Changeset 4107 for palm/trunk/SOURCE/data_output_binary_module.f90

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

File:

• palm/trunk/SOURCE/data_output_binary_module.f90 (modified) (12 diffs)

palm/trunk/SOURCE/data_output_binary_module.f90

@@ -56 +56 @@
    CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
    CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
-   CHARACTER(LEN=*), PARAMETER ::  prefix = 'BIN_'                               !< file prefix for binary files
-
+   CHARACTER(LEN=*), PARAMETER ::  file_prefix = 'BIN_'                          !< file prefix for binary files
+
+   CHARACTER(LEN=charlen)      ::  file_suffix = ''             !< file suffix added to each file name
    CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
    CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
@@ -65 +66 @@
    INTEGER(iwp) ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
    INTEGER(iwp) ::  global_id_in_file = -1          !< value of global ID within a file
+   INTEGER      ::  master_rank                     !< master rank for tasks to be executed by single PE only
    INTEGER(iwp) ::  next_available_unit             !< next unit number available for new file
+   INTEGER      ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
 
    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id  !< highest assigned ID of variable or dimension in a file
@@ -133 +136 @@
 !> Initialize data-output module.
 !--------------------------------------------------------------------------------------------------!
-SUBROUTINE binary_init_module( program_debug_output_unit, debug_output, dom_global_id )
+SUBROUTINE binary_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
+                               master_output_rank,                                    &
+                               program_debug_output_unit, debug_output, dom_global_id )
+
+   CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
+                                                                 !> must be unique for each output group
 
    INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
+   INTEGER,      INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
+   INTEGER,      INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
 
@@ -141 +151 @@
 
 
+   file_suffix = file_suffix_of_output_group
+   output_group_comm = mpi_comm_of_output_group
+   master_rank = master_output_rank
+
    debug_output_unit = program_debug_output_unit
-
    print_debug_output = debug_output
 
    global_id_in_file = dom_global_id
-
 
 END SUBROUTINE binary_init_module
@@ -159 +171 @@
    CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
-   CHARACTER(LEN=7)                   ::  myid_char          !< string containing value of myid with leading zeros
+   CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
    CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
 
@@ -165 +177 @@
 
    INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
-   INTEGER(iwp)              ::  myid          !< id of local processor id (MPI rank)
+   INTEGER                   ::  my_rank       !< MPI rank of local processor
+   INTEGER                   ::  nrank         !< number of MPI ranks participating in output
    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
 
@@ -176 +189 @@
 
 #if defined( __parallel )
-   CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
+   CALL MPI_COMM_SIZE( output_group_comm, nrank, return_value )
+   IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    IF ( return_value == 0 )  THEN
-      WRITE( myid_char, '("_",I6.6)' )  myid
+      WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    ELSE
-      CALL internal_message( 'debug', routine_name // ': MPI_COMM_RANK error' )
+      CALL internal_message( 'error', routine_name // ': MPI error' )
    ENDIF
 #else
-   myid = 0
-   myid_char = '_' // REPEAT('0', 6)
+   nrank = 1
+   my_rank = master_rank
+   WRITE( my_rank_char, '("_",I6.6)' )  my_rank
 #endif
 
@@ -196 +211 @@
       config_file_unit = binary_file_lowest_unit
 
-      IF ( myid == 0 )  THEN
+      IF ( my_rank == master_rank )  THEN
 
          !-- Remove any pre-existing file
-         INQUIRE( FILE=TRIM( config_file_name ), EXIST=file_exists )
+         INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
+                  EXIST=file_exists )
 
          IF ( file_exists )  THEN
-            CALL internal_message( 'debug', routine_name //              &
-                                            ': Remove existing file ' // &
-                                            TRIM( config_file_name ) )
-            CALL SYSTEM( 'rm ' // TRIM( config_file_name ) )
+            CALL internal_message( 'debug', routine_name //     &
+                                   ': Remove existing file ' // &
+                                   TRIM( config_file_name ) // TRIM( file_suffix ) )
+            CALL EXECUTE_COMMAND_LINE(                                                &
+                    COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), &
+                    WAIT=.TRUE., EXITSTAT=return_value )
          ENDIF
 
-         OPEN( config_file_unit, FILE=TRIM( config_file_name ), &
+         OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
                FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
 
@@ -216 +234 @@
 
             !-- Write some general information to config file
-            WRITE( config_file_unit )  LEN( prefix )
-            WRITE( config_file_unit )  prefix
+            WRITE( config_file_unit )  nrank
+            WRITE( config_file_unit )  master_rank
+            WRITE( config_file_unit )  LEN( file_prefix )
+            WRITE( config_file_unit )  file_prefix
             WRITE( config_file_unit )  charlen
             WRITE( config_file_unit )  global_id_in_file
@@ -237 +257 @@
    IF ( return_value == 0 )  THEN
 
-      bin_filename = prefix // TRIM( filename ) // myid_char
+      bin_filename = file_prefix // TRIM( filename ) // TRIM( file_suffix ) // my_rank_char
 
       !-- Remove any pre-existing file
@@ -245 +265 @@
          CALL internal_message( 'debug', routine_name // &
                                          ': remove existing file ' // TRIM( bin_filename ) )
-         CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
+         CALL EXECUTE_COMMAND_LINE( COMMAND='rm ' // TRIM( bin_filename ), &
+                                    WAIT=.TRUE., EXITSTAT=return_value )
       ENDIF
 
@@ -256 +277 @@
 
          !-- Add filename to config file
-         IF ( myid == 0 )  THEN
+         IF ( my_rank == master_rank )  THEN
             WRITE( config_file_unit )  filename
          ENDIF