Home

Context Navigation

data_output_netcdf4_module.f90 @ 4598

Last change on this file since 4598 was 4597, checked in by gronemeier, 4 years ago

Summary:

bugfix: - write unlimited dimension in netcdf4-parallel mode

prevent unused-variable warning if preprocessor directives are not given

new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

change: - set parallel access mode to independent per default (netCDF4 output files)

Details:

data_output_module.f90:

bugfix: - write unlimited dimension in netcdf4-parallel mode
new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

data_output_netcdf4_module.f90:

bugfix: - allow writing of unlimited dimensions in parallel mode

prevent unused-variable warning if preprocessor directives are not given

change: - set parallel access mode to independent per default
new : - dimension variables can be written by every PE

data_output_binary_module.f90:

change: update argument list of routine binary_init_dimension due to changes in interface

Property svn:keywords set to Id

File size: 49.9 KB

Line
1	!> @file data_output_netcdf4_module.f90
2	!--------------------------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 2019-2020 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! ------------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: data_output_netcdf4_module.f90 4597 2020-07-09 19:21:53Z suehring $
26	! bugfix: - allow writing of unlimited dimensions in parallel mode
27	! - prevent unused-variable warning if preprocessor directives are not given
28	! change: - set parallel access mode to independent per default
29	! new : - dimension variables can be written by every PE
30	!
31	! 4579 2020-06-25 20:05:07Z gronemeier
32	! corrected formatting to follow PALM coding standard
33	!
34	! 4577 2020-06-25 09:53:58Z raasch
35	! file re-formatted to follow the PALM coding standard
36	!
37	! 4481 2020-03-31 18:55:54Z maronga
38	! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument
39	!
40	! 4408 2020-02-14 10:04:39Z gronemeier
41	! Enable character-array output
42	!
43	! 4232 2019-09-20 09:34:22Z knoop
44	! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
45	!
46	! 4147 2019-08-07 09:42:31Z gronemeier
47	! corrected indentation according to coding standard
48	!
49	! 4141 2019-08-05 12:24:51Z gronemeier
50	! Initial revision
51	!
52	!
53	! Authors:
54	! --------
55	!> @author: Tobias Gronemeier
56	!
57	! Description:
58	! ------------
59	!> NetCDF output module to write data to NetCDF files.
60	!> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0.
61	!>
62	!> @bug 'mode' is not always checked. If a routine is called with an unknown mode (e.g. a typo),
63	!> this does not throw any error.
64	!--------------------------------------------------------------------------------------------------!
65	MODULE data_output_netcdf4_module
66
67	USE kinds
68
69	#if defined( __parallel ) && !defined( __mpifh )
70	USE MPI
71	#endif
72
73	#if defined( __netcdf4 )
74	USE NETCDF
75	#endif
76
77	IMPLICIT NONE
78
79	#if defined( __parallel ) && defined( __mpifh )
80	INCLUDE "mpif.h"
81	#endif
82
83	CHARACTER(LEN=*), PARAMETER :: mode_parallel = 'parallel' !< string selecting netcdf4 parallel mode
84	CHARACTER(LEN=*), PARAMETER :: mode_serial = 'serial' !< string selecting netcdf4 serial mode
85
86	CHARACTER(LEN=100) :: file_suffix = '' !< file suffix added to each file name
87	CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message
88	CHARACTER(LEN=800) :: temp_string !< dummy string
89
90	INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file
91	INTEGER :: global_id_in_file = -1 !< value of global ID within a file
92	INTEGER :: master_rank !< master rank for tasks to be executed by single PE only
93	INTEGER :: my_rank !< MPI rank of processor
94	INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output
95
96	LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed
97
98	SAVE
99
100	PRIVATE
101
102	INTERFACE netcdf4_init_module
103	MODULE PROCEDURE netcdf4_init_module
104	END INTERFACE netcdf4_init_module
105
106	INTERFACE netcdf4_open_file
107	MODULE PROCEDURE netcdf4_open_file
108	END INTERFACE netcdf4_open_file
109
110	INTERFACE netcdf4_init_dimension
111	MODULE PROCEDURE netcdf4_init_dimension
112	END INTERFACE netcdf4_init_dimension
113
114	INTERFACE netcdf4_init_variable
115	MODULE PROCEDURE netcdf4_init_variable
116	END INTERFACE netcdf4_init_variable
117
118	INTERFACE netcdf4_write_attribute
119	MODULE PROCEDURE netcdf4_write_attribute
120	END INTERFACE netcdf4_write_attribute
121
122	INTERFACE netcdf4_stop_file_header_definition
123	MODULE PROCEDURE netcdf4_stop_file_header_definition
124	END INTERFACE netcdf4_stop_file_header_definition
125
126	INTERFACE netcdf4_write_variable
127	MODULE PROCEDURE netcdf4_write_variable
128	END INTERFACE netcdf4_write_variable
129
130	INTERFACE netcdf4_finalize
131	MODULE PROCEDURE netcdf4_finalize
132	END INTERFACE netcdf4_finalize
133
134	INTERFACE netcdf4_get_error_message
135	MODULE PROCEDURE netcdf4_get_error_message
136	END INTERFACE netcdf4_get_error_message
137
138	PUBLIC &
139	netcdf4_finalize, &
140	netcdf4_get_error_message, &
141	netcdf4_init_dimension, &
142	netcdf4_init_module, &
143	netcdf4_init_variable, &
144	netcdf4_open_file, &
145	netcdf4_stop_file_header_definition, &
146	netcdf4_write_attribute, &
147	netcdf4_write_variable
148
149
150	CONTAINS
151
152
153	!--------------------------------------------------------------------------------------------------!
154	! Description:
155	! ------------
156	!> Initialize data-output module.
157	!--------------------------------------------------------------------------------------------------!
158	SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
159	master_output_rank, &
160	program_debug_output_unit, debug_output, dom_global_id )
161
162	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_module' !< name of this routine
163
164	CHARACTER(LEN=*), INTENT(IN) :: file_suffix_of_output_group !> file-name suffix added to each file;
165	!> must be unique for each output group
166
167	INTEGER, INTENT(IN) :: dom_global_id !< global id within a file defined by DOM
168	INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be executed by a single PE
169	INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output
170	INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output
171	INTEGER :: return_value !< return value
172
173	LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed
174
175
176	file_suffix = file_suffix_of_output_group
177	output_group_comm = mpi_comm_of_output_group
178	master_rank = master_output_rank
179
180	#if defined( __parallel )
181	CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
182	IF ( return_value /= 0 ) THEN
183	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
184	ENDIF
185	#else
186	my_rank = master_rank
187	return_value = 0
188	!
189	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
190	IF ( .FALSE. ) CALL internal_message( 'debug', routine_name // ': dummy message' )
191	#endif
192
193	debug_output_unit = program_debug_output_unit
194	print_debug_output = debug_output
195
196	global_id_in_file = dom_global_id
197
198	END SUBROUTINE netcdf4_init_module
199
200	!--------------------------------------------------------------------------------------------------!
201	! Description:
202	! ------------
203	!> Open netcdf file.
204	!--------------------------------------------------------------------------------------------------!
205	SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value )
206
207	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_open_file' !< name of this routine
208
209	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
210	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
211
212	INTEGER, INTENT(OUT) :: file_id !< file ID
213	INTEGER :: nc_stat !< netcdf return value
214	INTEGER, INTENT(OUT) :: return_value !< return value
215
216
217	return_value = 0
218	file_id = -1
219	!
220	!-- Open new file
221	CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' )
222
223	IF ( TRIM( mode ) == mode_serial ) THEN
224
225	#if defined( __netcdf4 )
226
227	IF ( return_value == 0 ) THEN
228	IF ( my_rank == master_rank ) THEN
229	nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &
230	IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &
231	file_id )
232	ELSE
233	nc_stat = 0
234	ENDIF
235	ENDIF
236	#else
237	nc_stat = 0
238	return_value = 1
239	CALL internal_message( 'error', routine_name // &
240	': pre-processor directive "__netcdf4" not given. ' // &
241	'Using NetCDF4 output not possible' )
242	#endif
243
244	ELSEIF ( TRIM( mode ) == mode_parallel ) THEN
245
246	#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
247	nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &
248	IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
249	file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
250	#else
251	nc_stat = 0
252	return_value = 1
253	CALL internal_message( 'error', routine_name // &
254	': pre-processor directives "__parallel" and/or ' // &
255	'"__netcdf4" and/or "__netcdf4_parallel" not given. ' // &
256	'Using parallel NetCDF4 output not possible' )
257	#endif
258
259	ELSE
260	nc_stat = 0
261	return_value = 1
262	CALL internal_message( 'error', routine_name // &
263	': selected mode "' // TRIM( mode ) // '" must be either "' // &
264	mode_serial // '" or "' // mode_parallel // '"' )
265	ENDIF
266
267	#if defined( __netcdf4 )
268	IF ( nc_stat /= NF90_NOERR .AND. return_value == 0 ) THEN
269	return_value = 1
270	CALL internal_message( 'error', routine_name // &
271	': NetCDF error while opening file "' // &
272	TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) )
273	ENDIF
274	#endif
275
276	END SUBROUTINE netcdf4_open_file
277
278	!--------------------------------------------------------------------------------------------------!
279	! Description:
280	! ------------
281	!> Write attribute to netcdf file.
282	!--------------------------------------------------------------------------------------------------!
283	SUBROUTINE netcdf4_write_attribute( mode, file_id, variable_id, attribute_name, &
284	value_char, value_int8, value_int16, value_int32, &
285	value_real32, value_real64, return_value )
286
287	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine
288
289	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
290	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
291	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute
292
293	INTEGER, INTENT(IN) :: file_id !< file ID
294	INTEGER :: nc_stat !< netcdf return value
295	INTEGER, INTENT(OUT) :: return_value !< return value
296	INTEGER :: target_id !< ID of target which gets attribute (either global or variable_id)
297	INTEGER, INTENT(IN) :: variable_id !< variable ID
298
299	INTEGER(KIND=1), INTENT(IN), OPTIONAL :: value_int8 !< value of attribute
300	INTEGER(KIND=2), INTENT(IN), OPTIONAL :: value_int16 !< value of attribute
301	INTEGER(KIND=4), INTENT(IN), OPTIONAL :: value_int32 !< value of attribute
302
303	REAL(KIND=4), INTENT(IN), OPTIONAL :: value_real32 !< value of attribute
304	REAL(KIND=8), INTENT(IN), OPTIONAL :: value_real64 !< value of attribute
305
306
307	#if defined( __netcdf4 )
308	return_value = 0
309
310	IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN
311
312	IF ( variable_id == global_id_in_file ) THEN
313	target_id = NF90_GLOBAL
314	ELSE
315	target_id = variable_id
316	ENDIF
317
318	CALL internal_message( 'debug', routine_name // &
319	': write attribute "' // TRIM( attribute_name ) // '"' )
320
321	IF ( PRESENT( value_char ) ) THEN
322	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
323	ELSEIF ( PRESENT( value_int8 ) ) THEN
324	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
325	ELSEIF ( PRESENT( value_int16 ) ) THEN
326	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
327	ELSEIF ( PRESENT( value_int32 ) ) THEN
328	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
329	ELSEIF ( PRESENT( value_real32 ) ) THEN
330	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
331	ELSEIF ( PRESENT( value_real64 ) ) THEN
332	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
333	ELSE
334	return_value = 1
335	CALL internal_message( 'error', routine_name // &
336	': no value given for attribute "' // TRIM( attribute_name ) // &
337	'"' )
338	ENDIF
339
340	IF ( return_value == 0 ) THEN
341	IF ( nc_stat /= NF90_NOERR ) THEN
342	return_value = 1
343	CALL internal_message( 'error', routine_name // &
344	': NetCDF error while writing attribute "' // &
345	TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
346	ENDIF
347	ENDIF
348
349	ENDIF
350	#else
351	return_value = 1
352	!
353	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
354	IF ( .FALSE. ) THEN
355	nc_stat = LEN( routine_name )
356	target_id = 0
357	ENDIF
358	#endif
359
360	END SUBROUTINE netcdf4_write_attribute
361
362	!--------------------------------------------------------------------------------------------------!
363	! Description:
364	! ------------
365	!> Initialize dimension.
366	!--------------------------------------------------------------------------------------------------!
367	SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, &
368	dimension_name, dimension_type, dimension_length, &
369	write_only_by_master_rank, return_value )
370
371	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine
372
373	CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension
374	CHARACTER(LEN=*), INTENT(IN) :: dimension_type !< data type of dimension
375	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
376
377	INTEGER, INTENT(OUT) :: dimension_id !< dimension ID
378	INTEGER, INTENT(IN) :: dimension_length !< length of dimension
379	INTEGER, INTENT(IN) :: file_id !< file ID
380	INTEGER :: nc_dimension_length !< length of dimension
381	INTEGER :: nc_stat !< netcdf return value
382	INTEGER, INTENT(OUT) :: return_value !< return value
383	INTEGER, INTENT(OUT) :: variable_id !< variable ID
384
385	LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable
386
387
388	#if defined( __netcdf4 )
389	return_value = 0
390	variable_id = -1
391	dimension_id = -1
392
393	IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN
394
395	CALL internal_message( 'debug', routine_name // &
396	': init dimension "' // TRIM( dimension_name ) // '"' )
397	!
398	!-- Check if dimension is unlimited
399	IF ( dimension_length < 0 ) THEN
400	nc_dimension_length = NF90_UNLIMITED
401	ELSE
402	nc_dimension_length = dimension_length
403	ENDIF
404	!
405	!-- Define dimension in file
406	nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
407
408	IF ( nc_stat == NF90_NOERR ) THEN
409	!
410	!-- Define variable holding dimension values in file
411	CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
412	(/ dimension_id /), &
413	write_only_by_master_rank=write_only_by_master_rank, &
414	return_value=return_value )
415
416	ELSE
417	return_value = 1
418	CALL internal_message( 'error', routine_name // &
419	': NetCDF error while initializing dimension "' // &
420	TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
421	ENDIF
422
423	ENDIF
424	#else
425	return_value = 1
426	variable_id = -1
427	dimension_id = -1
428	!
429	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
430	IF ( .FALSE. ) THEN
431	nc_stat = LEN( routine_name )
432	nc_dimension_length = 0
433	ENDIF
434	#endif
435
436	END SUBROUTINE netcdf4_init_dimension
437
438	!--------------------------------------------------------------------------------------------------!
439	! Description:
440	! ------------
441	!> Initialize variable.
442	!--------------------------------------------------------------------------------------------------!
443	SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, &
444	dimension_ids, write_only_by_master_rank, return_value )
445
446	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine
447
448	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
449	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
450	CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable
451
452	INTEGER, INTENT(IN) :: file_id !< file ID
453	INTEGER :: nc_stat !< netcdf return value
454	INTEGER :: nc_variable_type !< netcdf data type
455	INTEGER, INTENT(OUT) :: return_value !< return value
456	INTEGER, INTENT(OUT) :: variable_id !< variable ID
457	#if defined( __netcdf4_parallel )
458	INTEGER :: parallel_access_mode !< either NF90_INDEPENDENT or NF90_COLLECTIVE
459	INTEGER :: unlimited_dimension_id !< ID of unlimited dimension in file
460	#endif
461	INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable
462
463	LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable
464
465
466	#if defined( __netcdf4 )
467	return_value = 0
468	variable_id = -1
469
470	IF ( ( TRIM( mode ) == mode_serial .AND. my_rank == master_rank ) &
471	.OR. TRIM( mode ) == mode_parallel ) THEN
472
473	WRITE( temp_string, * ) write_only_by_master_rank
474	CALL internal_message( 'debug', routine_name // &
475	': init variable "' // TRIM( variable_name ) // &
476	'" ( write_only_by_master_rank = ' // TRIM( temp_string ) // ')' )
477
478	nc_variable_type = get_netcdf_data_type( variable_type )
479
480	IF ( nc_variable_type /= -1 ) THEN
481	!
482	!-- Define variable in file
483	nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, &
484	dimension_ids, variable_id )
485
486	#if defined( __netcdf4_parallel )
487	!
488	!-- Define how variable can be accessed by PEs in parallel netcdf file
489	IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN
490	!
491	!-- If the variable uses an unlimited dimension, its access mode must be 'collective',
492	!-- otherwise it can be set to independent.
493	!-- Hence, get ID of unlimited dimension in file (if any) and check if it is used by
494	!-- the variable.
495	nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
496
497	IF ( nc_stat == NF90_NOERR ) THEN
498	IF ( ANY( dimension_ids == unlimited_dimension_id ) ) THEN
499	parallel_access_mode = NF90_COLLECTIVE
500	ELSE
501	parallel_access_mode = NF90_INDEPENDENT
502	ENDIF
503
504	nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, parallel_access_mode )
505	ENDIF
506	ENDIF
507	#endif
508
509	IF ( nc_stat /= NF90_NOERR ) THEN
510	return_value = 1
511	CALL internal_message( 'error', routine_name // &
512	': NetCDF error while initializing variable "' // &
513	TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
514	ENDIF
515
516	ELSE
517	return_value = 1
518	ENDIF
519
520	ELSEIF ( TRIM( mode ) /= mode_serial .AND. TRIM( mode ) /= mode_parallel ) THEN
521	return_value = 1
522	CALL internal_message( 'error', routine_name // &
523	': selected mode "' // TRIM( mode ) // '" must be either "' // &
524	mode_serial // '" or "' // mode_parallel // '"' )
525	ENDIF
526
527	#else
528	return_value = 1
529	variable_id = -1
530	!
531	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
532	IF ( .FALSE. ) THEN
533	nc_stat = LEN( routine_name )
534	nc_variable_type = get_netcdf_data_type( '' )
535	ENDIF
536	#endif
537
538	END SUBROUTINE netcdf4_init_variable
539
540	!--------------------------------------------------------------------------------------------------!
541	! Description:
542	! ------------
543	!> Leave file definition state.
544	!--------------------------------------------------------------------------------------------------!
545	SUBROUTINE netcdf4_stop_file_header_definition( mode, file_id, return_value )
546
547	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_stop_file_header_definition' !< name of this routine
548
549	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
550
551	INTEGER, INTENT(IN) :: file_id !< file ID
552	INTEGER :: nc_stat !< netcdf return value
553	INTEGER :: old_fill_mode !< previous netcdf fill mode
554	INTEGER, INTENT(OUT) :: return_value !< return value
555
556
557	#if defined( __netcdf4 )
558	return_value = 0
559
560	IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN
561
562	WRITE( temp_string, * ) file_id
563	CALL internal_message( 'debug', routine_name // &
564	': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
565	!
566	!-- Set general no fill, otherwise the performance drops significantly
567	nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
568
569	IF ( nc_stat == NF90_NOERR ) THEN
570	nc_stat = NF90_ENDDEF( file_id )
571	ENDIF
572
573	IF ( nc_stat /= NF90_NOERR ) THEN
574	return_value = 1
575	CALL internal_message( 'error', routine_name // &
576	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
577	ENDIF
578
579	ENDIF
580	#else
581	return_value = 1
582	!
583	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
584	IF ( .FALSE. ) THEN
585	nc_stat = LEN( routine_name )
586	old_fill_mode = 0
587	ENDIF
588	#endif
589
590	END SUBROUTINE netcdf4_stop_file_header_definition
591
592	!--------------------------------------------------------------------------------------------------!
593	! Description:
594	! ------------
595	!> Write variable of different kind into netcdf file.
596	!--------------------------------------------------------------------------------------------------!
597	SUBROUTINE netcdf4_write_variable( &
598	mode, file_id, variable_id, bounds_start, value_counts, bounds_origin, &
599	write_only_by_master_rank, &
600	values_char_0d, values_char_1d, values_char_2d, values_char_3d, &
601	values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, &
602	values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, &
603	values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, &
604	values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, &
605	values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
606	values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
607	values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &
608	return_value )
609
610	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine
611
612	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
613
614	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable
615	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable
616	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable
617	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable
618
619	INTEGER :: d !< loop index
620	INTEGER, INTENT(IN) :: file_id !< file ID
621	INTEGER :: nc_stat !< netcdf return value
622	INTEGER :: ndims !< number of dimensions of variable in file
623	INTEGER, INTENT(OUT) :: return_value !< return value
624	INTEGER :: unlimited_dimension_id !< ID of unlimited dimension in file
625	INTEGER, INTENT(IN) :: variable_id !< variable ID
626
627	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension
628	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable
629	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< IDs of dimensions of variable in file
630	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_lengths !< length of dimensions of variable in file
631	INTEGER, DIMENSION(:), INTENT(IN) :: value_counts !< count of values along each dimension to be written
632
633	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: values_int8_0d !< output variable
634	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: values_int16_0d !< output variable
635	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_int32_0d !< output variable
636	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: values_intwp_0d !< output variable
637	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int8_1d !< output variable
638	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int16_1d !< output variable
639	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int32_1d !< output variable
640	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_intwp_1d !< output variable
641	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int8_2d !< output variable
642	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int16_2d !< output variable
643	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int32_2d !< output variable
644	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_intwp_2d !< output variable
645	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int8_3d !< output variable
646	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int16_3d !< output variable
647	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int32_3d !< output variable
648	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable
649
650	LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable
651	LOGICAL :: write_data !< true if variable shall be written to file
652
653	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable
654	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: values_real64_0d !< output variable
655	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: values_realwp_0d !< output variable
656	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real32_1d !< output variable
657	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real64_1d !< output variable
658	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_realwp_1d !< output variable
659	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real32_2d !< output variable
660	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real64_2d !< output variable
661	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_realwp_2d !< output variable
662	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real32_3d !< output variable
663	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real64_3d !< output variable
664	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_realwp_3d !< output variable
665
666
667	#if defined( __netcdf4 )
668	return_value = 0
669	write_data = .FALSE.
670	!
671	!-- Check whether this PE write any data to file
672	IF ( TRIM( mode ) == mode_serial ) THEN
673
674	IF ( my_rank == master_rank ) write_data = .TRUE.
675
676	ELSEIF ( TRIM( mode ) == mode_parallel ) THEN
677	!
678	!-- Check for collective access mode.
679	!-- This cannot be checked directly but indirect via the presence of any unlimited dimensions
680	!-- If any dimension is unlimited, variable access must be collective and all PEs must
681	!-- participate in writing
682	ndims = SIZE( bounds_start )
683	ALLOCATE( dimension_ids(ndims) )
684
685	nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, DIMIDS=dimension_ids )
686	nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
687
688	IF ( ANY( dimension_ids == unlimited_dimension_id ) ) THEN
689	write_data = .TRUE.
690	!
691	!-- If access is independent, check if only master rank shall write
692	ELSEIF ( write_only_by_master_rank ) THEN
693	IF ( my_rank == master_rank ) write_data = .TRUE.
694	!
695	!-- If all PEs can write, check if there are any data to be written
696	ELSEIF ( ALL( value_counts > 0, DIM=1 ) ) THEN
697	write_data = .TRUE.
698	ENDIF
699
700	ELSE
701	return_value = 1
702	CALL internal_message( 'error', routine_name // &
703	': selected mode "' // TRIM( mode ) // '" must be either "' // &
704	mode_serial // '" or "' // mode_parallel // '"' )
705	ENDIF
706
707	IF ( write_data ) THEN
708
709	WRITE( temp_string, * ) variable_id
710	CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
711
712	ndims = SIZE( bounds_start )
713	!
714	!-- Character output
715	IF ( PRESENT( values_char_0d ) ) THEN
716	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), &
717	start = bounds_start - bounds_origin + 1, &
718	count = value_counts )
719	ELSEIF ( PRESENT( values_char_1d ) ) THEN
720	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d, &
721	start = bounds_start - bounds_origin + 1, &
722	count = value_counts )
723	ELSEIF ( PRESENT( values_char_2d ) ) THEN
724	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d, &
725	start = bounds_start - bounds_origin + 1, &
726	count = value_counts )
727	ELSEIF ( PRESENT( values_char_3d ) ) THEN
728	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d, &
729	start = bounds_start - bounds_origin + 1, &
730	count = value_counts )
731	!
732	!-- 8bit integer output
733	ELSEIF ( PRESENT( values_int8_0d ) ) THEN
734	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), &
735	start = bounds_start - bounds_origin + 1, &
736	count = value_counts )
737	ELSEIF ( PRESENT( values_int8_1d ) ) THEN
738	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d, &
739	start = bounds_start - bounds_origin + 1, &
740	count = value_counts )
741	ELSEIF ( PRESENT( values_int8_2d ) ) THEN
742	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d, &
743	start = bounds_start - bounds_origin + 1, &
744	count = value_counts )
745	ELSEIF ( PRESENT( values_int8_3d ) ) THEN
746	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d, &
747	start = bounds_start - bounds_origin + 1, &
748	count = value_counts )
749	!
750	!-- 16bit integer output
751	ELSEIF ( PRESENT( values_int16_0d ) ) THEN
752	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), &
753	start = bounds_start - bounds_origin + 1, &
754	count = value_counts )
755	ELSEIF ( PRESENT( values_int16_1d ) ) THEN
756	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d, &
757	start = bounds_start - bounds_origin + 1, &
758	count = value_counts )
759	ELSEIF ( PRESENT( values_int16_2d ) ) THEN
760	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d, &
761	start = bounds_start - bounds_origin + 1, &
762	count = value_counts )
763	ELSEIF ( PRESENT( values_int16_3d ) ) THEN
764	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d, &
765	start = bounds_start - bounds_origin + 1, &
766	count = value_counts )
767	!
768	!-- 32bit integer output
769	ELSEIF ( PRESENT( values_int32_0d ) ) THEN
770	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /), &
771	start = bounds_start - bounds_origin + 1, &
772	count = value_counts )
773	ELSEIF ( PRESENT( values_int32_1d ) ) THEN
774	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d, &
775	start = bounds_start - bounds_origin + 1, &
776	count = value_counts )
777	ELSEIF ( PRESENT( values_int32_2d ) ) THEN
778	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d, &
779	start = bounds_start - bounds_origin + 1, &
780	count = value_counts )
781	ELSEIF ( PRESENT( values_int32_3d ) ) THEN
782	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d, &
783	start = bounds_start - bounds_origin + 1, &
784	count = value_counts )
785	!
786	!-- Working-precision integer output
787	ELSEIF ( PRESENT( values_intwp_0d ) ) THEN
788	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /), &
789	start = bounds_start - bounds_origin + 1, &
790	count = value_counts )
791	ELSEIF ( PRESENT( values_intwp_1d ) ) THEN
792	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d, &
793	start = bounds_start - bounds_origin + 1, &
794	count = value_counts )
795	ELSEIF ( PRESENT( values_intwp_2d ) ) THEN
796	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d, &
797	start = bounds_start - bounds_origin + 1, &
798	count = value_counts )
799	ELSEIF ( PRESENT( values_intwp_3d ) ) THEN
800	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d, &
801	start = bounds_start - bounds_origin + 1, &
802	count = value_counts )
803	!
804	!-- 32bit real output
805	ELSEIF ( PRESENT( values_real32_0d ) ) THEN
806	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), &
807	start = bounds_start - bounds_origin + 1, &
808	count = value_counts )
809	ELSEIF ( PRESENT( values_real32_1d ) ) THEN
810	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d, &
811	start = bounds_start - bounds_origin + 1, &
812	count = value_counts )
813	ELSEIF ( PRESENT( values_real32_2d ) ) THEN
814	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d, &
815	start = bounds_start - bounds_origin + 1, &
816	count = value_counts )
817	ELSEIF ( PRESENT( values_real32_3d ) ) THEN
818	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d, &
819	start = bounds_start - bounds_origin + 1, &
820	count = value_counts )
821	!
822	!-- 64bit real output
823	ELSEIF ( PRESENT( values_real64_0d ) ) THEN
824	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), &
825	start = bounds_start - bounds_origin + 1, &
826	count = value_counts )
827	ELSEIF ( PRESENT( values_real64_1d ) ) THEN
828	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d, &
829	start = bounds_start - bounds_origin + 1, &
830	count = value_counts )
831	ELSEIF ( PRESENT( values_real64_2d ) ) THEN
832	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d, &
833	start = bounds_start - bounds_origin + 1, &
834	count = value_counts )
835	ELSEIF ( PRESENT( values_real64_3d ) ) THEN
836	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d, &
837	start = bounds_start - bounds_origin + 1, &
838	count = value_counts )
839	!
840	!-- Working-precision real output
841	ELSEIF ( PRESENT( values_realwp_0d ) ) THEN
842	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), &
843	start = bounds_start - bounds_origin + 1, &
844	count = value_counts )
845	ELSEIF ( PRESENT( values_realwp_1d ) ) THEN
846	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d, &
847	start = bounds_start - bounds_origin + 1, &
848	count = value_counts )
849	ELSEIF ( PRESENT( values_realwp_2d ) ) THEN
850	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d, &
851	start = bounds_start - bounds_origin + 1, &
852	count = value_counts )
853	ELSEIF ( PRESENT( values_realwp_3d ) ) THEN
854	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d, &
855	start = bounds_start - bounds_origin + 1, &
856	count = value_counts )
857	ELSE
858	return_value = 1
859	nc_stat = NF90_NOERR
860	WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id
861	CALL internal_message( 'error', routine_name // &
862	': no output values given ' // TRIM( temp_string ) )
863	ENDIF
864	!
865	!-- Check for errors
866	IF ( nc_stat /= NF90_NOERR ) THEN
867	return_value = 1
868
869	IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS ) THEN
870	!
871	!-- If given bounds exceed dimension bounds, get information of bounds in file
872	WRITE( temp_string, * ) NF90_STRERROR( nc_stat )
873
874	IF ( .NOT. ALLOCATED( dimension_ids ) ) ALLOCATE( dimension_ids(ndims) )
875	ALLOCATE( dimension_lengths(ndims) )
876
877	nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids )
878
879	d = 1
880	DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR )
881	nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), &
882	LEN=dimension_lengths(d) )
883	d = d + 1
884	ENDDO
885
886	IF ( nc_stat == NF90_NOERR ) THEN
887	WRITE( temp_string, * ) TRIM( temp_string ) // '; given variable bounds: ' // &
888	'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
889	CALL internal_message( 'error', routine_name // &
890	': error while writing: ' // TRIM( temp_string ) )
891	ELSE
892	!
893	!-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
894	CALL internal_message( 'error', routine_name // &
895	': error while accessing file: ' // &
896	NF90_STRERROR( nc_stat ) )
897	ENDIF
898
899	ELSE
900	!
901	!-- Other NetCDF error
902	CALL internal_message( 'error', routine_name // &
903	': error while writing: ' // NF90_STRERROR( nc_stat ) )
904	ENDIF
905	ENDIF
906
907	ENDIF
908	#else
909	return_value = 1
910	!
911	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
912	IF ( .FALSE. ) THEN
913	nc_stat = LEN( routine_name )
914	IF ( write_data ) unlimited_dimension_id = 0
915	IF ( ALLOCATED( dimension_ids ) ) d = 0
916	IF ( ALLOCATED( dimension_lengths ) ) ndims = 0
917	ENDIF
918	#endif
919
920	END SUBROUTINE netcdf4_write_variable
921
922	!--------------------------------------------------------------------------------------------------!
923	! Description:
924	! ------------
925	!> Close netcdf file.
926	!--------------------------------------------------------------------------------------------------!
927	SUBROUTINE netcdf4_finalize( mode, file_id, return_value )
928
929	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_finalize' !< name of routine
930
931	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
932
933	INTEGER, INTENT(IN) :: file_id !< file ID
934	INTEGER :: nc_stat !< netcdf return value
935	INTEGER, INTENT(OUT) :: return_value !< return value
936
937
938	#if defined( __netcdf4 )
939	return_value = 0
940
941	IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN
942
943	WRITE( temp_string, * ) file_id
944	CALL internal_message( 'debug', routine_name // &
945	': close file (file_id=' // TRIM( temp_string ) // ')' )
946
947	nc_stat = NF90_CLOSE( file_id )
948	IF ( nc_stat == NF90_NOERR ) THEN
949	return_value = 0
950	ELSE
951	return_value = 1
952	CALL internal_message( 'error', routine_name // &
953	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
954	ENDIF
955
956	ENDIF
957	#else
958	return_value = 1
959	!
960	!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
961	IF ( .FALSE. ) THEN
962	nc_stat = 0
963	temp_string = routine_name
964	ENDIF
965	#endif
966
967	END SUBROUTINE netcdf4_finalize
968
969	!--------------------------------------------------------------------------------------------------!
970	! Description:
971	! ------------
972	!> Convert data_type string into netcdf data type value.
973	!--------------------------------------------------------------------------------------------------!
974	FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
975
976	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine
977
978	CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type
979
980	INTEGER :: return_value !< netcdf data type
981
982
983	SELECT CASE ( TRIM( data_type ) )
984
985	#if defined( __netcdf4 )
986	CASE ( 'char' )
987	return_value = NF90_CHAR
988
989	CASE ( 'int8' )
990	return_value = NF90_BYTE
991
992	CASE ( 'int16' )
993	return_value = NF90_SHORT
994
995	CASE ( 'int32' )
996	return_value = NF90_INT
997
998	CASE ( 'real32' )
999	return_value = NF90_FLOAT
1000
1001	CASE ( 'real64' )
1002	return_value = NF90_DOUBLE
1003	#endif
1004
1005	CASE DEFAULT
1006	CALL internal_message( 'error', routine_name // &
1007	': data type unknown (' // TRIM( data_type ) // ')' )
1008	return_value = -1
1009
1010	END SELECT
1011
1012	END FUNCTION get_netcdf_data_type
1013
1014	!--------------------------------------------------------------------------------------------------!
1015	! Description:
1016	! ------------
1017	!> Message routine writing debug information into the debug file or creating the error message
1018	!> string.
1019	!--------------------------------------------------------------------------------------------------!
1020	SUBROUTINE internal_message( level, string )
1021
1022	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
1023	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
1024
1025
1026	IF ( TRIM( level ) == 'error' ) THEN
1027
1028	WRITE( internal_error_message, '(A,A)' ) ': ', string
1029
1030	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
1031
1032	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
1033	FLUSH( debug_output_unit )
1034
1035	ENDIF
1036
1037	END SUBROUTINE internal_message
1038
1039	!--------------------------------------------------------------------------------------------------!
1040	! Description:
1041	! ------------
1042	!> Return the last created error message.
1043	!--------------------------------------------------------------------------------------------------!
1044	FUNCTION netcdf4_get_error_message() RESULT( error_message )
1045
1046	CHARACTER(LEN=800) :: error_message !< return error message to main program
1047
1048
1049	error_message = TRIM( internal_error_message )
1050
1051	internal_error_message = ''
1052
1053	END FUNCTION netcdf4_get_error_message
1054
1055
1056	END MODULE data_output_netcdf4_module

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: palm/trunk/SOURCE/data_output_netcdf4_module.f90 @ 4598

Download in other formats: