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

Last change on this file since 4123 was 4123, checked in by gronemeier, 2 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!--------------------------------------------------------------------------------------------------!
39MODULE 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
123CONTAINS
124
125
126!--------------------------------------------------------------------------------------------------!
127! Description:
128! ------------
129!> Initialize data-output module.
130!--------------------------------------------------------------------------------------------------!
131SUBROUTINE 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
155END SUBROUTINE netcdf4_init_module
156
157!--------------------------------------------------------------------------------------------------!
158! Description:
159! ------------
160!> Open netcdf file.
161!--------------------------------------------------------------------------------------------------!
162SUBROUTINE 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
244END SUBROUTINE netcdf4_open_file
245
246!--------------------------------------------------------------------------------------------------!
247! Description:
248! ------------
249!> Write attribute to netcdf file.
250!--------------------------------------------------------------------------------------------------!
251SUBROUTINE 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
317END SUBROUTINE netcdf4_write_attribute
318
319!--------------------------------------------------------------------------------------------------!
320! Description:
321! ------------
322!> Initialize dimension.
323!--------------------------------------------------------------------------------------------------!
324SUBROUTINE 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
377END SUBROUTINE netcdf4_init_dimension
378
379!--------------------------------------------------------------------------------------------------!
380! Description:
381! ------------
382!> Initialize variable.
383!--------------------------------------------------------------------------------------------------!
384SUBROUTINE 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
445END SUBROUTINE netcdf4_init_variable
446
447!--------------------------------------------------------------------------------------------------!
448! Description:
449! ------------
450!> Leave file definition state.
451!--------------------------------------------------------------------------------------------------!
452SUBROUTINE 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
486END SUBROUTINE netcdf4_init_end
487
488!--------------------------------------------------------------------------------------------------!
489! Description:
490! ------------
491!> Write variable of different kind into netcdf file.
492!--------------------------------------------------------------------------------------------------!
493SUBROUTINE 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
752END SUBROUTINE netcdf4_write_variable
753
754!--------------------------------------------------------------------------------------------------!
755! Description:
756! ------------
757!> Close netcdf file.
758!--------------------------------------------------------------------------------------------------!
759SUBROUTINE 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
785END SUBROUTINE netcdf4_finalize
786
787!--------------------------------------------------------------------------------------------------!
788! Description:
789! ------------
790!> Convert data_type string into netcdf data type value.
791!--------------------------------------------------------------------------------------------------!
792FUNCTION 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
830END 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!--------------------------------------------------------------------------------------------------!
838SUBROUTINE 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
855END SUBROUTINE internal_message
856
857!--------------------------------------------------------------------------------------------------!
858! Description:
859! ------------
860!> Return the last created error message.
861!--------------------------------------------------------------------------------------------------!
862SUBROUTINE 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
869END SUBROUTINE netcdf4_get_error_message
870
871
872END MODULE data_output_netcdf4_module
Note: See TracBrowser for help on using the repository browser.