Home


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

Changeset 4107 for palm/trunk/SOURCE


Ignore:
Timestamp:
Jul 22, 2019 8:51:35 AM (5 years ago)
Author:
gronemeier
Message:

changes in data-output module (data_output_module.f90, data_output_binary_module.f90, data_output_netcdf4_module.f90, binary_to_netcdf.f90):

  • add support for different output groups of MPI ranks (required for, e.g., nesting runs)
  • revise output messages
Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/data_output_binary_module.f90

    r4106 r4107  
    5656   CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
    5757   CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
    58    CHARACTER(LEN=*), PARAMETER ::  prefix = 'BIN_'                               !< file prefix for binary files
    59 
     58   CHARACTER(LEN=*), PARAMETER ::  file_prefix = 'BIN_'                          !< file prefix for binary files
     59
     60   CHARACTER(LEN=charlen)      ::  file_suffix = ''             !< file suffix added to each file name
    6061   CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
    6162   CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
    … …  
    6566   INTEGER(iwp) ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
    6667   INTEGER(iwp) ::  global_id_in_file = -1          !< value of global ID within a file
     68   INTEGER      ::  master_rank                     !< master rank for tasks to be executed by single PE only
    6769   INTEGER(iwp) ::  next_available_unit             !< next unit number available for new file
     70   INTEGER      ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
    6871
    6972   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id  !< highest assigned ID of variable or dimension in a file
    … …  
    133136!> Initialize data-output module.
    134137!--------------------------------------------------------------------------------------------------!
    135 SUBROUTINE binary_init_module( program_debug_output_unit, debug_output, dom_global_id )
     138SUBROUTINE binary_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
     139                               master_output_rank,                                    &
     140                               program_debug_output_unit, debug_output, dom_global_id )
     141
     142   CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
     143                                                                 !> must be unique for each output group
    136144
    137145   INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
     146   INTEGER,      INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
     147   INTEGER,      INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    138148   INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
    139149
    … …  
    141151
    142152
     153   file_suffix = file_suffix_of_output_group
     154   output_group_comm = mpi_comm_of_output_group
     155   master_rank = master_output_rank
     156
    143157   debug_output_unit = program_debug_output_unit
    144 
    145158   print_debug_output = debug_output
    146159
    147160   global_id_in_file = dom_global_id
    148 
    149161
    150162END SUBROUTINE binary_init_module
    … …  
    159171   CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    160172   CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
    161    CHARACTER(LEN=7)                   ::  myid_char          !< string containing value of myid with leading zeros
     173   CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
    162174   CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
    163175
    … …  
    165177
    166178   INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    167    INTEGER(iwp)              ::  myid          !< id of local processor id (MPI rank)
     179   INTEGER                   ::  my_rank       !< MPI rank of local processor
     180   INTEGER                   ::  nrank         !< number of MPI ranks participating in output
    168181   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    169182
    … …  
    176189
    177190#if defined( __parallel )
    178    CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
     191   CALL MPI_COMM_SIZE( output_group_comm, nrank, return_value )
     192   IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    179193   IF ( return_value == 0 )  THEN
    180       WRITE( myid_char, '("_",I6.6)' )  myid
     194      WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    181195   ELSE
    182       CALL internal_message( 'debug', routine_name // ': MPI_COMM_RANK error' )
     196      CALL internal_message( 'error', routine_name // ': MPI error' )
    183197   ENDIF
    184198#else
    185    myid = 0
    186    myid_char = '_' // REPEAT('0', 6)
     199   nrank = 1
     200   my_rank = master_rank
     201   WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    187202#endif
    188203
    … …  
    196211      config_file_unit = binary_file_lowest_unit
    197212
    198       IF ( myid == 0 )  THEN
     213      IF ( my_rank == master_rank )  THEN
    199214
    200215         !-- Remove any pre-existing file
    201          INQUIRE( FILE=TRIM( config_file_name ), EXIST=file_exists )
     216         INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
     217                  EXIST=file_exists )
    202218
    203219         IF ( file_exists )  THEN
    204             CALL internal_message( 'debug', routine_name //              &
    205                                             ': Remove existing file ' // &
    206                                             TRIM( config_file_name ) )
    207             CALL SYSTEM( 'rm ' // TRIM( config_file_name ) )
     220            CALL internal_message( 'debug', routine_name //     &
     221                                   ': Remove existing file ' // &
     222                                   TRIM( config_file_name ) // TRIM( file_suffix ) )
     223            CALL EXECUTE_COMMAND_LINE(                                                &
     224                    COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), &
     225                    WAIT=.TRUE., EXITSTAT=return_value )
    208226         ENDIF
    209227
    210          OPEN( config_file_unit, FILE=TRIM( config_file_name ), &
     228         OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
    211229               FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
    212230
    … …  
    216234
    217235            !-- Write some general information to config file
    218             WRITE( config_file_unit )  LEN( prefix )
    219             WRITE( config_file_unit )  prefix
     236            WRITE( config_file_unit )  nrank
     237            WRITE( config_file_unit )  master_rank
     238            WRITE( config_file_unit )  LEN( file_prefix )
     239            WRITE( config_file_unit )  file_prefix
    220240            WRITE( config_file_unit )  charlen
    221241            WRITE( config_file_unit )  global_id_in_file
    … …  
    237257   IF ( return_value == 0 )  THEN
    238258
    239       bin_filename = prefix // TRIM( filename ) // myid_char
     259      bin_filename = file_prefix // TRIM( filename ) // TRIM( file_suffix ) // my_rank_char
    240260
    241261      !-- Remove any pre-existing file
    … …  
    245265         CALL internal_message( 'debug', routine_name // &
    246266                                         ': remove existing file ' // TRIM( bin_filename ) )
    247          CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
     267         CALL EXECUTE_COMMAND_LINE( COMMAND='rm ' // TRIM( bin_filename ), &
     268                                    WAIT=.TRUE., EXITSTAT=return_value )
    248269      ENDIF
    249270
    … …  
    256277
    257278         !-- Add filename to config file
    258          IF ( myid == 0 )  THEN
     279         IF ( my_rank == master_rank )  THEN
    259280            WRITE( config_file_unit )  filename
    260281         ENDIF

  • palm/trunk/SOURCE/data_output_module.f90

    r4106 r4107  
    136136
    137137   CHARACTER(LEN=charlen) ::  output_file_format = 'binary'  !< file format (namelist parameter)
     138   CHARACTER(LEN=charlen) ::  output_file_suffix = ''        !< file suffix added to each file name
    138139
    139140   CHARACTER(LEN=800) ::  internal_error_message = '' !< string containing the last error message
    … …  
    142143   INTEGER(iwp) ::  debug_output_unit  !< Fortran Unit Number of the debug-output file
    143144   INTEGER(iwp) ::  nf                 !< number of files
     145   INTEGER      ::  master_rank = 0    !< master rank for tasks to be executed by single PE only
     146   INTEGER      ::  output_group_comm  !< MPI communicator addressing all MPI ranks which participate in output
    144147
    145148   INTEGER(iwp), PARAMETER ::  no_var_id = -1  !< value of var_id if no variable is selected
    … …  
    223226!> Initialize data-output module
    224227!--------------------------------------------------------------------------------------------------!
    225 SUBROUTINE dom_init( program_debug_output_unit, debug_output )
    226 
    227    INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
     228SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &
     229                     program_debug_output_unit, debug_output )
     230
     231   CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  file_suffix_of_output_group  !< file-name suffix added to each file;
     232                                                                           !> must be unique for each output group
     233
     234   INTEGER, INTENT(IN), OPTIONAL ::  master_output_rank         !< MPI rank executing tasks which must
     235                                                                !> be executed by a single PE only
     236   INTEGER, INTENT(IN)           ::  mpi_comm_of_output_group   !< MPI communicator specifying the MPI group
     237                                                                !> which participate in the output
     238   INTEGER, INTENT(IN)           ::  program_debug_output_unit  !< file unit number for debug output
    228239
    229240   LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
    230241
    231242
     243   IF ( PRESENT( file_suffix_of_output_group ) )  output_file_suffix = file_suffix_of_output_group
     244   IF ( PRESENT( master_output_rank ) )  master_rank = master_output_rank
     245
     246   output_group_comm = mpi_comm_of_output_group
     247
    232248   debug_output_unit = program_debug_output_unit
    233 
    234249   print_debug_output = debug_output
    235250
    236    CALL binary_init_module( debug_output_unit, debug_output, no_var_id )
    237 
    238    CALL netcdf4_init_module( debug_output_unit, debug_output, no_var_id )
     251   CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &
     252                            debug_output_unit, debug_output, no_var_id )
     253
     254   CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &
     255                            debug_output_unit, debug_output, no_var_id )
    239256
    240257END SUBROUTINE dom_init

  • palm/trunk/SOURCE/data_output_netcdf4_module.f90

    r4106 r4107  
    5656
    5757   CHARACTER(LEN=800) ::  internal_error_message = ''  !< string containing the last error message
     58   CHARACTER(LEN=100) ::  file_suffix = ''             !< file suffix added to each file name
    5859   CHARACTER(LEN=800) ::  temp_string                  !< dummy string
    5960
    … …  
    6364   INTEGER(iwp) ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
    6465   INTEGER(iwp) ::  global_id_in_file = -1  !< value of global ID within a file
     66   INTEGER      ::  master_rank             !< master rank for tasks to be executed by single PE only
     67   INTEGER      ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
    6568
    6669   LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
    … …  
    126129!> Initialize data-output module.
    127130!--------------------------------------------------------------------------------------------------!
    128 SUBROUTINE netcdf4_init_module( program_debug_output_unit, debug_output, dom_global_id )
     131SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
     132                                master_output_rank,                                    &
     133                                program_debug_output_unit, debug_output, dom_global_id )
     134
     135   CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
     136                                                                 !> must be unique for each output group
    129137
    130138   INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
     139   INTEGER,      INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
     140   INTEGER,      INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    131141   INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
    132142
    … …  
    134144
    135145
     146   file_suffix = file_suffix_of_output_group
     147   output_group_comm = mpi_comm_of_output_group
     148   master_rank = master_output_rank
     149
    136150   debug_output_unit = program_debug_output_unit
    137 
    138151   print_debug_output = debug_output
    139152
    … …  
    155168
    156169   INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
     170   INTEGER                   ::  my_rank       !< MPI rank of processor
    157171   INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    158172   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    … …  
    160174
    161175   return_value = 0
     176   file_id = -1
    162177
    163178   !-- Open new file
    … …  
    167182
    168183#if defined( __netcdf4 )
    169       nc_stat = NF90_CREATE( TRIM( filename ),                    &
    170                              IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &
    171                              file_id )
    172 #else
    173       file_id = -1
     184#if defined( __parallel )
     185      CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
     186      IF ( return_value /= 0 )  THEN
     187         CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
     188      ENDIF
     189      IF ( my_rank /= master_rank )  THEN
     190         return_value = 1
     191         CALL internal_message( 'error', routine_name // &
     192                                ': trying to define a NetCDF file in serial mode by an MPI ' // &
     193                                'rank other than the master output rank. Serial NetCDF ' // &
     194                                'files can only be defined by the master output rank!' )
     195      ENDIF
     196#else
     197      my_rank = master_rank
     198      return_value = 0
     199#endif
     200
     201      IF ( return_value == 0 )  &
     202         nc_stat = NF90_CREATE( TRIM( filename ) // TRIM( file_suffix ), &
     203                                IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &
     204                                file_id )
     205#else
    174206      nc_stat = 0
    175207      return_value = 1
    … …  
    182214
    183215#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
    184       nc_stat = NF90_CREATE( TRIM( filename ),                                       &
     216      nc_stat = NF90_CREATE( TRIM( filename ) // TRIM( file_suffix ),                &
    185217                             IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
    186                              file_id, COMM = MPI_COMM_WORLD, INFO = MPI_INFO_NULL )
    187 #else
    188       file_id = -1
     218                             file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
     219#else
    189220      nc_stat = 0
    190221      return_value = 1
    … …  
    196227
    197228   ELSE
    198       file_id = -1
    199229      nc_stat = 0
    200230      return_value = 1
    … …  
    205235
    206236#if defined( __netcdf4 )
    207    IF ( nc_stat /= NF90_NOERR )  THEN
     237   IF ( nc_stat /= NF90_NOERR  .AND.  return_value == 0 )  THEN
    208238      return_value = 1
    209239      CALL internal_message( 'error', routine_name // ': NetCDF error while opening file "' // &
    … …  
    477507   INTEGER(iwp)              ::  d             !< loop index
    478508   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    479    INTEGER(iwp)              ::  myid          !< id number of processor element
     509   INTEGER                   ::  my_rank       !< MPI rank of processor
    480510   INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    481511   INTEGER(iwp)              ::  ndim          !< number of dimensions of variable in file
    … …  
    532562
    533563#if defined( __parallel )
    534    CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
     564   CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    535565   IF ( return_value /= 0 )  THEN
    536566      CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
    537567   ENDIF
    538568#else
    539    myid = 0
     569   my_rank = master_rank
    540570   return_value = 0
    541571#endif
    542572
    543    IF ( return_value == 0  .AND.  ( .NOT. is_global  .OR.  myid == 0 ) )  THEN
     573   IF ( return_value == 0  .AND.  ( .NOT. is_global  .OR.  my_rank == master_rank ) )  THEN
    544574
    545575      WRITE( temp_string, * ) var_id
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |