Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Jul 9, 2020 7:21:53 PM (4 years ago)
Author:
gronemeier
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/data_output_netcdf4_module.f90

    r4579 r4597  
    2424! -----------------
    2525! $Id$
     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
    2632! corrected formatting to follow PALM coding standard
    2733!
    … …  
    5359!> NetCDF output module to write data to NetCDF files.
    5460!> 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.
    5564!--------------------------------------------------------------------------------------------------!
    5665 MODULE data_output_netcdf4_module
    … …  
    8291    INTEGER ::  global_id_in_file = -1  !< value of global ID within a file
    8392    INTEGER ::  master_rank             !< master rank for tasks to be executed by single PE only
     93    INTEGER ::  my_rank                 !< MPI rank of processor
    8494    INTEGER ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
    8595
    … …  
    150160                                 program_debug_output_unit, debug_output, dom_global_id )
    151161
     162    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_module'  !< name of this routine
     163
    152164    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
    153165                                                                  !> must be unique for each output group
    … …  
    157169    INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    158170    INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
     171    INTEGER             ::  return_value               !< return value
    159172
    160173    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
    … …  
    165178    master_rank = master_output_rank
    166179
     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
    167193    debug_output_unit = program_debug_output_unit
    168194    print_debug_output = debug_output
    … …  
    185211
    186212    INTEGER, INTENT(OUT) ::  file_id       !< file ID
    187     INTEGER              ::  my_rank       !< MPI rank of processor
    188213    INTEGER              ::  nc_stat       !< netcdf return value
    189214    INTEGER, INTENT(OUT) ::  return_value  !< return value
    … …  
    199224
    200225#if defined( __netcdf4 )
    201 #if defined( __parallel )
    202        CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    203        IF ( return_value /= 0 )  THEN
    204           CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
    205        ENDIF
    206        IF ( my_rank /= master_rank )  THEN
    207           return_value = 1
    208           CALL internal_message( 'error', routine_name //                                          &
    209                                  ': trying to define a NetCDF file in serial mode by an MPI ' //   &
    210                                  'rank other than the master output rank. Serial NetCDF ' //       &
    211                                  'files can only be defined by the master output rank!' )
    212        ENDIF
    213 #else
    214        my_rank = master_rank
    215        return_value = 0
    216 #endif
    217 
    218        IF ( return_value == 0 )                                                                    &
    219           nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),                         &
    220                                  IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), file_id )
     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
    221236#else
    222237       nc_stat = 0
    … …  
    245260       nc_stat = 0
    246261       return_value = 1
    247        CALL internal_message( 'error', routine_name // ': selected mode "' //                      &
    248                                        TRIM( mode ) // '" must be either "' //                     &
    249                                        mode_serial // '" or "' // mode_parallel // '"' )
     262       CALL internal_message( 'error', routine_name //                                             &
     263                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
     264                              mode_serial // '" or "' // mode_parallel // '"' )
    250265    ENDIF
    251266
    … …  
    266281!> Write attribute to netcdf file.
    267282!--------------------------------------------------------------------------------------------------!
    268  SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name,                         &
     283 SUBROUTINE netcdf4_write_attribute( mode, file_id, variable_id, attribute_name,                   &
    269284                                     value_char, value_int8, value_int16, value_int32,             &
    270285                                     value_real32, value_real64, return_value )
    … …  
    273288
    274289    CHARACTER(LEN=*), INTENT(IN)           ::  attribute_name  !< name of attribute
     290    CHARACTER(LEN=*), INTENT(IN)           ::  mode            !< operation mode (either parallel or serial)
    275291    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  value_char      !< value of attribute
    276292
    … …  
    292308    return_value = 0
    293309
    294     IF ( variable_id == global_id_in_file )  THEN
    295        target_id = NF90_GLOBAL
    296     ELSE
    297        target_id = variable_id
    298     ENDIF
    299 
    300     CALL internal_message( 'debug', routine_name //                                                &
    301                            ': write attribute "' // TRIM( attribute_name ) // '"' )
    302 
    303     IF ( PRESENT( value_char ) )  THEN
    304        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
    305     ELSEIF ( PRESENT( value_int8 ) )  THEN
    306        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
    307     ELSEIF ( PRESENT( value_int16 ) )  THEN
    308        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
    309     ELSEIF ( PRESENT( value_int32 ) )  THEN
    310        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
    311     ELSEIF ( PRESENT( value_real32 ) )  THEN
    312        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
    313     ELSEIF ( PRESENT( value_real64 ) )  THEN
    314        nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
    315     ELSE
    316        return_value = 1
    317        CALL internal_message( 'error', routine_name //                                             &
    318                               ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
    319     ENDIF
    320 
    321     IF ( return_value == 0 )  THEN
    322        IF ( nc_stat /= NF90_NOERR )  THEN
     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
    323334          return_value = 1
    324335          CALL internal_message( 'error', routine_name //                                          &
    325                                  ': NetCDF error while writing attribute "' //                     &
    326                                  TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    327        ENDIF
     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
    328349    ENDIF
    329350#else
    330351    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
    331358#endif
    332359
    … …  
    339366!--------------------------------------------------------------------------------------------------!
    340367 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id,                      &
    341                                     dimension_name, dimension_type, dimension_length, return_value )
     368                                    dimension_name, dimension_type, dimension_length,              &
     369                                    write_only_by_master_rank, return_value )
    342370
    343371    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_dimension'  !< name of this routine
    … …  
    355383    INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
    356384
     385    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
     386
    357387
    358388#if defined( __netcdf4 )
    359389    return_value = 0
    360390    variable_id = -1
    361 
    362     CALL internal_message( 'debug', routine_name //                                                &
    363                            ': init dimension "' // TRIM( dimension_name ) // '"' )
    364 !
    365 !-- Check if dimension is unlimited
    366     IF ( dimension_length < 0 )  THEN
    367        nc_dimension_length = NF90_UNLIMITED
    368     ELSE
    369        nc_dimension_length = dimension_length
    370     ENDIF
    371 !
    372 !-- Define dimension in file
    373     nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
    374 
    375     IF ( nc_stat == NF90_NOERR )  THEN
    376 !
    377 !--    Define variable holding dimension values in file
    378        CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type,     &
    379                                    (/ dimension_id /), is_global=.TRUE., return_value=return_value )
    380 
    381     ELSE
    382        return_value = 1
    383        CALL internal_message( 'error', routine_name //                                             &
    384                               ': NetCDF error while initializing dimension "' //                   &
    385                               TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
     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
    386423    ENDIF
    387424#else
    … …  
    389426    variable_id = -1
    390427    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
    391434#endif
    392435
    … …  
    399442!--------------------------------------------------------------------------------------------------!
    400443 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type,       &
    401                                    dimension_ids, is_global, return_value )
     444                                   dimension_ids, write_only_by_master_rank, return_value )
    402445
    403446    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_variable'  !< name of this routine
    … …  
    407450    CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
    408451
    409     INTEGER, INTENT(IN)  ::  file_id           !< file ID
    410     INTEGER              ::  nc_stat           !< netcdf return value
    411     INTEGER              ::  nc_variable_type  !< netcdf data type
    412     INTEGER, INTENT(OUT) ::  return_value      !< return value
    413     INTEGER, INTENT(OUT) ::  variable_id       !< variable ID
    414 
     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
    415461    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
    416462
    417     LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
     463    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
    418464
    419465
    420466#if defined( __netcdf4 )
    421467    return_value = 0
    422 
    423     WRITE( temp_string, * ) is_global
    424     CALL internal_message( 'debug', routine_name //                                                &
    425                            ': init variable "' // TRIM( variable_name ) //                         &
    426                            '" ( is_global = ' // TRIM( temp_string ) // ')' )
    427 
    428     nc_variable_type = get_netcdf_data_type( variable_type )
    429 
    430     IF ( nc_variable_type /= -1 )  THEN
    431 !
    432 !--    Define variable in file
    433        nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id )
    434 
    435 !
    436 !--    Define how variable can be accessed by PEs in parallel netcdf file
    437        IF ( nc_stat == NF90_NOERR  .AND.  TRIM( mode ) == mode_parallel )  THEN
     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
    438486#if defined( __netcdf4_parallel )
    439           IF ( is_global )  THEN
    440              nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT )
    441           ELSE
    442              nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE )
     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
    443506          ENDIF
    444 #else
    445           CONTINUE
    446 #endif
    447        ENDIF
    448 
    449        IF ( nc_stat /= NF90_NOERR )  THEN
     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
    450517          return_value = 1
    451           CALL internal_message( 'error', routine_name //                                          &
    452                                  ': NetCDF error while initializing variable "' //                 &
    453                                  TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    454        ENDIF
    455 
    456     ELSE
     518       ENDIF
     519
     520    ELSEIF ( TRIM( mode ) /= mode_serial  .AND.  TRIM( mode ) /= mode_parallel )  THEN
    457521       return_value = 1
     522       CALL internal_message( 'error', routine_name //                                             &
     523                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
     524                              mode_serial // '" or "' // mode_parallel // '"' )
    458525    ENDIF
    459526
    … …  
    461528    return_value = 1
    462529    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
    463536#endif
    464537
    … …  
    470543!> Leave file definition state.
    471544!--------------------------------------------------------------------------------------------------!
    472  SUBROUTINE netcdf4_stop_file_header_definition( file_id, return_value )
     545 SUBROUTINE netcdf4_stop_file_header_definition( mode, file_id, return_value )
    473546
    474547    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)
    475550
    476551    INTEGER, INTENT(IN)  ::  file_id        !< file ID
    … …  
    483558    return_value = 0
    484559
    485     WRITE( temp_string, * ) file_id
    486     CALL internal_message( 'debug', routine_name //                                                &
    487                            ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
    488 !
    489 !-- Set general no fill, otherwise the performance drops significantly
    490     nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
    491 
    492     IF ( nc_stat == NF90_NOERR )  THEN
    493        nc_stat = NF90_ENDDEF( file_id )
    494     ENDIF
    495 
    496     IF ( nc_stat /= NF90_NOERR )  THEN
    497        return_value = 1
    498        CALL internal_message( 'error', routine_name //                                             &
    499                               ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
     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
    500579    ENDIF
    501580#else
    502581    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
    503588#endif
    504589
    … …  
    511596!--------------------------------------------------------------------------------------------------!
    512597 SUBROUTINE netcdf4_write_variable(                                                                &
    513                file_id, variable_id, bounds_start, value_counts, bounds_origin,                    &
    514                is_global,                                                                          &
     598               mode, file_id, variable_id, bounds_start, value_counts, bounds_origin,              &
     599               write_only_by_master_rank,                                                          &
    515600               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,               &
    516601               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,               &
    … …  
    525610    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_variable'  !< name of this routine
    526611
     612    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
     613
    527614    CHARACTER(LEN=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_char_0d  !< output variable
    528615    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_char_1d  !< output variable
    … …  
    530617    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_char_3d  !< output variable
    531618
    532     INTEGER              ::  d             !< loop index
    533     INTEGER, INTENT(IN)  ::  file_id       !< file ID
    534     INTEGER              ::  my_rank       !< MPI rank of processor
    535     INTEGER              ::  nc_stat       !< netcdf return value
    536     INTEGER              ::  ndims         !< number of dimensions of variable in file
    537     INTEGER, INTENT(OUT) ::  return_value  !< return value
    538     INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     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
    539626
    540627    INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_origin      !< starting index of each dimension
    … …  
    561648    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
    562649
    563     LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)
     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
    564652
    565653    REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
    … …  
    578666
    579667#if defined( __netcdf4 )
    580 
    581 #if defined( __parallel )
    582     CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    583     IF ( return_value /= 0 )  THEN
    584        CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
    585     ENDIF
    586 #else
    587     my_rank = master_rank
    588668    return_value = 0
    589 #endif
    590 
    591     IF ( return_value == 0  .AND.  ( .NOT. is_global .OR. my_rank == master_rank ) )  THEN
     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
    592708
    593709       WRITE( temp_string, * ) variable_id
    … …  
    595711
    596712       ndims = SIZE( bounds_start )
    597 
    598 !
    599 !--    character output
     713!
     714!--    Character output
    600715       IF ( PRESENT( values_char_0d ) )  THEN
    601716          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /),                      &
    … …  
    723838                                  count = value_counts )
    724839!
    725 !--    working-precision real output
     840!--    Working-precision real output
    726841       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
    727842          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /),                    &
    … …  
    757872             WRITE( temp_string, * )  NF90_STRERROR( nc_stat )
    758873
    759              ALLOCATE( dimension_ids(ndims) )
     874             IF ( .NOT. ALLOCATED( dimension_ids ) )  ALLOCATE( dimension_ids(ndims) )
    760875             ALLOCATE( dimension_lengths(ndims) )
    761876
    … …  
    793908#else
    794909    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
    795918#endif
    796919
    … …  
    802925!> Close netcdf file.
    803926!--------------------------------------------------------------------------------------------------!
    804  SUBROUTINE netcdf4_finalize( file_id, return_value )
     927 SUBROUTINE netcdf4_finalize( mode, file_id, return_value )
    805928
    806929    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_finalize'  !< name of routine
     930
     931    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
    807932
    808933    INTEGER, INTENT(IN)  ::  file_id       !< file ID
    … …  
    812937
    813938#if defined( __netcdf4 )
    814     WRITE( temp_string, * ) file_id
    815     CALL internal_message( 'debug', routine_name //                                                &
    816                            ': close file (file_id=' // TRIM( temp_string ) // ')' )
    817 
    818     nc_stat = NF90_CLOSE( file_id )
    819     IF ( nc_stat == NF90_NOERR )  THEN
    820        return_value = 0
    821     ELSE
    822        return_value = 1
    823        CALL internal_message( 'error', routine_name //                                             &
    824                               ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
     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
    825956    ENDIF
    826957#else
    827958    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
    828965#endif
    829966
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |