Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |