source: palm/trunk/SOURCE/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!--------------------------------------------------------------------------------------------------!
41MODULE 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
119CONTAINS
120
121
122!--------------------------------------------------------------------------------------------------!
123! Description:
124! ------------
125!> Initialize data-output module.
126!--------------------------------------------------------------------------------------------------!
127SUBROUTINE 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
142END SUBROUTINE netcdf4_parallel_init_module
143
144!--------------------------------------------------------------------------------------------------!
145! Description:
146! ------------
147!> Open netcdf file.
148!--------------------------------------------------------------------------------------------------!
149SUBROUTINE 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
185END SUBROUTINE netcdf4_parallel_open_file
186
187!--------------------------------------------------------------------------------------------------!
188! Description:
189! ------------
190!> Write attribute to netcdf file.
191!--------------------------------------------------------------------------------------------------!
192SUBROUTINE 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
258END SUBROUTINE netcdf4_parallel_write_attribute
259
260!--------------------------------------------------------------------------------------------------!
261! Description:
262! ------------
263!> Initialize dimension.
264!--------------------------------------------------------------------------------------------------!
265SUBROUTINE 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
320END SUBROUTINE netcdf4_parallel_init_dimension
321
322!--------------------------------------------------------------------------------------------------!
323! Description:
324! ------------
325!> Initialize variable.
326!--------------------------------------------------------------------------------------------------!
327SUBROUTINE 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
387END SUBROUTINE netcdf4_parallel_init_variable
388
389!--------------------------------------------------------------------------------------------------!
390! Description:
391! ------------
392!> Leave file definition state.
393!--------------------------------------------------------------------------------------------------!
394SUBROUTINE 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
428END SUBROUTINE netcdf4_parallel_init_end
429
430!--------------------------------------------------------------------------------------------------!
431! Description:
432! ------------
433!> Write variable of different kind into netcdf file.
434!--------------------------------------------------------------------------------------------------!
435SUBROUTINE 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
667END SUBROUTINE netcdf4_parallel_write_variable
668
669!--------------------------------------------------------------------------------------------------!
670! Description:
671! ------------
672!> Close netcdf file.
673!--------------------------------------------------------------------------------------------------!
674SUBROUTINE 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
700END SUBROUTINE netcdf4_parallel_finalize
701
702!--------------------------------------------------------------------------------------------------!
703! Description:
704! ------------
705!> Convert data_type string into netcdf data type value.
706!--------------------------------------------------------------------------------------------------!
707FUNCTION 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
745END 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!--------------------------------------------------------------------------------------------------!
753SUBROUTINE 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
770END SUBROUTINE internal_message
771
772!--------------------------------------------------------------------------------------------------!
773! Description:
774! ------------
775!> Return the last created error message.
776!--------------------------------------------------------------------------------------------------!
777SUBROUTINE 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
784END SUBROUTINE netcdf4_parallel_get_error_message
785
786
787END MODULE data_output_netcdf4_parallel_module
Note: See TracBrowser for help on using the repository browser.