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

Last change on this file since 4598 was 4597, checked in by gronemeier, 10 months ago

Summary:

bugfix: - write unlimited dimension in netcdf4-parallel mode

  • prevent unused-variable warning if preprocessor directives are not given

new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

change: - set parallel access mode to independent per default (netCDF4 output files)

Details:

data_output_module.f90:

bugfix: - write unlimited dimension in netcdf4-parallel mode
new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

data_output_netcdf4_module.f90:

bugfix: - allow writing of unlimited dimensions in parallel mode

  • prevent unused-variable warning if preprocessor directives are not given

change: - set parallel access mode to independent per default
new : - dimension variables can be written by every PE

data_output_binary_module.f90:

change: update argument list of routine binary_init_dimension due to changes in interface

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