Home

Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

data_output_netcdf4_parallel_module.f90 @ 4087

Last change on this file since 4087 was 4070, checked in by gronemeier, 5 years ago
Add new data output modules
Property svn:keywords set to `Id`
File size: 33.7 KB

Line
1	!> @file data_output_netcdf4_parallel_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_parallel_module.f90 4070 2019-07-03 13:51:40Z 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 using parallel NetCDF.
37	!>
38	!> @todo Think of removing 'is_init' as its value can be derived from the return
39	!> value of 'return_value'.
40	!--------------------------------------------------------------------------------------------------!
41	MODULE data_output_netcdf4_parallel_module
42
43	USE kinds
44
45	#if defined( __parallel )
46	#if defined( __mpifh )
47	INCLUDE "mpif.h"
48	#else
49	USE MPI
50	#endif
51	#endif
52
53	#if defined( __netcdf4_parallel )
54	USE NETCDF
55	#endif
56
57	IMPLICIT NONE
58
59	CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message
60	CHARACTER(LEN=800) :: temp_string !< dummy string
61
62	INTEGER(iwp) :: debug_output_unit !< Fortran Unit Number of the debug-output file
63	INTEGER(iwp) :: global_id_in_file = -1 !< value of global ID within a file
64
65	LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed
66
67	SAVE
68
69	PRIVATE
70
71	INTERFACE netcdf4_parallel_init_module
72	MODULE PROCEDURE netcdf4_parallel_init_module
73	END INTERFACE netcdf4_parallel_init_module
74
75	INTERFACE netcdf4_parallel_open_file
76	MODULE PROCEDURE netcdf4_parallel_open_file
77	END INTERFACE netcdf4_parallel_open_file
78
79	INTERFACE netcdf4_parallel_init_dimension
80	MODULE PROCEDURE netcdf4_parallel_init_dimension
81	END INTERFACE netcdf4_parallel_init_dimension
82
83	INTERFACE netcdf4_parallel_init_variable
84	MODULE PROCEDURE netcdf4_parallel_init_variable
85	END INTERFACE netcdf4_parallel_init_variable
86
87	INTERFACE netcdf4_parallel_write_attribute
88	MODULE PROCEDURE netcdf4_parallel_write_attribute
89	END INTERFACE netcdf4_parallel_write_attribute
90
91	INTERFACE netcdf4_parallel_init_end
92	MODULE PROCEDURE netcdf4_parallel_init_end
93	END INTERFACE netcdf4_parallel_init_end
94
95	INTERFACE netcdf4_parallel_write_variable
96	MODULE PROCEDURE netcdf4_parallel_write_variable
97	END INTERFACE netcdf4_parallel_write_variable
98
99	INTERFACE netcdf4_parallel_finalize
100	MODULE PROCEDURE netcdf4_parallel_finalize
101	END INTERFACE netcdf4_parallel_finalize
102
103	INTERFACE netcdf4_parallel_get_error_message
104	MODULE PROCEDURE netcdf4_parallel_get_error_message
105	END INTERFACE netcdf4_parallel_get_error_message
106
107	PUBLIC &
108	netcdf4_parallel_finalize, &
109	netcdf4_parallel_get_error_message, &
110	netcdf4_parallel_init_dimension, &
111	netcdf4_parallel_init_end, &
112	netcdf4_parallel_init_module, &
113	netcdf4_parallel_init_variable, &
114	netcdf4_parallel_open_file, &
115	netcdf4_parallel_write_attribute, &
116	netcdf4_parallel_write_variable
117
118
119	CONTAINS
120
121
122	!--------------------------------------------------------------------------------------------------!
123	! Description:
124	! ------------
125	!> Initialize data-output module.
126	!--------------------------------------------------------------------------------------------------!
127	SUBROUTINE netcdf4_parallel_init_module( program_debug_output_unit, debug_output, dom_global_id )
128
129	INTEGER(iwp), INTENT(IN) :: dom_global_id !< global id within a file defined by DOM
130	INTEGER(iwp), INTENT(IN) :: program_debug_output_unit !< file unit number for debug output
131
132	LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed
133
134
135	debug_output_unit = program_debug_output_unit
136
137	print_debug_output = debug_output
138
139	global_id_in_file = dom_global_id
140
141
142	END SUBROUTINE netcdf4_parallel_init_module
143
144	!--------------------------------------------------------------------------------------------------!
145	! Description:
146	! ------------
147	!> Open netcdf file.
148	!--------------------------------------------------------------------------------------------------!
149	SUBROUTINE netcdf4_parallel_open_file( filename, file_id, return_value )
150
151	CHARACTER(LEN=*), INTENT(IN) :: filename !< name of file
152
153	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_open_file' !< name of this routine
154
155	INTEGER(iwp), INTENT(OUT) :: file_id !< file ID
156	INTEGER(iwp) :: nc_stat !< netcdf return value
157	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
158
159
160	#if defined( __parallel ) && defined( __netcdf4_parallel )
161	return_value = 0
162
163	!-- Open new file
164	CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( filename ) // '"' )
165
166	nc_stat = NF90_CREATE( TRIM( filename ), &
167	IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
168	file_id, COMM = MPI_COMM_WORLD, INFO = MPI_INFO_NULL )
169
170	IF ( nc_stat /= NF90_NOERR ) THEN
171	return_value = 1
172	CALL internal_message( 'error', routine_name // ': NetCDF error while opening file "' // &
173	TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) )
174	ENDIF
175	#else
176	file_id = -1
177	nc_stat = 0
178	return_value = 1
179	CALL internal_message( 'error', routine_name // &
180	': pre-processor directives "__parallel" ' // &
181	'and/or "__netcdf4_parallel" not given. ' // &
182	'Using parallel NetCDF4 output not possible' )
183	#endif
184
185	END SUBROUTINE netcdf4_parallel_open_file
186
187	!--------------------------------------------------------------------------------------------------!
188	! Description:
189	! ------------
190	!> Write attribute to netcdf file.
191	!--------------------------------------------------------------------------------------------------!
192	SUBROUTINE netcdf4_parallel_write_attribute( file_id, var_id, att_name, att_value_char, &
193	att_value_int8, att_value_int16, att_value_int32, &
194	att_value_real32, att_value_real64, return_value )
195
196	CHARACTER(LEN=*), INTENT(IN) :: att_name !< name of attribute
197	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: att_value_char !< value of attribute
198
199	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_write_attribute' !< name of this routine
200
201	INTEGER(iwp) :: nc_stat !< netcdf return value
202	INTEGER(iwp) :: target_id !< ID of target which gets attribute (either global or var_id)
203
204	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
205	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
206	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
207
208	INTEGER(KIND=1), INTENT(IN), OPTIONAL :: att_value_int8 !< value of attribute
209	INTEGER(KIND=2), INTENT(IN), OPTIONAL :: att_value_int16 !< value of attribute
210	INTEGER(KIND=4), INTENT(IN), OPTIONAL :: att_value_int32 !< value of attribute
211
212	REAL(KIND=4), INTENT(IN), OPTIONAL :: att_value_real32 !< value of attribute
213	REAL(KIND=8), INTENT(IN), OPTIONAL :: att_value_real64 !< value of attribute
214
215
216	#if defined( __netcdf4_parallel )
217	return_value = 0
218
219	IF ( var_id == global_id_in_file ) THEN
220	target_id = NF90_GLOBAL
221	ELSE
222	target_id = var_id
223	ENDIF
224
225	CALL internal_message( 'debug', &
226	routine_name // ': write attribute "' // TRIM( att_name ) // '"' )
227
228	IF ( PRESENT( att_value_char ) ) THEN
229	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), TRIM( att_value_char ) )
230	ELSEIF ( PRESENT( att_value_int8 ) ) THEN
231	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int8 )
232	ELSEIF ( PRESENT( att_value_int16 ) ) THEN
233	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int16 )
234	ELSEIF ( PRESENT( att_value_int32 ) ) THEN
235	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int32 )
236	ELSEIF ( PRESENT( att_value_real32 ) ) THEN
237	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real32 )
238	ELSEIF ( PRESENT( att_value_real64 ) ) THEN
239	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real64 )
240	ELSE
241	return_value = 1
242	CALL internal_message( 'error', TRIM( routine_name ) // &
243	': attribute "' // TRIM( att_name ) // '": no value given' )
244	ENDIF
245
246	IF ( return_value == 0 ) THEN
247	IF ( nc_stat /= NF90_NOERR ) THEN
248	return_value = 1
249	CALL internal_message( 'error', &
250	routine_name // ': NetCDF error while writing attribute "' // &
251	TRIM( att_name ) // '": ' // NF90_STRERROR( nc_stat ) )
252	ENDIF
253	ENDIF
254	#else
255	return_value = 1
256	#endif
257
258	END SUBROUTINE netcdf4_parallel_write_attribute
259
260	!--------------------------------------------------------------------------------------------------!
261	! Description:
262	! ------------
263	!> Initialize dimension.
264	!--------------------------------------------------------------------------------------------------!
265	SUBROUTINE netcdf4_parallel_init_dimension( file_id, dim_id, var_id, &
266	dim_name, dim_type, dim_length, is_init, return_value )
267
268	CHARACTER(LEN=*), INTENT(IN) :: dim_name !< name of dimension
269	CHARACTER(LEN=*), INTENT(IN) :: dim_type !< data type of dimension
270
271	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_dimension' !< name of this routine
272
273	INTEGER(iwp), INTENT(OUT) :: dim_id !< dimension ID
274	INTEGER(iwp), INTENT(IN) :: dim_length !< length of dimension
275	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
276	INTEGER(iwp) :: nc_dim_length !< length of dimension
277	INTEGER(iwp) :: nc_stat !< netcdf return value
278	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
279	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
280
281	LOGICAL, INTENT(OUT) :: is_init !< true if dimension is initialized
282
283
284	#if defined( __netcdf4_parallel )
285	return_value = 0
286	var_id = -1
287
288	CALL internal_message( 'debug', routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
289
290	!-- Check if dimension is unlimited
291	IF ( dim_length < 0 ) THEN
292	nc_dim_length = NF90_UNLIMITED
293	ELSE
294	nc_dim_length = dim_length
295	ENDIF
296
297	!-- Define dimension in file
298	nc_stat = NF90_DEF_DIM( file_id, dim_name, nc_dim_length, dim_id )
299
300	IF ( nc_stat == NF90_NOERR ) THEN
301
302	!-- Define variable holding dimension values in file
303	CALL netcdf4_parallel_init_variable( file_id, var_id, dim_name, dim_type, (/dim_id/), &
304	is_init, is_global=.TRUE., return_value=return_value )
305
306	ELSE
307	return_value = 1
308	is_init = .FALSE.
309	CALL internal_message( 'error', routine_name // &
310	': NetCDF error while initializing dimension "' // &
311	TRIM( dim_name ) // '": ' // NF90_STRERROR( nc_stat ) )
312	ENDIF
313	#else
314	return_value = 1
315	var_id = -1
316	dim_id = -1
317	is_init = .FALSE.
318	#endif
319
320	END SUBROUTINE netcdf4_parallel_init_dimension
321
322	!--------------------------------------------------------------------------------------------------!
323	! Description:
324	! ------------
325	!> Initialize variable.
326	!--------------------------------------------------------------------------------------------------!
327	SUBROUTINE netcdf4_parallel_init_variable( file_id, var_id, var_name, var_type, var_dim_ids, &
328	is_init, is_global, return_value )
329
330	CHARACTER(LEN=*), INTENT(IN) :: var_name !< name of variable
331	CHARACTER(LEN=*), INTENT(IN) :: var_type !< data type of variable
332
333	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_variable' !< name of this routine
334
335	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
336	INTEGER(iwp) :: nc_stat !< netcdf return value
337	INTEGER(iwp) :: nc_var_type !< netcdf data type
338	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
339	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
340
341	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: var_dim_ids !< list of dimension IDs used by variable
342
343	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
344	LOGICAL, INTENT(OUT) :: is_init !< true if variable is initialized
345
346
347	#if defined( __netcdf4_parallel )
348	return_value = 0
349
350	WRITE( temp_string, * ) is_global
351	CALL internal_message( 'debug', routine_name // ': init variable "' // TRIM( var_name ) // &
352	'" ( is_global = ' // TRIM( temp_string ) // ')' )
353
354	nc_var_type = get_netcdf_data_type( var_type )
355
356	IF ( nc_var_type /= -1_iwp ) THEN
357
358	!-- Define variable in file
359	nc_stat = NF90_DEF_VAR( file_id, var_name, nc_var_type, var_dim_ids, var_id )
360
361	IF ( nc_stat == NF90_NOERR ) THEN
362	IF ( is_global ) THEN
363	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_INDEPENDENT )
364	ELSE
365	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_COLLECTIVE )
366	ENDIF
367	ENDIF
368
369	IF ( nc_stat /= NF90_NOERR) THEN
370	return_value = 1
371	CALL internal_message( 'error', routine_name // &
372	': NetCDF error while initializing variable "' // &
373	TRIM( var_name ) // '": ' // NF90_STRERROR( nc_stat ) )
374	ENDIF
375
376	ELSE
377	return_value = 1
378	ENDIF
379
380	is_init = return_value == 0
381	#else
382	return_value = 1
383	var_id = -1
384	is_init = .FALSE.
385	#endif
386
387	END SUBROUTINE netcdf4_parallel_init_variable
388
389	!--------------------------------------------------------------------------------------------------!
390	! Description:
391	! ------------
392	!> Leave file definition state.
393	!--------------------------------------------------------------------------------------------------!
394	SUBROUTINE netcdf4_parallel_init_end( file_id, return_value )
395
396	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_end' !< name of this routine
397
398	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
399	INTEGER(iwp) :: nc_stat !< netcdf return value
400	INTEGER(iwp) :: old_mode !< previous netcdf fill mode
401	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
402
403
404	#if defined( __netcdf4_parallel )
405	return_value = 0
406
407	WRITE( temp_string, * ) file_id
408	CALL internal_message( 'debug', &
409	routine_name // &
410	': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
411
412	!-- Set general no fill, otherwise the performance drops significantly
413	nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_mode )
414
415	IF ( nc_stat == NF90_NOERR ) THEN
416	nc_stat = NF90_ENDDEF( file_id )
417	ENDIF
418
419	IF ( nc_stat /= NF90_NOERR ) THEN
420	return_value = 1
421	CALL internal_message( 'error', routine_name // ': NetCDF error: ' // &
422	NF90_STRERROR( nc_stat ) )
423	ENDIF
424	#else
425	return_value = 1
426	#endif
427
428	END SUBROUTINE netcdf4_parallel_init_end
429
430	!--------------------------------------------------------------------------------------------------!
431	! Description:
432	! ------------
433	!> Write variable of different kind into netcdf file.
434	!--------------------------------------------------------------------------------------------------!
435	SUBROUTINE netcdf4_parallel_write_variable( &
436	file_id, var_id, bounds_start, bounds_end, bounds_origin, &
437	do_output, is_global, &
438	var_int8_0d, var_int8_1d, var_int8_2d, var_int8_3d, &
439	var_int16_0d, var_int16_1d, var_int16_2d, var_int16_3d, &
440	var_int32_0d, var_int32_1d, var_int32_2d, var_int32_3d, &
441	var_intwp_0d, var_intwp_1d, var_intwp_2d, var_intwp_3d, &
442	var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
443	var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
444	var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
445	return_value )
446
447	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_write_variable' !< name of this routine
448
449	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
450	INTEGER(iwp) :: myid = 0 !< id number of processor element
451	INTEGER(iwp) :: nc_stat !< netcdf return value
452	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
453	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
454
455	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension
456	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_end !< ending index of variable
457	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable
458	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: value_count !< count of values along each dimension to be written
459
460	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: var_int8_0d !< output variable
461	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int8_1d !< output variable
462	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int8_2d !< output variable
463	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int8_3d !< output variable
464
465	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: var_int16_0d !< output variable
466	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int16_1d !< output variable
467	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int16_2d !< output variable
468	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int16_3d !< output variable
469
470	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_int32_0d !< output variable
471	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int32_1d !< output variable
472	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int32_2d !< output variable
473	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int32_3d !< output variable
474
475	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: var_intwp_0d !< output variable
476	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_intwp_1d !< output variable
477	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_intwp_2d !< output variable
478	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_intwp_3d !< output variable
479
480	LOGICAL, INTENT(IN) :: do_output !< if false, set count to 0 and do no output
481	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
482
483	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_real32_0d !< output variable
484	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real32_1d !< output variable
485	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real32_2d !< output variable
486	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real32_3d !< output variable
487
488	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: var_real64_0d !< output variable
489	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real64_1d !< output variable
490	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real64_2d !< output variable
491	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real64_3d !< output variable
492
493	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: var_realwp_0d !< output variable
494	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_realwp_1d !< output variable
495	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_realwp_2d !< output variable
496	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_realwp_3d !< output variable
497
498
499	#if defined( __netcdf4_parallel )
500	return_value = 0
501
502	#if defined( __parallel )
503	CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
504	IF ( return_value /= 0 ) THEN
505	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
506	ENDIF
507	#endif
508
509	IF ( return_value == 0 .AND. ( .NOT. is_global .OR. myid == 0 ) ) THEN
510
511	WRITE( temp_string, * ) var_id
512	CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
513
514	ALLOCATE( value_count(SIZE( bounds_start )) )
515
516	IF ( do_output ) THEN
517	value_count = bounds_end - bounds_start + 1
518	ELSE
519	value_count = 0
520	END IF
521
522	!-- 8bit integer output
523	IF ( PRESENT( var_int8_0d ) ) THEN
524	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int8_0d /), &
525	start = bounds_start - bounds_origin + 1, &
526	count = value_count )
527	ELSEIF ( PRESENT( var_int8_1d ) ) THEN
528	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_1d, &
529	start = bounds_start - bounds_origin + 1, &
530	count = value_count )
531	ELSEIF ( PRESENT( var_int8_2d ) ) THEN
532	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_2d, &
533	start = bounds_start - bounds_origin + 1, &
534	count = value_count )
535	ELSEIF ( PRESENT( var_int8_3d ) ) THEN
536	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_3d, &
537	start = bounds_start - bounds_origin + 1, &
538	count = value_count )
539	!-- 16bit integer output
540	ELSEIF ( PRESENT( var_int16_0d ) ) THEN
541	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int16_0d /), &
542	start = bounds_start - bounds_origin + 1, &
543	count = value_count )
544	ELSEIF ( PRESENT( var_int16_1d ) ) THEN
545	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_1d, &
546	start = bounds_start - bounds_origin + 1, &
547	count = value_count )
548	ELSEIF ( PRESENT( var_int16_2d ) ) THEN
549	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_2d, &
550	start = bounds_start - bounds_origin + 1, &
551	count = value_count )
552	ELSEIF ( PRESENT( var_int16_3d ) ) THEN
553	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_3d, &
554	start = bounds_start - bounds_origin + 1, &
555	count = value_count )
556	!-- 32bit integer output
557	ELSEIF ( PRESENT( var_int32_0d ) ) THEN
558	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int32_0d /), &
559	start = bounds_start - bounds_origin + 1, &
560	count = value_count )
561	ELSEIF ( PRESENT( var_int32_1d ) ) THEN
562	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_1d, &
563	start = bounds_start - bounds_origin + 1, &
564	count = value_count )
565	ELSEIF ( PRESENT( var_int32_2d ) ) THEN
566	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_2d, &
567	start = bounds_start - bounds_origin + 1, &
568	count = value_count )
569	ELSEIF ( PRESENT( var_int32_3d ) ) THEN
570	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_3d, &
571	start = bounds_start - bounds_origin + 1, &
572	count = value_count )
573	!-- working-precision integer output
574	ELSEIF ( PRESENT( var_intwp_0d ) ) THEN
575	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_intwp_0d /), &
576	start = bounds_start - bounds_origin + 1, &
577	count = value_count )
578	ELSEIF ( PRESENT( var_intwp_1d ) ) THEN
579	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_1d, &
580	start = bounds_start - bounds_origin + 1, &
581	count = value_count )
582	ELSEIF ( PRESENT( var_intwp_2d ) ) THEN
583	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_2d, &
584	start = bounds_start - bounds_origin + 1, &
585	count = value_count )
586	ELSEIF ( PRESENT( var_intwp_3d ) ) THEN
587	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_3d, &
588	start = bounds_start - bounds_origin + 1, &
589	count = value_count )
590	!-- 32bit real output
591	ELSEIF ( PRESENT( var_real32_0d ) ) THEN
592	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real32_0d /), &
593	start = bounds_start - bounds_origin + 1, &
594	count = value_count )
595	ELSEIF ( PRESENT( var_real32_1d ) ) THEN
596	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_1d, &
597	start = bounds_start - bounds_origin + 1, &
598	count = value_count )
599	ELSEIF ( PRESENT( var_real32_2d ) ) THEN
600	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_2d, &
601	start = bounds_start - bounds_origin + 1, &
602	count = value_count )
603	ELSEIF ( PRESENT( var_real32_3d ) ) THEN
604	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_3d, &
605	start = bounds_start - bounds_origin + 1, &
606	count = value_count )
607	!-- 64bit real output
608	ELSEIF ( PRESENT( var_real64_0d ) ) THEN
609	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real64_0d /), &
610	start = bounds_start - bounds_origin + 1, &
611	count = value_count )
612	ELSEIF ( PRESENT( var_real64_1d ) ) THEN
613	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_1d, &
614	start = bounds_start - bounds_origin + 1, &
615	count = value_count )
616	ELSEIF ( PRESENT( var_real64_2d ) ) THEN
617	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_2d, &
618	start = bounds_start - bounds_origin + 1, &
619	count = value_count )
620	ELSEIF ( PRESENT( var_real64_3d ) ) THEN
621	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_3d, &
622	start = bounds_start - bounds_origin + 1, &
623	count = value_count )
624	!-- working-precision real output
625	ELSEIF ( PRESENT( var_realwp_0d ) ) THEN
626	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_realwp_0d /), &
627	start = bounds_start - bounds_origin + 1, &
628	count = value_count )
629	ELSEIF ( PRESENT( var_realwp_1d ) ) THEN
630	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_1d, &
631	start = bounds_start - bounds_origin + 1, &
632	count = value_count )
633	ELSEIF ( PRESENT( var_realwp_2d ) ) THEN
634	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_2d, &
635	start = bounds_start - bounds_origin + 1, &
636	count = value_count )
637	ELSEIF ( PRESENT( var_realwp_3d ) ) THEN
638	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_3d, &
639	start = bounds_start - bounds_origin + 1, &
640	count = value_count )
641	ELSE
642	return_value = 1
643	nc_stat = NF90_NOERR
644	WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
645	CALL internal_message( 'error', routine_name // &
646	TRIM( temp_string ) // &
647	': no output values given' )
648	ENDIF
649
650	!-- Check for errors
651	IF ( nc_stat /= NF90_NOERR ) THEN
652	return_value = 1
653	WRITE( temp_string, * ) 'variable_id=', var_id, '; file_id=', file_id, &
654	', bounds_start=', bounds_start, &
655	', bounds_end=', bounds_end, &
656	', count=', value_count
657	CALL internal_message( 'error', routine_name // &
658	': error while writing ' // TRIM( temp_string ) // &
659	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
660	ENDIF
661
662	ENDIF
663	#else
664	return_value = 1
665	#endif
666
667	END SUBROUTINE netcdf4_parallel_write_variable
668
669	!--------------------------------------------------------------------------------------------------!
670	! Description:
671	! ------------
672	!> Close netcdf file.
673	!--------------------------------------------------------------------------------------------------!
674	SUBROUTINE netcdf4_parallel_finalize( file_id, return_value )
675
676	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_finalize' !< name of routine
677
678	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
679	INTEGER(iwp) :: nc_stat !< netcdf return value
680	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
681
682
683	#if defined( __netcdf4_parallel )
684	WRITE( temp_string, * ) file_id
685	CALL internal_message( 'debug', routine_name // &
686	': close file (file_id=' // TRIM( temp_string ) // ')' )
687
688	nc_stat = NF90_CLOSE( file_id )
689	IF ( nc_stat == NF90_NOERR ) THEN
690	return_value = 0
691	ELSE
692	return_value = 1
693	CALL internal_message( 'error', routine_name // &
694	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
695	ENDIF
696	#else
697	return_value = 1
698	#endif
699
700	END SUBROUTINE netcdf4_parallel_finalize
701
702	!--------------------------------------------------------------------------------------------------!
703	! Description:
704	! ------------
705	!> Convert data_type string into netcdf data type value.
706	!--------------------------------------------------------------------------------------------------!
707	FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
708
709	CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type
710
711	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine
712
713	INTEGER(iwp) :: return_value !< netcdf data type
714
715
716	SELECT CASE ( TRIM( data_type ) )
717
718	#if defined( __netcdf4_parallel )
719	CASE ( 'char' )
720	return_value = NF90_CHAR
721
722	CASE ( 'int8' )
723	return_value = NF90_BYTE
724
725	CASE ( 'int16' )
726	return_value = NF90_SHORT
727
728	CASE ( 'int32' )
729	return_value = NF90_INT
730
731	CASE ( 'real32' )
732	return_value = NF90_FLOAT
733
734	CASE ( 'real64' )
735	return_value = NF90_DOUBLE
736	#endif
737
738	CASE DEFAULT
739	CALL internal_message( 'error', routine_name // &
740	': data type unknown (' // TRIM( data_type ) // ')' )
741	return_value = -1_iwp
742
743	END SELECT
744
745	END FUNCTION get_netcdf_data_type
746
747	!--------------------------------------------------------------------------------------------------!
748	! Description:
749	! ------------
750	!> Message routine writing debug information into the debug file
751	!> or creating the error message string.
752	!--------------------------------------------------------------------------------------------------!
753	SUBROUTINE internal_message( level, string )
754
755	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
756	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
757
758
759	IF ( TRIM( level ) == 'error' ) THEN
760
761	WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
762
763	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
764
765	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
766	FLUSH( debug_output_unit )
767
768	ENDIF
769
770	END SUBROUTINE internal_message
771
772	!--------------------------------------------------------------------------------------------------!
773	! Description:
774	! ------------
775	!> Return the last created error message.
776	!--------------------------------------------------------------------------------------------------!
777	SUBROUTINE netcdf4_parallel_get_error_message( error_message )
778
779	CHARACTER(LEN=800), INTENT(OUT) :: error_message !< return error message to main program
780
781
782	error_message = internal_error_message
783
784	END SUBROUTINE netcdf4_parallel_get_error_message
785
786
787	END MODULE data_output_netcdf4_parallel_module

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

Context Navigation

source: palm/trunk/SOURCE/data_output_netcdf4_parallel_module.f90 @ 4087

Download in other formats: