Home

Context Navigation

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

Last change on this file since 4124 was 4123, checked in by gronemeier, 5 years ago
bugfix: do not assue that output arrays start with index 0
Property svn:keywords set to `Id`
File size: 37.5 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 4123 2019-07-26 13:45:03Z 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(iwp) :: debug_output_unit !< Fortran Unit Number of the debug-output file
65	INTEGER(iwp) :: 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_init_end
96	MODULE PROCEDURE netcdf4_init_end
97	END INTERFACE netcdf4_init_end
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_init_end, &
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(iwp), 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(iwp), 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, filename, file_id, return_value )
163
164	CHARACTER(LEN=*), INTENT(IN) :: filename !< 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(iwp), INTENT(OUT) :: file_id !< file ID
170	INTEGER :: my_rank !< MPI rank of processor
171	INTEGER(iwp) :: nc_stat !< netcdf return value
172	INTEGER(iwp), 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( filename ) // '"' )
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( filename ) // 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( filename ) // 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 // ': NetCDF error while opening file "' // &
240	TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) )
241	ENDIF
242	#endif
243
244	END SUBROUTINE netcdf4_open_file
245
246	!--------------------------------------------------------------------------------------------------!
247	! Description:
248	! ------------
249	!> Write attribute to netcdf file.
250	!--------------------------------------------------------------------------------------------------!
251	SUBROUTINE netcdf4_write_attribute( file_id, var_id, att_name, att_value_char, &
252	att_value_int8, att_value_int16, att_value_int32, &
253	att_value_real32, att_value_real64, return_value )
254
255	CHARACTER(LEN=*), INTENT(IN) :: att_name !< name of attribute
256	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: att_value_char !< value of attribute
257
258	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine
259
260	INTEGER(iwp) :: nc_stat !< netcdf return value
261	INTEGER(iwp) :: target_id !< ID of target which gets attribute (either global or var_id)
262
263	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
264	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
265	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
266
267	INTEGER(KIND=1), INTENT(IN), OPTIONAL :: att_value_int8 !< value of attribute
268	INTEGER(KIND=2), INTENT(IN), OPTIONAL :: att_value_int16 !< value of attribute
269	INTEGER(KIND=4), INTENT(IN), OPTIONAL :: att_value_int32 !< value of attribute
270
271	REAL(KIND=4), INTENT(IN), OPTIONAL :: att_value_real32 !< value of attribute
272	REAL(KIND=8), INTENT(IN), OPTIONAL :: att_value_real64 !< value of attribute
273
274
275	#if defined( __netcdf4 )
276	return_value = 0
277
278	IF ( var_id == global_id_in_file ) THEN
279	target_id = NF90_GLOBAL
280	ELSE
281	target_id = var_id
282	ENDIF
283
284	CALL internal_message( 'debug', &
285	routine_name // ': write attribute "' // TRIM( att_name ) // '"' )
286
287	IF ( PRESENT( att_value_char ) ) THEN
288	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), TRIM( att_value_char ) )
289	ELSEIF ( PRESENT( att_value_int8 ) ) THEN
290	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int8 )
291	ELSEIF ( PRESENT( att_value_int16 ) ) THEN
292	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int16 )
293	ELSEIF ( PRESENT( att_value_int32 ) ) THEN
294	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int32 )
295	ELSEIF ( PRESENT( att_value_real32 ) ) THEN
296	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real32 )
297	ELSEIF ( PRESENT( att_value_real64 ) ) THEN
298	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real64 )
299	ELSE
300	return_value = 1
301	CALL internal_message( 'error', TRIM( routine_name ) // &
302	': attribute "' // TRIM( att_name ) // '": no value given' )
303	ENDIF
304
305	IF ( return_value == 0 ) THEN
306	IF ( nc_stat /= NF90_NOERR ) THEN
307	return_value = 1
308	CALL internal_message( 'error', &
309	routine_name // ': NetCDF error while writing attribute "' // &
310	TRIM( att_name ) // '": ' // NF90_STRERROR( nc_stat ) )
311	ENDIF
312	ENDIF
313	#else
314	return_value = 1
315	#endif
316
317	END SUBROUTINE netcdf4_write_attribute
318
319	!--------------------------------------------------------------------------------------------------!
320	! Description:
321	! ------------
322	!> Initialize dimension.
323	!--------------------------------------------------------------------------------------------------!
324	SUBROUTINE netcdf4_init_dimension( mode, file_id, dim_id, var_id, &
325	dim_name, dim_type, dim_length, return_value )
326
327	CHARACTER(LEN=*), INTENT(IN) :: dim_name !< name of dimension
328	CHARACTER(LEN=*), INTENT(IN) :: dim_type !< data type of dimension
329	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
330
331	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine
332
333	INTEGER(iwp), INTENT(OUT) :: dim_id !< dimension ID
334	INTEGER(iwp), INTENT(IN) :: dim_length !< length of dimension
335	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
336	INTEGER(iwp) :: nc_dim_length !< length of dimension
337	INTEGER(iwp) :: nc_stat !< netcdf return value
338	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
339	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
340
341
342	#if defined( __netcdf4 )
343	return_value = 0
344	var_id = -1
345
346	CALL internal_message( 'debug', &
347	routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
348
349	!-- Check if dimension is unlimited
350	IF ( dim_length < 0 ) THEN
351	nc_dim_length = NF90_UNLIMITED
352	ELSE
353	nc_dim_length = dim_length
354	ENDIF
355
356	!-- Define dimension in file
357	nc_stat = NF90_DEF_DIM( file_id, dim_name, nc_dim_length, dim_id )
358
359	IF ( nc_stat == NF90_NOERR ) THEN
360
361	!-- Define variable holding dimension values in file
362	CALL netcdf4_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
363	is_global=.TRUE., return_value=return_value )
364
365	ELSE
366	return_value = 1
367	CALL internal_message( 'error', routine_name // &
368	': NetCDF error while initializing dimension "' // &
369	TRIM( dim_name ) // '": ' // NF90_STRERROR( nc_stat ) )
370	ENDIF
371	#else
372	return_value = 1
373	var_id = -1
374	dim_id = -1
375	#endif
376
377	END SUBROUTINE netcdf4_init_dimension
378
379	!--------------------------------------------------------------------------------------------------!
380	! Description:
381	! ------------
382	!> Initialize variable.
383	!--------------------------------------------------------------------------------------------------!
384	SUBROUTINE netcdf4_init_variable( mode, file_id, var_id, var_name, var_type, var_dim_ids, &
385	is_global, return_value )
386
387	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
388	CHARACTER(LEN=*), INTENT(IN) :: var_name !< name of variable
389	CHARACTER(LEN=*), INTENT(IN) :: var_type !< data type of variable
390
391	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine
392
393	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
394	INTEGER(iwp) :: nc_stat !< netcdf return value
395	INTEGER(iwp) :: nc_var_type !< netcdf data type
396	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
397	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
398
399	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: var_dim_ids !< list of dimension IDs used by variable
400
401	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
402
403
404	#if defined( __netcdf4 )
405	return_value = 0
406
407	WRITE( temp_string, * ) is_global
408	CALL internal_message( 'debug', routine_name // ': init variable "' // TRIM( var_name ) // &
409	'" ( is_global = ' // TRIM( temp_string ) // ')' )
410
411	nc_var_type = get_netcdf_data_type( var_type )
412
413	IF ( nc_var_type /= -1_iwp ) THEN
414
415	!-- Define variable in file
416	nc_stat = NF90_DEF_VAR( file_id, var_name, nc_var_type, var_dim_ids, var_id )
417
418	#if defined( __netcdf4_parallel )
419	!-- Define how variable can be accessed by PEs in parallel netcdf file
420	IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN
421	IF ( is_global ) THEN
422	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_INDEPENDENT )
423	ELSE
424	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_COLLECTIVE )
425	ENDIF
426	ENDIF
427	#endif
428
429	IF ( nc_stat /= NF90_NOERR) THEN
430	return_value = 1
431	CALL internal_message( 'error', routine_name // &
432	': NetCDF error while initializing variable "' // &
433	TRIM( var_name ) // '": ' // NF90_STRERROR( nc_stat ) )
434	ENDIF
435
436	ELSE
437	return_value = 1
438	ENDIF
439
440	#else
441	return_value = 1
442	var_id = -1
443	#endif
444
445	END SUBROUTINE netcdf4_init_variable
446
447	!--------------------------------------------------------------------------------------------------!
448	! Description:
449	! ------------
450	!> Leave file definition state.
451	!--------------------------------------------------------------------------------------------------!
452	SUBROUTINE netcdf4_init_end( file_id, return_value )
453
454	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_end' !< name of this routine
455
456	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
457	INTEGER(iwp) :: nc_stat !< netcdf return value
458	INTEGER(iwp) :: old_mode !< previous netcdf fill mode
459	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
460
461
462	#if defined( __netcdf4 )
463	return_value = 0
464
465	WRITE( temp_string, * ) file_id
466	CALL internal_message( 'debug', &
467	routine_name // &
468	': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
469
470	!-- Set general no fill, otherwise the performance drops significantly
471	nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_mode )
472
473	IF ( nc_stat == NF90_NOERR ) THEN
474	nc_stat = NF90_ENDDEF( file_id )
475	ENDIF
476
477	IF ( nc_stat /= NF90_NOERR ) THEN
478	return_value = 1
479	CALL internal_message( 'error', routine_name // ': NetCDF error: ' // &
480	NF90_STRERROR( nc_stat ) )
481	ENDIF
482	#else
483	return_value = 1
484	#endif
485
486	END SUBROUTINE netcdf4_init_end
487
488	!--------------------------------------------------------------------------------------------------!
489	! Description:
490	! ------------
491	!> Write variable of different kind into netcdf file.
492	!--------------------------------------------------------------------------------------------------!
493	SUBROUTINE netcdf4_write_variable( &
494	file_id, var_id, bounds_start, value_counts, bounds_origin, &
495	is_global, &
496	var_int8_0d, var_int8_1d, var_int8_2d, var_int8_3d, &
497	var_int16_0d, var_int16_1d, var_int16_2d, var_int16_3d, &
498	var_int32_0d, var_int32_1d, var_int32_2d, var_int32_3d, &
499	var_intwp_0d, var_intwp_1d, var_intwp_2d, var_intwp_3d, &
500	var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
501	var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
502	var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
503	return_value )
504
505	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine
506
507	INTEGER(iwp) :: d !< loop index
508	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
509	INTEGER :: my_rank !< MPI rank of processor
510	INTEGER(iwp) :: nc_stat !< netcdf return value
511	INTEGER(iwp) :: ndim !< number of dimensions of variable in file
512	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
513	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
514
515	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension
516	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable
517	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_ids !< IDs of dimensions of variable in file
518	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_lengths !< length of dimensions of variable in file
519	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: value_counts !< count of values along each dimension to be written
520
521	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: var_int8_0d !< output variable
522	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int8_1d !< output variable
523	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int8_2d !< output variable
524	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int8_3d !< output variable
525
526	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: var_int16_0d !< output variable
527	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int16_1d !< output variable
528	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int16_2d !< output variable
529	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int16_3d !< output variable
530
531	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_int32_0d !< output variable
532	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int32_1d !< output variable
533	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int32_2d !< output variable
534	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int32_3d !< output variable
535
536	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: var_intwp_0d !< output variable
537	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_intwp_1d !< output variable
538	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_intwp_2d !< output variable
539	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_intwp_3d !< output variable
540
541	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
542
543	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_real32_0d !< output variable
544	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real32_1d !< output variable
545	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real32_2d !< output variable
546	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real32_3d !< output variable
547
548	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: var_real64_0d !< output variable
549	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real64_1d !< output variable
550	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real64_2d !< output variable
551	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real64_3d !< output variable
552
553	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: var_realwp_0d !< output variable
554	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_realwp_1d !< output variable
555	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_realwp_2d !< output variable
556	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_realwp_3d !< output variable
557
558
559	#if defined( __netcdf4 )
560
561	#if defined( __parallel )
562	CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
563	IF ( return_value /= 0 ) THEN
564	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
565	ENDIF
566	#else
567	my_rank = master_rank
568	return_value = 0
569	#endif
570
571	IF ( return_value == 0 .AND. ( .NOT. is_global .OR. my_rank == master_rank ) ) THEN
572
573	WRITE( temp_string, * ) var_id
574	CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
575
576	ndim = SIZE( bounds_start )
577
578	!-- 8bit integer output
579	IF ( PRESENT( var_int8_0d ) ) THEN
580	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int8_0d /), &
581	start = bounds_start - bounds_origin + 1, &
582	count = value_counts )
583	ELSEIF ( PRESENT( var_int8_1d ) ) THEN
584	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_1d, &
585	start = bounds_start - bounds_origin + 1, &
586	count = value_counts )
587	ELSEIF ( PRESENT( var_int8_2d ) ) THEN
588	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_2d, &
589	start = bounds_start - bounds_origin + 1, &
590	count = value_counts )
591	ELSEIF ( PRESENT( var_int8_3d ) ) THEN
592	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_3d, &
593	start = bounds_start - bounds_origin + 1, &
594	count = value_counts )
595	!-- 16bit integer output
596	ELSEIF ( PRESENT( var_int16_0d ) ) THEN
597	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int16_0d /), &
598	start = bounds_start - bounds_origin + 1, &
599	count = value_counts )
600	ELSEIF ( PRESENT( var_int16_1d ) ) THEN
601	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_1d, &
602	start = bounds_start - bounds_origin + 1, &
603	count = value_counts )
604	ELSEIF ( PRESENT( var_int16_2d ) ) THEN
605	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_2d, &
606	start = bounds_start - bounds_origin + 1, &
607	count = value_counts )
608	ELSEIF ( PRESENT( var_int16_3d ) ) THEN
609	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_3d, &
610	start = bounds_start - bounds_origin + 1, &
611	count = value_counts )
612	!-- 32bit integer output
613	ELSEIF ( PRESENT( var_int32_0d ) ) THEN
614	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int32_0d /), &
615	start = bounds_start - bounds_origin + 1, &
616	count = value_counts )
617	ELSEIF ( PRESENT( var_int32_1d ) ) THEN
618	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_1d, &
619	start = bounds_start - bounds_origin + 1, &
620	count = value_counts )
621	ELSEIF ( PRESENT( var_int32_2d ) ) THEN
622	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_2d, &
623	start = bounds_start - bounds_origin + 1, &
624	count = value_counts )
625	ELSEIF ( PRESENT( var_int32_3d ) ) THEN
626	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_3d, &
627	start = bounds_start - bounds_origin + 1, &
628	count = value_counts )
629	!-- working-precision integer output
630	ELSEIF ( PRESENT( var_intwp_0d ) ) THEN
631	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_intwp_0d /), &
632	start = bounds_start - bounds_origin + 1, &
633	count = value_counts )
634	ELSEIF ( PRESENT( var_intwp_1d ) ) THEN
635	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_1d, &
636	start = bounds_start - bounds_origin + 1, &
637	count = value_counts )
638	ELSEIF ( PRESENT( var_intwp_2d ) ) THEN
639	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_2d, &
640	start = bounds_start - bounds_origin + 1, &
641	count = value_counts )
642	ELSEIF ( PRESENT( var_intwp_3d ) ) THEN
643	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_3d, &
644	start = bounds_start - bounds_origin + 1, &
645	count = value_counts )
646	!-- 32bit real output
647	ELSEIF ( PRESENT( var_real32_0d ) ) THEN
648	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real32_0d /), &
649	start = bounds_start - bounds_origin + 1, &
650	count = value_counts )
651	ELSEIF ( PRESENT( var_real32_1d ) ) THEN
652	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_1d, &
653	start = bounds_start - bounds_origin + 1, &
654	count = value_counts )
655	ELSEIF ( PRESENT( var_real32_2d ) ) THEN
656	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_2d, &
657	start = bounds_start - bounds_origin + 1, &
658	count = value_counts )
659	ELSEIF ( PRESENT( var_real32_3d ) ) THEN
660	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_3d, &
661	start = bounds_start - bounds_origin + 1, &
662	count = value_counts )
663	!-- 64bit real output
664	ELSEIF ( PRESENT( var_real64_0d ) ) THEN
665	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real64_0d /), &
666	start = bounds_start - bounds_origin + 1, &
667	count = value_counts )
668	ELSEIF ( PRESENT( var_real64_1d ) ) THEN
669	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_1d, &
670	start = bounds_start - bounds_origin + 1, &
671	count = value_counts )
672	ELSEIF ( PRESENT( var_real64_2d ) ) THEN
673	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_2d, &
674	start = bounds_start - bounds_origin + 1, &
675	count = value_counts )
676	ELSEIF ( PRESENT( var_real64_3d ) ) THEN
677	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_3d, &
678	start = bounds_start - bounds_origin + 1, &
679	count = value_counts )
680	!-- working-precision real output
681	ELSEIF ( PRESENT( var_realwp_0d ) ) THEN
682	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_realwp_0d /), &
683	start = bounds_start - bounds_origin + 1, &
684	count = value_counts )
685	ELSEIF ( PRESENT( var_realwp_1d ) ) THEN
686	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_1d, &
687	start = bounds_start - bounds_origin + 1, &
688	count = value_counts )
689	ELSEIF ( PRESENT( var_realwp_2d ) ) THEN
690	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_2d, &
691	start = bounds_start - bounds_origin + 1, &
692	count = value_counts )
693	ELSEIF ( PRESENT( var_realwp_3d ) ) THEN
694	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_3d, &
695	start = bounds_start - bounds_origin + 1, &
696	count = value_counts )
697	ELSE
698	return_value = 1
699	nc_stat = NF90_NOERR
700	WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
701	CALL internal_message( 'error', routine_name // &
702	TRIM( temp_string ) // &
703	': no output values given' )
704	ENDIF
705
706	!-- Check for errors
707	IF ( nc_stat /= NF90_NOERR ) THEN
708	return_value = 1
709
710	IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS ) THEN
711
712	!-- If given bounds exceed dimension bounds, get information of bounds in file
713	WRITE( temp_string, * ) NF90_STRERROR( nc_stat )
714
715	ALLOCATE( dim_ids(ndim) )
716	ALLOCATE( dim_lengths(ndim) )
717
718	nc_stat = NF90_INQUIRE_VARIABLE( file_id, var_id, dimids=dim_ids )
719
720	d = 1
721	DO WHILE ( d <= ndim .AND. nc_stat == NF90_NOERR )
722	nc_stat = NF90_INQUIRE_DIMENSION( file_id, dim_ids(d), len=dim_lengths(d) )
723	d = d + 1
724	ENDDO
725
726	IF ( nc_stat == NF90_NOERR ) THEN
727	WRITE( temp_string, * ) TRIM( temp_string ) // '; given variable bounds: ' // &
728	'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
729	CALL internal_message( 'error', routine_name // &
730	': error while writing: ' // &
731	TRIM( temp_string ) )
732	ELSE
733	!-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
734	CALL internal_message( 'error', routine_name // &
735	': error while accessing file: ' // &
736	NF90_STRERROR( nc_stat ) )
737	ENDIF
738
739	ELSE
740	!-- Other NetCDF error
741	CALL internal_message( 'error', routine_name // &
742	': error while writing: ' // &
743	NF90_STRERROR( nc_stat ) )
744	ENDIF
745	ENDIF
746
747	ENDIF
748	#else
749	return_value = 1
750	#endif
751
752	END SUBROUTINE netcdf4_write_variable
753
754	!--------------------------------------------------------------------------------------------------!
755	! Description:
756	! ------------
757	!> Close netcdf file.
758	!--------------------------------------------------------------------------------------------------!
759	SUBROUTINE netcdf4_finalize( file_id, return_value )
760
761	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_finalize' !< name of routine
762
763	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
764	INTEGER(iwp) :: nc_stat !< netcdf return value
765	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
766
767
768	#if defined( __netcdf4 )
769	WRITE( temp_string, * ) file_id
770	CALL internal_message( 'debug', routine_name // &
771	': close file (file_id=' // TRIM( temp_string ) // ')' )
772
773	nc_stat = NF90_CLOSE( file_id )
774	IF ( nc_stat == NF90_NOERR ) THEN
775	return_value = 0
776	ELSE
777	return_value = 1
778	CALL internal_message( 'error', routine_name // &
779	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
780	ENDIF
781	#else
782	return_value = 1
783	#endif
784
785	END SUBROUTINE netcdf4_finalize
786
787	!--------------------------------------------------------------------------------------------------!
788	! Description:
789	! ------------
790	!> Convert data_type string into netcdf data type value.
791	!--------------------------------------------------------------------------------------------------!
792	FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
793
794	CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type
795
796	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine
797
798	INTEGER(iwp) :: return_value !< netcdf data type
799
800
801	SELECT CASE ( TRIM( data_type ) )
802
803	#if defined( __netcdf4 )
804	CASE ( 'char' )
805	return_value = NF90_CHAR
806
807	CASE ( 'int8' )
808	return_value = NF90_BYTE
809
810	CASE ( 'int16' )
811	return_value = NF90_SHORT
812
813	CASE ( 'int32' )
814	return_value = NF90_INT
815
816	CASE ( 'real32' )
817	return_value = NF90_FLOAT
818
819	CASE ( 'real64' )
820	return_value = NF90_DOUBLE
821	#endif
822
823	CASE DEFAULT
824	CALL internal_message( 'error', routine_name // &
825	': data type unknown (' // TRIM( data_type ) // ')' )
826	return_value = -1_iwp
827
828	END SELECT
829
830	END FUNCTION get_netcdf_data_type
831
832	!--------------------------------------------------------------------------------------------------!
833	! Description:
834	! ------------
835	!> Message routine writing debug information into the debug file
836	!> or creating the error message string.
837	!--------------------------------------------------------------------------------------------------!
838	SUBROUTINE internal_message( level, string )
839
840	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
841	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
842
843
844	IF ( TRIM( level ) == 'error' ) THEN
845
846	WRITE( internal_error_message, '(A,A)' ) ': ', string
847
848	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
849
850	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
851	FLUSH( debug_output_unit )
852
853	ENDIF
854
855	END SUBROUTINE internal_message
856
857	!--------------------------------------------------------------------------------------------------!
858	! Description:
859	! ------------
860	!> Return the last created error message.
861	!--------------------------------------------------------------------------------------------------!
862	SUBROUTINE netcdf4_get_error_message( error_message )
863
864	CHARACTER(LEN=800), INTENT(OUT) :: error_message !< return error message to main program
865
866
867	error_message = internal_error_message
868
869	END SUBROUTINE netcdf4_get_error_message
870
871
872	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 |