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

Last change on this file since 4794 was 4629, checked in by raasch, 4 years ago

support for MPI Fortran77 interface (mpif.h) removed

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