Home

Context Navigation

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

Last change on this file since 4141 was 4141, checked in by gronemeier, 5 years ago

changes in data-output module (data_output_binary_module, data_output_module, data_output_netcdf4_module, binary_to_netcdf):

renaming of variables
changes to formatting and layout
update routine descriptions

Property svn:keywords set to Id

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