Home


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

Changeset 4534 for palm


Ignore:
Timestamp:
May 14, 2020 6:35:22 PM (5 years ago)
Author:
raasch
Message:

I/O on reduced number of cores added (using shared memory MPI)

Location:
palm/trunk/SOURCE
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/Makefile

    r4525 r4534  
    2525# -----------------
    2626# $Id$
     27# shared_memory_io_mod included and respective dependencies added
     28#
     29# 4525 2020-05-10 17:05:07Z raasch
    2730# dependency for salsa_mod updated
    2831#
    … …  
    289292        run_control.f90 \
    290293        salsa_mod.f90 \
     294        shared_memory_io_mod.f90 \
    291295        singleton_mod.f90 \
    292296        sor.f90 \
    … …  
    10941098        mod_kinds.o \
    10951099        exchange_horiz_mod.o \
    1096         posix_interface_mod.o
     1100        posix_interface_mod.o \
     1101        shared_memory_io_mod.o
    10971102run_control.o: \
    10981103        cpulog_mod.o \
    … …  
    11181123singleton_mod.o: \
    11191124        mod_kinds.o
     1125shared_memory_io_mod.o: \
     1126        modules.o
    11201127sor.o: \
    11211128        exchange_horiz_mod.o \

  • palm/trunk/SOURCE/check_parameters.f90

    r4514 r4534  
    2525! -----------------
    2626! $Id$
     27! adjustments for I/O on reduced number of cores using shared memory MPI
     28!
     29! 4514 2020-04-30 16:29:59Z suehring
    2730! Enable output of qsurf and ssurf
    2831!
    … …  
    256259!-- Check and set the restart data format variables
    257260    IF ( TRIM( restart_data_format ) /= 'fortran_binary'  .AND.                                    &
    258          TRIM( restart_data_format ) /= 'mpi' )  THEN
     261         TRIM( restart_data_format ) /= 'mpi'             .AND.                                    &
     262         TRIM( restart_data_format ) /= 'mpi_shared_memory' )  THEN
    259263       message_string = 'illegal restart data format "' // TRIM( restart_data_format ) // '"'
    260264       CALL message( 'check_parameters', 'PA....', 1, 2, 0, 6, 0 )
    … …  
    269273
    270274    IF ( TRIM( restart_data_format_input ) /= 'fortran_binary'  .AND.                              &
    271          TRIM( restart_data_format_input ) /= 'mpi' )  THEN
     275         TRIM( restart_data_format_input ) /= 'mpi'             .AND.                              &
     276         TRIM( restart_data_format_input ) /= 'mpi_shared_memory' )  THEN
    272277       message_string = 'illegal restart data input format "' //                                   &
    273278                        TRIM( restart_data_format_input ) // '"'
    … …  
    275280    ENDIF
    276281    IF ( TRIM( restart_data_format_output ) /= 'fortran_binary'  .AND.                             &
    277          TRIM( restart_data_format_output ) /= 'mpi' )  THEN
     282         TRIM( restart_data_format_output ) /= 'mpi'             .AND.                             &
     283         TRIM( restart_data_format_output ) /= 'mpi_shared_memory' )  THEN
    278284       message_string = 'illegal restart data output format "' //                                  &
    279285                        TRIM( restart_data_format_output ) // '"'
     286       CALL message( 'check_parameters', 'PA....', 1, 2, 0, 6, 0 )
     287    ENDIF
     288
     289    IF ( ( TRIM( restart_data_format_input ) == 'mpi_shared_memory'  .AND.                         &
     290           TRIM( restart_data_format_output ) /= 'mpi_shared_memory' )  .OR.                       &
     291         ( TRIM( restart_data_format_input ) /= 'mpi_shared_memory'  .AND.                         &
     292           TRIM( restart_data_format_output ) == 'mpi_shared_memory' ) )  THEN
     293       message_string = 'restart data formats both must be set "mpi_shared_memory"'
    280294       CALL message( 'check_parameters', 'PA....', 1, 2, 0, 6, 0 )
    281295    ENDIF

  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r4517 r4534  
    2525! -----------------
    2626! $Id$
     27! bugfix for switching on restart data output with MPI-IO
     28!
     29! 4517 2020-05-03 14:29:30Z raasch
    2730! added restart with MPI-IO for reading local arrays
    2831!
    … …  
    66606663       ENDDO
    66616664
    6662     ELSEIF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
     6665    ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' )  THEN
    66636666
    66646667       IF ( ALLOCATED( c_liq_av ) )  CALL wrd_mpi_io( 'c_liq_av',  c_liq_av )

  • palm/trunk/SOURCE/read_restart_data_mod.f90

    r4518 r4534  
    2525! -----------------
    2626! $Id$
     27! adjustments for I/O on reduced number of cores using shared memory MPI
     28!
     29! 4518 2020-05-04 15:44:28Z suehring
    2730! Move input of diagnostic output quantities to doq_rrd_local
    2831!
    … …  
    833836       CALL close_file( 13 )
    834837
    835     ELSEIF ( TRIM( restart_data_format_input ) == 'mpi' )  THEN
     838    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
    836839!
    837840!--    Read global restart data using MPI-IO
    … …  
    843846!
    844847!--    Open the MPI-IO restart file.
    845        CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ) )
     848       CALL rd_mpi_io_open( 'read', 'BININ' // TRIM( coupling_char ),                              &
     849                            open_for_global_io_only = .TRUE. )
    846850
    847851!
    … …  
    21582162
    21592163
    2160     ELSEIF ( TRIM( restart_data_format_input ) == 'mpi' )  THEN
     2164    ELSEIF ( restart_data_format_input(1:3) == 'mpi' )  THEN
    21612165
    21622166!

  • palm/trunk/SOURCE/restart_data_mpi_io_mod.f90

    r4500 r4534  
    2424! -----------------
    2525! $Id$
     26! I/O on reduced number of cores added (using shared memory MPI)
     27!
     28! 4500 2020-04-17 10:12:45Z suehring
    2629! Fix too long lines
    2730!
    … …  
    6063
    6164    USE control_parameters,                                                                        &
    62         ONLY:  include_total_domain_boundaries
     65        ONLY:  include_total_domain_boundaries, restart_data_format_input
    6366
    6467    USE exchange_horiz_mod,                                                                        &
    … …  
    7376        ONLY:  comm1dx, comm1dy, comm2d, myid, myidx, myidy, npex, npey, numprocs, pdims
    7477
    75 
    76     IMPLICIT NONE
     78    USE shared_memory_io_mod,                                                                      &
     79        ONLY:  local_boundaries, sm_class
     80
     81
     82    IMPLICIT NONE
     83
     84    CHARACTER(LEN=128) :: io_file_name  !> internal variable to communicate filename between
     85                                        !> different subroutines
     86
     87#if defined( __parallel )
     88    INTEGER(iwp)            ::  ierr                              !< error status of MPI-calls
     89    INTEGER(iwp), PARAMETER ::  rd_offset_kind = MPI_OFFSET_KIND  !< Adress or Offset kind
     90    INTEGER(iwp), PARAMETER ::  rd_status_size = MPI_STATUS_SIZE  !<
     91#else
     92    INTEGER(iwp), PARAMETER ::  rd_offset_kind = C_SIZE_T         !<
     93    INTEGER(iwp), PARAMETER ::  rd_status_size = 1       !< Not required in sequential mode
     94#endif
     95
     96    INTEGER(iwp)            ::  debug_level = 1 !< TODO: replace with standard debug output steering
     97
     98    INTEGER(iwp)            ::  comm_io       !< Communicator for MPI-IO
     99    INTEGER(iwp)            ::  fh            !< MPI-IO file handle
     100#if defined( __parallel )
     101    INTEGER(iwp)            ::  fhs = -1      !< MPI-IO file handle to open file with comm2d always
     102#endif
     103    INTEGER(iwp)            ::  ft_surf = -1  !< MPI filetype surface data
     104#if defined( __parallel )
     105    INTEGER(iwp)            ::  ft_2di_nb     !< MPI filetype 2D array INTEGER no outer boundary
     106    INTEGER(iwp)            ::  ft_2d         !< MPI filetype 2D array REAL with outer boundaries
     107    INTEGER(iwp)            ::  ft_3d         !< MPI filetype 3D array REAL with outer boundaries
     108    INTEGER(iwp)            ::  ft_3dsoil     !< MPI filetype for 3d-soil array
     109#endif
     110    INTEGER(iwp)            ::  glo_start     !< global start index on this PE
     111#if defined( __parallel )
     112    INTEGER(iwp)            ::  local_start   !<
     113#endif
     114    INTEGER(iwp)            ::  nr_iope       !<
     115    INTEGER(iwp)            ::  nr_val        !< local number of values in x and y direction
     116#if defined( __parallel )
     117    INTEGER(iwp)            ::  win_2di
     118    INTEGER(iwp)            ::  win_2dr
     119    INTEGER(iwp)            ::  win_3dr
     120    INTEGER(iwp)            ::  win_3ds
     121    INTEGER(iwp)            ::  win_surf = -1
     122#endif
     123    INTEGER(iwp)            ::  total_number_of_surface_values    !< total number of values for one variable
     124
     125    INTEGER(KIND=rd_offset_kind) ::  array_position   !<
     126    INTEGER(KIND=rd_offset_kind) ::  header_position  !<
     127
     128    INTEGER(iwp), DIMENSION(:,:), POINTER, CONTIGUOUS ::  array_2di  !<
     129
     130    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_end_index     !<
     131    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_start_index   !<
     132    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_global_start  !<
    77133
    78134    LOGICAL ::  all_pes_write                     !< all PEs have data to write
    79135    LOGICAL ::  filetypes_created                 !<
     136    LOGICAL ::  io_on_limited_cores_per_node      !< switch to shared memory MPI-IO
    80137    LOGICAL ::  print_header_now = .TRUE.         !<
    81138    LOGICAL ::  rd_flag                           !< file is opened for read
    82139    LOGICAL ::  wr_flag                           !< file is opened for write
    83140
    84 #if defined( __parallel )
    85     INTEGER(iwp)                     :: ierr                              !< error status of MPI-calls
    86     INTEGER(iwp), PARAMETER          :: rd_offset_kind = MPI_OFFSET_KIND  !< Adress or Offset kind
    87     INTEGER(iwp), PARAMETER          :: rd_status_size = MPI_STATUS_SIZE  !<
    88 #else
    89     INTEGER(iwp), PARAMETER          :: rd_offset_kind = C_SIZE_T         !<
    90     INTEGER(iwp), PARAMETER          :: rd_status_size = 1       !< Not required in sequential mode
    91 #endif
    92 
    93     INTEGER(iwp)                     :: debug_level = 1 !< TODO: replace with standard debug output steering
    94 
    95     INTEGER(iwp)                     :: fh            !< MPI-IO file handle
    96     INTEGER(iwp)                     :: ft_surf = -1  !< MPI filetype surface data
    97 #if defined( __parallel )
    98     INTEGER(iwp)                     :: ft_2di_nb     !< MPI filetype 2D array INTEGER no outer boundary
    99     INTEGER(iwp)                     :: ft_2d         !< MPI filetype 2D array REAL with outer boundaries
    100     INTEGER(iwp)                     :: ft_3d         !< MPI filetype 3D array REAL with outer boundaries
    101     INTEGER(iwp)                     :: ft_3dsoil     !< MPI filetype for 3d-soil array
    102 #endif
    103     INTEGER(iwp)                     :: glo_start     !< global start index on this PE
    104     INTEGER(iwp)                     :: nr_val        !< local number of values in x and y direction
    105     INTEGER(iwp)                     :: total_number_of_surface_values    !< total number of values for one variable
    106 
    107     INTEGER(KIND=rd_offset_kind) ::  array_position   !<
    108     INTEGER(KIND=rd_offset_kind) ::  header_position  !<
    109 
    110     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_end_index     !<
    111     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_start_index   !<
    112     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_global_start  !<
    113 
    114141    REAL(KIND=wp) ::  mb_processed  !<
    115142
     143#if defined( __parallel )
     144    REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS     ::  array_1d       !<
     145#endif
     146    REAL(wp), DIMENSION(:,:), POINTER, CONTIGUOUS   ::  array_2d       !<
     147    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3d       !<
     148    REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS ::  array_3d_soil  !<
     149
    116150!
    117151!-- Handling of outer boundaries
    118     TYPE local_boundaries
    119        INTEGER(iwp) ::  nnx
    120        INTEGER(iwp) ::  nny
    121        INTEGER(iwp) ::  nx
    122        INTEGER(iwp) ::  nxl
    123        INTEGER(iwp) ::  nxr
    124        INTEGER(iwp) ::  ny
    125        INTEGER(iwp) ::  nyn
    126        INTEGER(iwp) ::  nys
    127     END TYPE local_boundaries
    128 
    129152    TYPE(local_boundaries) ::  lb  !<
    130153
    … …  
    144167    TYPE(general_header), TARGET ::  tgh
    145168
     169    TYPE(sm_class)               ::  sm_io
     170
    146171!
    147172!-- Declaration of varibales for file header section
    … …  
    250275!> Open restart file for read or write with MPI-IO
    251276!--------------------------------------------------------------------------------------------------!
    252  SUBROUTINE rd_mpi_io_open( action, file_name )
     277 SUBROUTINE rd_mpi_io_open( action, file_name, open_for_global_io_only )
    253278
    254279    IMPLICIT NONE
    … …  
    266291#endif
    267292
     293    LOGICAL, INTENT(IN), OPTIONAL ::  open_for_global_io_only          !<
     294    LOGICAL                       ::  set_filetype                     !<
     295
    268296#if ! defined( __parallel )
    269297    TYPE(C_PTR)                   ::  buf_ptr                          !<
    … …  
    275303    rd_flag = ( TRIM( action ) == 'READ'  .OR. TRIM( action ) == 'read'  )
    276304    wr_flag = ( TRIM( action ) == 'WRITE' .OR. TRIM( action ) == 'write' )
     305
     306!
     307!-- Store name of I/O file to communicate it internally within this module.
     308    io_file_name = file_name
     309!
     310!-- Setup for IO on a limited number of threads per node (using shared memory MPI)
     311    IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' )  THEN
     312       io_on_limited_cores_per_node = .TRUE.
     313       set_filetype                 = .TRUE.
     314    ENDIF
     315!
     316!-- Shared memory MPI is not used for reading of global data
     317    IF ( PRESENT( open_for_global_io_only )  .AND.  rd_flag )  THEN
     318       IF ( open_for_global_io_only )  THEN
     319          io_on_limited_cores_per_node = .FALSE.
     320          set_filetype                 = .FALSE.
     321       ENDIF
     322    ENDIF
     323
     324    CALL sm_io%sm_init_comm( io_on_limited_cores_per_node )
     325
     326!
     327!-- Set communicator to be used. If all cores are doing I/O, comm2d is used as usual.
     328    IF( sm_io%is_sm_active() )  THEN
     329       comm_io = sm_io%comm_io
     330    ELSE
     331       comm_io = comm2d
     332    ENDIF
    277333
    278334!
    … …  
    284340!-- further below.
    285341    IF ( wr_flag)  THEN
    286        CALL rs_mpi_io_create_filetypes
     342       CALL rd_mpi_io_create_filetypes
    287343       filetypes_created = .TRUE.
    288344    ENDIF
    … …  
    291347!-- Open file for MPI-IO
    292348#if defined( __parallel )
    293     IF ( rd_flag )  THEN
    294        CALL MPI_FILE_OPEN( comm2d, TRIM( file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh, ierr )
    295        WRITE (9,*) 'Open MPI-IO restart file for read  ==> ', TRIM( file_name )
    296     ELSEIF ( wr_flag )  THEN
    297        CALL MPI_FILE_OPEN( comm2d, TRIM( file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY,             &
    298                            MPI_INFO_NULL, fh, ierr )
    299        WRITE (9,*) 'Open MPI-IO restart file for write ==> ', TRIM( file_name )
    300     ELSE
    301        CALL rs_mpi_io_error( 1 )
     349    IF ( sm_io%iam_io_pe )  THEN
     350       IF ( rd_flag )  THEN
     351          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh,   &
     352                              ierr )
     353          WRITE (9,*) 'Open MPI-IO restart file for read  ==> ', TRIM( io_file_name )
     354       ELSEIF ( wr_flag )  THEN
     355          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY,      &
     356                              MPI_INFO_NULL, fh, ierr )
     357          WRITE (9,*) 'Open MPI-IO restart file for write ==> ', TRIM( io_file_name )
     358       ELSE
     359          CALL rd_mpi_io_error( 1 )
     360       ENDIF
    302361    ENDIF
    303362#else
    304363    IF ( rd_flag )  THEN
    305        fh = posix_open( TRIM( file_name ), .TRUE. )
    306        WRITE (9,*) 'Open sequential restart file for read  ==> ', TRIM( file_name ), ' ', fh
     364       fh = posix_open( TRIM( io_file_name ), .TRUE. )
     365       WRITE (9,*) 'Open sequential restart file for read  ==> ', TRIM( io_file_name ), ' ', fh
    307366    ELSEIF ( wr_flag )  THEN
    308        fh = posix_open( TRIM( file_name ), .FALSE. )
    309        WRITE (9,*) 'Open sequential restart file for write ==> ', TRIM(file_name), ' ', fh
     367       fh = posix_open( TRIM( io_file_name ), .FALSE. )
     368       WRITE (9,*) 'Open sequential restart file for write ==> ', TRIM( io_file_name ), ' ', fh
    310369    ELSE
    311        CALL rs_mpi_io_error( 1 )
    312     ENDIF
    313 
    314     IF ( fh < 0 )  CALL rs_mpi_io_error( 6 )
     370       CALL rd_mpi_io_error( 1 )
     371    ENDIF
     372
     373    IF ( fh < 0 )  CALL rd_mpi_io_error( 6 )
    315374#endif
    316375
    … …  
    347406
    348407    IF ( rd_flag )  THEN
    349 !
    350 !--    File is open for read.
    351 #if defined( __parallel )
    352 !--    Set the default view
    353        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    354 !
    355 !--    Read the file header size
    356        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    357        CALL MPI_FILE_READ( fh, tgh, gh_size, MPI_BYTE, status, ierr )
     408       IF ( sm_io%iam_io_pe )  THEN
     409!
     410!--       File is open for read.
     411#if defined( __parallel )
     412!--       Set the default view
     413          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     414!
     415!--       Read the file header size
     416          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     417          CALL MPI_FILE_READ( fh, tgh, gh_size, MPI_BYTE, status, ierr )
    358418#else
    359        CALL posix_lseek( fh, header_position )
    360        buf_ptr = C_LOC( tgh )
    361        CALL posix_read( fh, buf_ptr, gh_size )
     419          CALL posix_lseek( fh, header_position )
     420          buf_ptr = C_LOC( tgh )
     421          CALL posix_read( fh, buf_ptr, gh_size )
     422#endif
     423       ENDIF
     424#if defined( __parallel )
     425       IF ( sm_io%is_sm_active() )  THEN
     426          CALL MPI_BCAST( tgh, gh_size, MPI_BYTE, 0, sm_io%comm_shared, ierr )
     427       ENDIF
    362428#endif
    363429       header_position = header_position + gh_size
    … …  
    368434!--    File types depend on if boundaries of the total domain is included in data. This has been
    369435!--    checked with the previous statement.
    370        CALL rs_mpi_io_create_filetypes
    371        filetypes_created = .TRUE.
    372 
    373 #if defined( __parallel )
    374 !
    375 !--    Read INTEGER values
    376        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    377        CALL MPI_FILE_READ( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
    378        header_position = header_position + SIZE( int_names ) * 32
    379 
    380        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    381        CALL MPI_FILE_READ (fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
    382        header_position = header_position + SIZE( int_values ) * iwp
    383 !
    384 !--    Character entries
    385        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    386        CALL MPI_FILE_READ( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
    387        header_position = header_position+size(text_lines) * 128
    388 !
    389 !--    REAL values
    390        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    391        CALL MPI_FILE_READ( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
    392        header_position = header_position + SIZE( real_names ) * 32
    393 
    394        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    395        CALL MPI_FILE_READ( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
    396        header_position = header_position + SIZE( real_values ) * wp
    397 !
    398 !--    2d- and 3d-array headers
    399        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    400        CALL MPI_FILE_READ( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
    401        header_position = header_position + SIZE( array_names ) * 32
    402 
    403        CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    404        CALL MPI_FILE_READ( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE,     &
    405                            status,ierr )   ! there is no I*8 datatype in Fortran
    406        header_position = header_position + SIZE( array_offset ) * rd_offset_kind
     436       IF ( set_filetype )  THEN
     437          CALL rd_mpi_io_create_filetypes
     438          filetypes_created = .TRUE.
     439       ENDIF
     440
     441       IF ( sm_io%iam_io_pe )  THEN
     442#if defined( __parallel )
     443!
     444!--       Read INTEGER values
     445          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     446          CALL MPI_FILE_READ( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
     447          header_position = header_position + SIZE( int_names ) * 32
     448
     449          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     450          CALL MPI_FILE_READ (fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
     451          header_position = header_position + SIZE( int_values ) * iwp
     452!
     453!--       Character entries
     454          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     455          CALL MPI_FILE_READ( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
     456          header_position = header_position+size(text_lines) * 128
     457!
     458!--       REAL values
     459          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     460          CALL MPI_FILE_READ( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
     461          header_position = header_position + SIZE( real_names ) * 32
     462
     463          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     464          CALL MPI_FILE_READ( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
     465          header_position = header_position + SIZE( real_values ) * wp
     466!
     467!--       2d- and 3d-array headers
     468          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     469          CALL MPI_FILE_READ( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
     470          header_position = header_position + SIZE( array_names ) * 32
     471
     472          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
     473          CALL MPI_FILE_READ( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE,  &
     474                              status,ierr )   ! there is no I*8 datatype in Fortran
     475          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
    407476#else
    408        CALL posix_lseek( fh, header_position )
    409        CALL posix_read( fh, int_names )
    410        header_position = header_position + SIZE( int_names ) * 32
    411 
    412        CALL posix_lseek( fh, header_position )
    413        CALL posix_read( fh, int_values, SIZE( int_values ) )
    414        header_position = header_position + SIZE( int_values ) * iwp
    415 !
    416 !--    Character entries
    417        CALL posix_lseek( fh, header_position )
    418        CALL posix_read( fh, text_lines )
    419        header_position = header_position + SIZE( text_lines ) * 128
    420 !
    421 !--    REAL values
    422        CALL posix_lseek( fh, header_position )
    423        CALL posix_read( fh, real_names )
    424        header_position = header_position + SIZE( real_names ) * 32
    425 
    426        CALL posix_lseek( fh, header_position )
    427        CALL posix_read( fh, real_values, SIZE( real_values ) )
    428        header_position = header_position + SIZE( real_values ) * wp
    429 !
    430 !--    2d- and 3d-array headers
    431        CALL posix_lseek( fh, header_position )
    432        CALL posix_read( fh, array_names )
    433        header_position = header_position + SIZE( array_names ) * 32
    434 
    435        CALL posix_lseek( fh, header_position )
    436        CALL posix_read( fh, array_offset, SIZE( array_offset ) ) ! there is no I*8 datatype in Fortran
    437        header_position = header_position + SIZE( array_offset ) * rd_offset_kind
    438 #endif
    439        IF ( debug_level >= 2 )  THEN
    440           WRITE (9,*) 'header positio after array metadata  ', header_position
    441        ENDIF
    442 
    443        IF ( print_header_now )  CALL rs_mpi_io_print_header
     477          CALL posix_lseek( fh, header_position )
     478          CALL posix_read( fh, int_names )
     479          header_position = header_position + SIZE( int_names ) * 32
     480
     481          CALL posix_lseek( fh, header_position )
     482          CALL posix_read( fh, int_values, SIZE( int_values ) )
     483          header_position = header_position + SIZE( int_values ) * iwp
     484!
     485!--       Character entries
     486          CALL posix_lseek( fh, header_position )
     487          CALL posix_read( fh, text_lines )
     488          header_position = header_position + SIZE( text_lines ) * 128
     489!
     490!--       REAL values
     491          CALL posix_lseek( fh, header_position )
     492          CALL posix_read( fh, real_names )
     493          header_position = header_position + SIZE( real_names ) * 32
     494
     495          CALL posix_lseek( fh, header_position )
     496          CALL posix_read( fh, real_values, SIZE( real_values ) )
     497          header_position = header_position + SIZE( real_values ) * wp
     498!
     499!--       2d- and 3d-array headers
     500          CALL posix_lseek( fh, header_position )
     501          CALL posix_read( fh, array_names )
     502          header_position = header_position + SIZE( array_names ) * 32
     503
     504          CALL posix_lseek( fh, header_position )
     505          CALL posix_read( fh, array_offset, SIZE( array_offset ) ) ! there is no I*8 datatype in Fortran
     506          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
     507#endif
     508          IF ( debug_level >= 2 )  THEN
     509             WRITE (9,*) 'header positio after array metadata  ', header_position
     510          ENDIF
     511
     512          IF ( print_header_now )  CALL rd_mpi_io_print_header
     513
     514       ENDIF
     515
     516#if defined( __parallel )
     517!
     518!--    Broadcast header to all remaining cores that are not involved in I/O
     519       IF ( sm_io%is_sm_active() )  THEN
     520!
     521!--        Not sure, that it is possible to broadcast CHARACTER array in one MPI_Bcast call
     522           DO  i = 1, SIZE( int_names )
     523              CALL MPI_BCAST( int_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
     524           ENDDO
     525           CALL MPI_BCAST( int_values, SIZE( int_values ), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
     526
     527           DO  i = 1, SIZE( text_lines )
     528              CALL MPI_BCAST( text_lines(i), 128, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
     529           ENDDO
     530
     531           DO  i = 1, SIZE( real_names )
     532              CALL MPI_BCAST( real_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
     533           ENDDO
     534           CALL MPI_BCAST( real_values, SIZE( real_values ), MPI_REAL, 0, sm_io%comm_shared, ierr )
     535
     536           DO  i = 1, SIZE( array_names )
     537              CALL MPI_BCAST( array_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
     538           ENDDO
     539           CALL MPI_BCAST( array_offset, SIZE( array_offset )*8, MPI_BYTE, 0, sm_io%comm_shared,   &
     540                           ierr )  ! there is no I*8 datatype in Fortran (array_offset is I*8!)
     541
     542           CALL MPI_BCAST( header_position, rd_offset_kind, MPI_BYTE, 0, sm_io%comm_shared, ierr )
     543
     544       ENDIF
     545#endif
    444546
    445547    ENDIF
    … …  
    515617    IF ( .NOT. lo_found )  THEN
    516618       WRITE(9,*)  'INTEGER not found ', name
    517        CALL rs_mpi_io_error( 3 )
     619       CALL rd_mpi_io_error( 3 )
    518620    ENDIF
    519621
    … …  
    560662    IF ( .NOT. lo_found )  THEN
    561663       WRITE(9,*) 'REAL value not found ', name
    562        CALL rs_mpi_io_error(3)
     664       CALL rd_mpi_io_error(3)
    563665    ENDIF
    564666
    … …  
    586688
    587689    REAL(wp), INTENT(INOUT), DIMENSION(nysg:nyng,nxlg:nxrg) ::  data
    588 
    589     REAL(KIND=wp), DIMENSION(lb%nxl:lb%nxr,lb%nys:lb%nyn)   ::  array_2d
    590690
    591691
    … …  
    600700    ENDDO
    601701
    602      IF ( found )  THEN
    603 #if defined( __parallel )
    604         CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
    605         CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
     702    IF ( found )  THEN
     703#if defined( __parallel )
     704       CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     705       IF ( sm_io%iam_io_pe )  THEN
     706          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL,   &
     707                                  ierr )
     708          CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
     709       ENDIF
     710       CALL sm_io%sm_node_barrier()
    606711#else
    607         CALL posix_lseek( fh, array_position )
    608         CALL posix_read( fh, array_2d, SIZE( array_2d ) )
    609 #endif
    610 
    611         IF ( include_total_domain_boundaries)  THEN
    612            DO  i = lb%nxl, lb%nxr
    613               data(lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_2d(i,lb%nys:lb%nyn)
    614            ENDDO
    615            IF ( debug_level >= 2)  WRITE(9,*) 'r2f_ob ', TRIM(name),' ', SUM( data(nys:nyn,nxl:nxr) )
    616         ELSE
    617            DO  i = nxl, nxr
    618               data(nys:nyn,i) = array_2d(i,nys:nyn)
    619            ENDDO
    620            IF ( debug_level >= 2) WRITE(9,*) 'r2f ', TRIM( name ),' ', SUM( data)
    621         ENDIF
    622 
    623         CALL exchange_horiz_2d( data )
    624 
    625      ELSE
    626         WRITE(9,*) 'array_2D not found ', name
    627         CALL rs_mpi_io_error( 2 )
    628      ENDIF
     712       CALL posix_lseek( fh, array_position )
     713       CALL posix_read( fh, array_2d, SIZE( array_2d ) )
     714#endif
     715
     716       IF ( include_total_domain_boundaries)  THEN
     717          DO  i = lb%nxl, lb%nxr
     718             data(lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_2d(i,lb%nys:lb%nyn)
     719          ENDDO
     720          IF ( debug_level >= 2)  WRITE(9,*) 'r2f_ob ', TRIM(name),' ', SUM( data(nys:nyn,nxl:nxr) )
     721       ELSE
     722          DO  i = nxl, nxr
     723             data(nys:nyn,i) = array_2d(i,nys:nyn)
     724          ENDDO
     725          IF ( debug_level >= 2) WRITE(9,*) 'r2f ', TRIM( name ),' ', SUM( data(nys:nyn,nxl:nxr) )
     726       ENDIF
     727
     728       CALL exchange_horiz_2d( data )
     729
     730    ELSE
     731       WRITE(9,*) 'array_2D not found ', name
     732       CALL rd_mpi_io_error( 2 )
     733    ENDIF
    629734
    630735 END SUBROUTINE rrd_mpi_io_real_2d
    … …  
    649754    INTEGER, DIMENSION(rd_status_size)  ::  status
    650755#endif
    651 
    652     INTEGER, DIMENSION(nxl:nxr,nys:nyn) ::  array_2d
    653756
    654757    INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:,:) ::  data
    … …  
    675778!--                  would be dimensioned in the caller subroutine like this:
    676779!--                  INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg)::  data
    677           CALL rs_mpi_io_error( 2 )
     780          CALL rd_mpi_io_error( 2 )
    678781
    679782       ELSEIF ( (nxr-nxl+1) == SIZE( data, 2 ) )  THEN
    … …  
    684787
    685788#if defined( __parallel )
    686           CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',            &
    687                                   MPI_INFO_NULL, ierr )
    688           CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d), MPI_INTEGER, status, ierr )
     789          CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
     790          IF ( sm_io%iam_io_pe )  THEN
     791             CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',         &
     792                                     MPI_INFO_NULL, ierr )
     793             CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_INTEGER, status, ierr )
     794          ENDIF
     795          CALL sm_io%sm_node_barrier()
    689796#else
    690797          CALL posix_lseek( fh, array_position )
    691           CALL posix_read( fh, array_2d, SIZE( array_2d ) )
     798          CALL posix_read( fh, array_2di, SIZE( array_2di ) )
    692799#endif
    693800
    694801          DO  j = nys, nyn
    695802             DO  i = nxl, nxr
    696                 data(j-nys+1,i-nxl+1) = array_2d(i,j)
     803                data(j-nys+1,i-nxl+1) = array_2di(i,j)
    697804             ENDDO
    698805          ENDDO
    699806
    700           IF ( debug_level >= 2 )  WRITE(9,*) 'r2i ', TRIM( name ),' ', SUM( array_2d )
     807          IF ( debug_level >= 2 )  WRITE(9,*) 'r2i ', TRIM( name ),' ', SUM( array_2di )
    701808
    702809       ELSE
    703810          WRITE (9,*) '### rrd_mpi_io_int_2d  array: ', TRIM( name )
    704           CALL rs_mpi_io_error( 4 )
     811          CALL rd_mpi_io_error( 4 )
    705812       ENDIF
    706813
    … …  
    708815
    709816       WRITE(9,*) 'array_2D not found ', name
    710        CALL rs_mpi_io_error( 2 )
     817       CALL rd_mpi_io_error( 2 )
    711818
    712819    ENDIF
    … …  
    734841
    735842    LOGICAL                            ::  found
    736 
    737     REAL(KIND=wp), DIMENSION(nzb:nzt+1,lb%nxl:lb%nxr,lb%nys:lb%nyn)   ::  array_3d
    738843
    739844    REAL(wp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  data
    … …  
    752857    IF ( found )  THEN
    753858#if defined( __parallel )
    754        CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
    755        CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
     859       CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     860       IF( sm_io%iam_io_pe )  THEN
     861          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL,    &
     862                                  ierr )
     863          CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
     864       ENDIF
     865       CALL sm_io%sm_node_barrier()
    756866#else
    757867       CALL posix_lseek( fh, array_position )
    … …  
    767877             data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
    768878          ENDDO
    769           IF ( debug_level >= 2 )  WRITE(9,*) 'r3f ', TRIM( name ),' ', SUM( data )
     879          IF ( debug_level >= 2 )  WRITE(9,*) 'r3f ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
    770880       ENDIF
    771881
    … …  
    774884    ELSE
    775885       WRITE(9,*)  'array_3D not found ', name
    776        CALL rs_mpi_io_error(2)
     886       CALL rd_mpi_io_error(2)
    777887    ENDIF
    778888
    … …  
    803913
    804914    LOGICAL                            ::  found
    805 
    806     REAL(KIND=wp), DIMENSION(nzb_soil:nzt_soil,lb%nxl:lb%nxr,lb%nys:lb%nyn)   ::  array_3d
    807915
    808916    REAL(wp), INTENT(INOUT), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ::  data
    … …  
    822930#if defined( __parallel )
    823931       CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
    824        CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL,   &
    825                                ierr )
    826        CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
    827        CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
     932       CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     933       IF ( sm_io%iam_io_pe )  THEN
     934          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL,&
     935                                  ierr )
     936          CALL MPI_FILE_READ_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
     937          CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
     938       ENDIF
     939       CALL sm_io%sm_node_barrier()
    828940#else
    829941       CALL posix_lseek( fh, array_position )
    830        CALL posix_read( fh, array_3d, SIZE( array_3d ) )
     942       CALL posix_read( fh, array_3d_soil, SIZE( array_3d_soil ) )
    831943#endif
    832944       IF ( include_total_domain_boundaries )  THEN
    … …  
    844956    ELSE
    845957       WRITE(9,*)  'array_3D not found ', name
    846        CALL rs_mpi_io_error( 2 )
     958       CALL rd_mpi_io_error( 2 )
    847959    ENDIF
    848960
    … …  
    8901002    IF ( .NOT. lo_found )  THEN
    8911003       WRITE(9,*)  'Character variable not found ', name
    892          CALL rs_mpi_io_error( 3 )
     1004       CALL rd_mpi_io_error( 3 )
    8931005    ENDIF
    8941006
    … …  
    9751087    INTEGER, DIMENSION(rd_status_size) ::  status
    9761088#endif
    977 
    978     REAL(KIND=wp), DIMENSION(lb%nxl:lb%nxr,lb%nys:lb%nyn)  :: array_2d
    9791089
    9801090    REAL(wp), INTENT(IN), DIMENSION(nysg:nyng,nxlg:nxrg)    :: data
    … …  
    9981108          array_2d(i,lb%nys:lb%nyn) = data(nys:nyn,i)
    9991109       ENDDO
    1000        IF ( debug_level >= 2 )  WRITE(9,*)  'w2f ', TRIM( name ),' ', SUM( array_2d )
    1001     ENDIF
    1002 
    1003 #if defined( __parallel )
    1004     CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
    1005     CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
     1110       IF ( debug_level >= 2 )  WRITE(9,*)  'w2f ', TRIM( name ),' ',                              &
     1111                                            SUM( array_2d(nxl:nxr, lb%nys:lb%nyn) )
     1112    ENDIF
     1113
     1114#if defined( __parallel )
     1115    CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     1116    IF ( sm_io%iam_io_pe )  THEN
     1117       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
     1118       CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
     1119    ENDIF
     1120    CALL sm_io%sm_node_barrier()
    10061121#else
    10071122    CALL posix_lseek( fh, array_position )
    … …  
    10361151#endif
    10371152    INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:,:) ::  data
    1038     INTEGER, DIMENSION(nxl:nxr,nys:nyn)           ::  array_2d
    10391153
    10401154    LOGICAl, OPTIONAL                             ::  ar_found
    … …  
    10511165!--    INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) ::  data
    10521166       WRITE (9,*) '### wrd_mpi_io_int_2d  IF  array: ', TRIM( name )
    1053        CALL rs_mpi_io_error( 4 )
     1167       CALL rd_mpi_io_error( 4 )
    10541168
    10551169    ELSEIF ( ( nxr-nxl+1 ) == SIZE( data, 2 ) )  THEN
    … …  
    10601174       DO  j = nys, nyn
    10611175          DO  i = nxl, nxr
    1062              array_2d(i,j) = data(j-nys+1,i-nxl+1)
     1176             array_2di(i,j) = data(j-nys+1,i-nxl+1)
    10631177          ENDDO
    10641178       ENDDO
    1065        IF ( debug_level >= 2 )  WRITE(9,*) 'w2i ', TRIM( name ), ' ', SUM( array_2d )
    1066 #if defined( __parallel )
    1067        CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', MPI_INFO_NULL,&
    1068                                ierr )
    1069        CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d ), MPI_INTEGER, status, ierr )
     1179       IF ( debug_level >= 2 )  WRITE(9,*) 'w2i ', TRIM( name ), ' ', SUM( array_2di(nxl:nxr,nys:nyn) ), SUM( data )
     1180#if defined( __parallel )
     1181       CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     1182       IF ( sm_io%iam_io_pe )  THEN
     1183          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native',            &
     1184                                  MPI_INFO_NULL, ierr )
     1185          CALL MPI_FILE_WRITE_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
     1186       ENDIF
     1187       CALL sm_io%sm_node_barrier()
    10701188#else
    10711189       CALL posix_lseek( fh, array_position )
    1072        CALL posix_write( fh, array_2d, SIZE( array_2d ) )
     1190       CALL posix_write( fh, array_2di, SIZE( array_2di ) )
    10731191#endif
    10741192!
    … …  
    10801198    ELSE
    10811199       WRITE (9,*) '### wrd_mpi_io_int_2d  array: ', TRIM( name )
    1082        CALL rs_mpi_io_error( 4 )
     1200       CALL rd_mpi_io_error( 4 )
    10831201    ENDIF
    10841202
    … …  
    11051223#endif
    11061224    REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  ::  data
    1107 
    1108     REAL(KIND=wp), DIMENSION(nzb:nzt+1,lb%nxl:lb%nxr,lb%nys:lb%nyn) ::  array_3d
    11091225
    11101226
    … …  
    11301246           array_3d(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
    11311247       ENDDO
    1132        IF ( debug_level >= 2 )  WRITE(9,*)  'w3f ', TRIM( name ),' ', SUM( array_3d )
    1133     ENDIF
    1134 #if defined( __parallel )
    1135     CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
    1136     CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
     1248       IF ( debug_level >= 2 )  WRITE(9,*)  'w3f ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
     1249    ENDIF
     1250#if defined( __parallel )
     1251    CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     1252    IF ( sm_io%iam_io_pe )  THEN
     1253       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
     1254       CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
     1255    ENDIF
     1256    CALL sm_io%sm_node_barrier()
    11371257#else
    11381258    CALL posix_lseek( fh, array_position )
    … …  
    11731293    REAL(wp), INTENT(IN), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg)  ::  data
    11741294
    1175     REAL(KIND=wp), DIMENSION(nzb_soil:nzt_soil,lb%nxl:lb%nxr,lb%nys:lb%nyn) ::  array_3d
    1176 
    11771295
    11781296    array_names(header_arr_index)  = name
    11791297    array_offset(header_arr_index) = array_position
    11801298    header_arr_index = header_arr_index + 1
     1299
     1300#if defined( __parallel )
     1301    CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
     1302#endif
    11811303
    11821304    IF ( include_total_domain_boundaries)  THEN
    … …  
    11881310!--    For this reason, the original PALM data need to be swaped.
    11891311       DO  i = lb%nxl, lb%nxr
    1190           array_3d(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
     1312          array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
    11911313       ENDDO
    11921314       IF ( debug_level >= 2 )  WRITE(9,*) 'w3f_ob_soil ', TRIM( name ), ' ', SUM( data(:,nys:nyn,nxl:nxr) )
    … …  
    11951317!--    Prepare output of 3d-REAL-array without ghost layers
    11961318       DO  i = nxl, nxr
    1197           array_3d(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
     1319          array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
    11981320       ENDDO
    11991321       IF ( debug_level >= 2 )  WRITE(9,*) 'w3f_soil ', TRIM( name ), ' ', SUM( array_3d )
    12001322    ENDIF
    12011323#if defined( __parallel )
    1202     CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
    1203     CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL, ierr )
    1204     CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
    1205     CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
     1324    CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     1325    IF ( sm_io%iam_io_pe )  THEN
     1326       CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL,   &
     1327                               ierr )
     1328       CALL MPI_FILE_WRITE_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
     1329    ENDIF
     1330    CALL sm_io%sm_node_barrier()
    12061331#else
    12071332    CALL posix_lseek( fh, array_position )
    1208     CALL posix_write( fh, array_3d, SIZE( array_3d ) )
     1333    CALL posix_write( fh, array_3d_soil, SIZE( array_3d_soil ) )
    12091334#endif
    12101335!
    … …  
    13091434!--    Set default view
    13101435#if defined( __parallel )
    1311        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    1312        CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
    1313        CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
     1436       IF ( sm_io%iam_io_pe )  THEN
     1437          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1438          CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
     1439          CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
     1440       ENDIF
     1441       IF ( sm_io%is_sm_active() )  THEN
     1442          CALL MPI_BCAST( data, SIZE(data), MPI_REAL, 0, sm_io%comm_shared, ierr )
     1443       ENDIF
    13141444#else
    13151445       CALL posix_lseek( fh, array_position )
    … …  
    13191449    ELSE
    13201450       WRITE(9,*)  'replicated array_1D not found ', name
    1321        CALL rs_mpi_io_error( 2 )
     1451       CALL rd_mpi_io_error( 2 )
    13221452    ENDIF
    13231453
    … …  
    14591589!--    Set default view
    14601590#if defined( __parallel )
    1461        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    1462        CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
    1463        CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
     1591       IF ( sm_io%iam_io_pe )  THEN
     1592          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1593          CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
     1594          CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
     1595       ENDIF
     1596       IF ( sm_io%is_sm_active() )  THEN
     1597          CALL MPI_BCAST( data, SIZE(data), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
     1598       ENDIF
    14641599#else
    14651600       CALL posix_lseek( fh, array_position )
    … …  
    14721607       ELSE
    14731608          WRITE (9,*) '### rrd_mpi_io_global_array_int_1d ', TRIM( name )
    1474           CALL rs_mpi_io_error( 4 )
     1609          CALL rd_mpi_io_error( 4 )
    14751610          WRITE(9,*)  'replicated array_1D not found ', name
    1476           CALL rs_mpi_io_error( 2 )
     1611          CALL rd_mpi_io_error( 2 )
    14771612       ENDIF
    14781613    ENDIF
    … …  
    15151650!--    Set default view
    15161651#if defined( __parallel )
    1517        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1652       IF ( sm_io%iam_io_pe )  THEN
     1653          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1654       ENDIF
    15181655!
    15191656!--    Only PE 0 writes replicated data
    … …  
    16561793!-- Set default view
    16571794#if defined( __parallel )
    1658     CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1795    IF ( sm_io%iam_io_pe )  THEN
     1796       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1797    ENDIF
    16591798!
    16601799!-- Only PE 0 writes replicated data
    … …  
    17671906             ELSE                                          ! read
    17681907#if defined( __parallel )
    1769                 IF ( debug_level >= 2 )  WRITE(9,'(a,8i8)') 'read block ', j, i, j_f, i_f, &
    1770                                                             m_start_index(j_f,i_f), nr_bytes_f, disp_f
    1771                 CALL MPI_FILE_SEEK( fh, disp_f, MPI_SEEK_SET, ierr )
     1908                IF ( debug_level >= 2 )  WRITE(9,'(a,4i4,4i10)') 'read block ', j, i, j_f, i_f,    &
     1909                                                         m_start_index(j_f,i_f), nr_bytes_f, disp_f
     1910                CALL MPI_FILE_SEEK( fhs, disp_f, MPI_SEEK_SET, ierr )
    17721911                nr_words = nr_bytes_f / wp
    1773                 CALL MPI_FILE_READ( fh, data(m_start_index(j_f,i_f)), nr_words, MPI_REAL, status, ierr )
     1912                CALL MPI_FILE_READ( fhs, data(m_start_index(j_f,i_f)), nr_words, MPI_REAL, status, ierr )
    17741913#else
    17751914                CALL posix_lseek( fh, disp_f )
    1776 !                CALL posix_read( fh, data(m_start_index(j_f:,i_f:)), nr_bytes_f )
     1915                CALL posix_read( fh, data(m_start_index(j_f,i_f):), nr_bytes_f )
    17771916#endif
    17781917                disp_f     = disp
    … …  
    17871926    ELSE
    17881927       WRITE(9,*) 'surface array not found ', name
    1789        CALL rs_mpi_io_error( 2 )
     1928       CALL rd_mpi_io_error( 2 )
    17901929    ENDIF
    17911930
    17921931      IF ( lo_first_index == 1 )  THEN
    1793          IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
     1932         IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
    17941933      ELSE
    17951934         IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_next ', TRIM( name ), ' ', &
    … …  
    18561995#endif
    18571996    INTEGER(iwp), OPTIONAL             ::  first_index
     1997#if defined( __parallel )
     1998    INTEGER(iwp)                       ::  i
     1999#endif
    18582000    INTEGER(iwp)                       ::  lo_first_index
    18592001    INTEGER(KIND=rd_offset_kind)       ::  offset
    … …  
    18632005#endif
    18642006
    1865     REAL(wp), INTENT(IN), DIMENSION(:) ::  data
     2007    REAL(wp), INTENT(IN), DIMENSION(:), TARGET ::  data
    18662008
    18672009
    … …  
    18802022    ENDIF
    18812023#if defined( __parallel )
    1882     IF ( all_pes_write )  THEN
    1883        CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native', MPI_INFO_NULL, ierr )
    1884        CALL MPI_FILE_WRITE_ALL( fh, data, nr_val, MPI_REAL, status, ierr )
     2024    IF ( sm_io%is_sm_active() )  THEN
     2025       DO  i = 1, nr_val
     2026          array_1d(i+local_start) = data(i)
     2027       ENDDO
     2028       IF ( debug_level >= 2 )  WRITE(9,*) 'w_surf ', TRIM( name ), ' ', SUM( array_1d(local_start+1:local_start+nr_val)),sum(data)
    18852029    ELSE
    1886        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    1887        IF ( nr_val > 0 )  THEN
    1888           disp = array_position + 8 * ( glo_start - 1 )
    1889           CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
    1890           CALL MPI_FILE_WRITE( fh, data, nr_val, MPI_REAL, status, ierr )
    1891        ENDIF
    1892     ENDIF
     2030!       array_1d => data                           !kk Did not work in all cases    why???
     2031       ALLOCATE( array_1d( SIZE( data ) ) )
     2032       array_1d = data
     2033    ENDIF
     2034
     2035    CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
     2036    IF ( sm_io%iam_io_pe )  THEN
     2037       IF ( all_pes_write )  THEN
     2038          CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native', MPI_INFO_NULL,  &
     2039                                  ierr )
     2040          CALL MPI_FILE_WRITE_ALL( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
     2041       ELSE
     2042          CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     2043          IF ( nr_val > 0 )  THEN
     2044             disp = array_position + 8 * ( glo_start - 1 )
     2045             CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
     2046             CALL MPI_FILE_WRITE( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
     2047          ENDIF
     2048       ENDIF
     2049    ENDIF
     2050    CALL sm_io%sm_node_barrier()
     2051    IF( .NOT. sm_io%is_sm_active() )  DEALLOCATE( array_1d )
    18932052#else
    18942053    CALL posix_lseek( fh, array_position )
    … …  
    18982057
    18992058    IF ( lo_first_index == 1 )  THEN
    1900        IF ( debug_level >= 2 .AND. nr_val  > 0 )  WRITE(9,*) 'w_surf ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
     2059       IF ( debug_level >= 2 .AND. nr_val  > 0 )  WRITE(9,*) 'w_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
    19012060    ELSE
    19022061       IF ( debug_level >= 2 .AND. nr_val  > 0 ) WRITE(9,*) 'w_surf_n ', TRIM( name ), ' ', &
    … …  
    19552114    offset = 0
    19562115
    1957     IF ( wr_flag )  THEN
     2116    IF ( wr_flag  .AND.  sm_io%iam_io_pe )  THEN
    19582117
    19592118       tgh%nr_int    = header_int_index - 1
    … …  
    19712130!--    Check for big/little endian format. This check is currently not used, and could be removed
    19722131!--    if we can assume little endian as the default on all machines.
    1973        CALL rs_mpi_io_check_endian( tgh%endian )
     2132       CALL rd_mpi_io_check_endian( tgh%endian )
    19742133
    19752134!
    … …  
    19812140!--    Write header file
    19822141       gh_size = storage_size(tgh) / 8
    1983        IF ( myid == 0 )  THEN
     2142       IF ( myid == 0 )  THEN   ! myid = 0 always performs I/O, even if I/O is limited to some cores
    19842143#if defined( __parallel )
    19852144          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    … …  
    20602219          ENDIF
    20612220
    2062           IF ( print_header_now )  CALL rs_mpi_io_print_header
     2221          IF ( print_header_now )  CALL rd_mpi_io_print_header
    20632222       ENDIF
    20642223
    … …  
    20672226!
    20682227!-- Free file types
    2069     CALL rs_mpi_io_free_filetypes
    2070 
    2071 !
    2072 !-- Close MPI-IO file
    2073 #if defined( __parallel )
    2074     CALL MPI_FILE_CLOSE( fh, ierr )
     2228    CALL rd_mpi_io_free_filetypes
     2229
     2230!
     2231!-- Close MPI-IO files
     2232#if defined( __parallel )
     2233!
     2234!-- Restart file has been opened with comm2d
     2235    IF ( fhs /= -1 )  THEN
     2236       CALL MPI_FILE_CLOSE( fhs, ierr )
     2237    ENDIF
     2238#endif
     2239
     2240    IF ( sm_io%iam_io_pe )  THEN
     2241
     2242#if defined( __parallel )
     2243       CALL MPI_FILE_CLOSE( fh, ierr )
    20752244#else
    2076     CALL posix_close( fh )
    2077 #endif
     2245       CALL posix_close( fh )
     2246#endif
     2247
     2248    ENDIF
    20782249
    20792250    mb_processed = array_position / ( 1024.0_dp * 1024.0_dp )
    … …  
    20902261!> called. A main feature of this subroutine is computing the global start indices of the 1d- and
    20912262!> 2d- surface arrays.
     2263!> Even if I/O is done by a limited number of cores only, the surface data are read by ALL cores!
     2264!> Reading them by some cores and then distributing the data would result in complicated code
     2265!> which is suspectable for errors and overloads the reading subroutine. Since reading of surface
     2266!> data is not time critical (data size is comparably small), it will be read by all cores.
    20922267!--------------------------------------------------------------------------------------------------!
    20932268 SUBROUTINE rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start )
    … …  
    21162291#if defined( __parallel )
    21172292    CALL MPI_ALLREDUCE( lo_nr_val, all_nr_val, numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr )
    2118     IF ( ft_surf /= -1 )  THEN
     2293    IF ( ft_surf /= -1  .AND.  sm_io%iam_io_pe )  THEN
    21192294       CALL MPI_TYPE_FREE( ft_surf, ierr )    ! if set, free last surface filetype
     2295    ENDIF
     2296
     2297    IF ( win_surf /= -1 )  THEN
     2298       IF ( sm_io%is_sm_active() )  THEN
     2299          CALL MPI_WIN_FREE( win_surf, ierr )
     2300       ENDIF
     2301       win_surf = -1
     2302    ENDIF
     2303
     2304    IF ( sm_io%is_sm_active() .AND. rd_flag )  THEN
     2305       IF ( fhs == -1 )  THEN
     2306          CALL MPI_FILE_OPEN( comm2d, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fhs,   &
     2307                              ierr )
     2308       ENDIF
     2309    ELSE
     2310       fhs = fh
    21202311    ENDIF
    21212312#else
    … …  
    21462337
    21472338#if defined( __parallel )
    2148        CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     2339       CALL MPI_FILE_SET_VIEW( fhs, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    21492340#endif
    21502341    ENDIF
    … …  
    21612352          global_start = -1
    21622353       ENDWHERE
     2354
     2355#if defined( __parallel )
     2356       IF ( sm_io%is_sm_active() )  THEN
     2357          IF ( sm_io%iam_io_pe )  THEN
     2358!
     2359!--          Calculate number of values of all PEs of an I/O group
     2360             nr_iope = 0
     2361             DO  i = myid, myid+sm_io%sh_npes-1
     2362                nr_iope = nr_iope + all_nr_val(i)
     2363             ENDDO
     2364          ELSE
     2365             local_start = 0
     2366             DO  i = myid-sm_io%sh_rank, myid-1
     2367                local_start = local_start + all_nr_val(i)
     2368             ENDDO
     2369          ENDIF
     2370!
     2371!--       Get the size of shared memory window on all PEs
     2372          CALL MPI_BCAST( nr_iope, 1, MPI_INTEGER, 0, sm_io%comm_shared, ierr )
     2373          CALL sm_io%sm_allocate_shared( array_1d, 1, MAX( 1, nr_iope ), win_surf )
     2374       ELSE
     2375          nr_iope = nr_val
     2376       ENDIF
     2377#else
     2378       nr_iope = nr_val
     2379#endif
    21632380
    21642381!
    … …  
    21702387       ENDIF
    21712388
    2172        all_pes_write = ( MINVAL( all_nr_val ) > 0 )
    2173 
    2174        IF ( all_pes_write )  THEN
    2175           dims1(1)  = total_number_of_surface_values
    2176           lize1(1)  = nr_val
    2177           start1(1) = glo_start-1
    2178 
    2179 #if defined( __parallel )
    2180           IF ( total_number_of_surface_values > 0 )  THEN
    2181               CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lize1, start1, MPI_ORDER_FORTRAN, MPI_REAL, ft_surf, ierr )
    2182               CALL MPI_TYPE_COMMIT( ft_surf, ierr )
     2389       IF ( sm_io%iam_io_pe )  THEN
     2390
     2391          all_pes_write = ( MINVAL( all_nr_val ) > 0 )
     2392
     2393          IF ( all_pes_write )  THEN
     2394             dims1(1)  = total_number_of_surface_values
     2395             lize1(1)  = nr_iope
     2396             start1(1) = glo_start-1
     2397
     2398#if defined( __parallel )
     2399             IF ( total_number_of_surface_values > 0 )  THEN
     2400                 CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lize1, start1, MPI_ORDER_FORTRAN,        &
     2401                                                MPI_REAL, ft_surf, ierr )
     2402                 CALL MPI_TYPE_COMMIT( ft_surf, ierr )
     2403             ENDIF
     2404#endif
    21832405          ENDIF
    2184 #endif
    2185        ENDIF
     2406       ENDIF
     2407
    21862408    ENDIF
    21872409
    … …  
    21962418!> distributed in blocks among processes to a single file that contains the global arrays.
    21972419!--------------------------------------------------------------------------------------------------!
    2198   SUBROUTINE rs_mpi_io_create_filetypes
     2420  SUBROUTINE rd_mpi_io_create_filetypes
    21992421
    22002422    IMPLICIT NONE
    … …  
    22082430    INTEGER, DIMENSION(3) ::  start3
    22092431
     2432    TYPE(local_boundaries) ::  save_io_grid  !< temporary variable to store grid settings
     2433
     2434
     2435    IF ( sm_io%is_sm_active() )  THEN
     2436       save_io_grid = sm_io%io_grid
     2437    ENDIF
    22102438
    22112439!
    … …  
    22402468       ENDIF
    22412469
     2470       CALL sm_io%sm_adjust_outer_boundary()
     2471
    22422472    ELSE
    22432473
    … …  
    22532483    ENDIF
    22542484
     2485    IF ( sm_io%is_sm_active() )  THEN
     2486#if defined( __parallel )
     2487       CALL sm_io%sm_allocate_shared( array_2d,  sm_io%io_grid%nxl, sm_io%io_grid%nxr,             &
     2488                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_2dr )
     2489       CALL sm_io%sm_allocate_shared( array_2di, save_io_grid%nxl, save_io_grid%nxr,               &
     2490                                      save_io_grid%nys, save_io_grid%nyn, win_2di )
     2491       CALL sm_io%sm_allocate_shared( array_3d, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,  &
     2492                                      sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3dr )
     2493#endif
     2494    ELSE
     2495       ALLOCATE( array_2d(lb%nxl:lb%nxr,lb%nys:lb%nyn) )
     2496       ALLOCATE( array_2di(nxl:nxr,nys:nyn) )
     2497       ALLOCATE( array_3d(nzb:nzt+1,lb%nxl:lb%nxr,lb%nys:lb%nyn) )
     2498       sm_io%io_grid = lb
     2499    ENDIF
     2500
    22552501!
    22562502!-- Create filetype for 2d-REAL array with ghost layers around the total domain
    … …  
    22582504    dims2(2)  = lb%ny + 1
    22592505
    2260     lize2(1)  = lb%nnx
    2261     lize2(2)  = lb%nny
    2262 
    2263     start2(1) = lb%nxl
    2264     start2(2) = lb%nys
    2265 
    2266 #if defined( __parallel )
    2267     CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_REAL, ft_2d, ierr )
    2268     CALL MPI_TYPE_COMMIT( ft_2d, ierr )
     2506    lize2(1)  = sm_io%io_grid%nnx
     2507    lize2(2)  = sm_io%io_grid%nny
     2508
     2509    start2(1) = sm_io%io_grid%nxl
     2510    start2(2) = sm_io%io_grid%nys
     2511
     2512#if defined( __parallel )
     2513    IF ( sm_io%iam_io_pe )  THEN
     2514       CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_REAL,        &
     2515                                      ft_2d, ierr )
     2516       CALL MPI_TYPE_COMMIT( ft_2d, ierr )
     2517    ENDIF
    22692518#endif
    22702519!
    … …  
    22732522    dims2(2)  = ny + 1
    22742523
    2275     lize2(1)  = nnx
    2276     lize2(2)  = nny
    2277 
    2278     start2(1) = nxl
    2279     start2(2) = nys
    2280 
    2281 #if defined( __parallel )
    2282     CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_INTEGER, ft_2di_nb, ierr )
    2283     CALL MPI_TYPE_COMMIT( ft_2di_nb, ierr )
     2524    IF ( sm_io%is_sm_active() )  THEN
     2525
     2526       lize2(1)  = save_io_grid%nnx
     2527       lize2(2)  = save_io_grid%nny
     2528
     2529       start2(1) = save_io_grid%nxl
     2530       start2(2) = save_io_grid%nys
     2531
     2532    ELSE
     2533
     2534       lize2(1)  = nnx
     2535       lize2(2)  = nny
     2536
     2537       start2(1) = nxl
     2538       start2(2) = nys
     2539
     2540    ENDIF
     2541
     2542#if defined( __parallel )
     2543    IF ( sm_io%iam_io_pe )  THEN
     2544       CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_INTEGER,     &
     2545                                      ft_2di_nb, ierr )
     2546       CALL MPI_TYPE_COMMIT( ft_2di_nb, ierr )
     2547    ENDIF
    22842548#endif
    22852549!
    … …  
    22902554
    22912555    lize3(1)  = dims3(1)
    2292     lize3(2)  = lb%nnx
    2293     lize3(3)  = lb%nny
     2556    lize3(2)  = sm_io%io_grid%nnx
     2557    lize3(3)  = sm_io%io_grid%nny
    22942558
    22952559    start3(1) = nzb
    2296     start3(2) = lb%nxl
    2297     start3(3) = lb%nys
    2298 
    2299 #if defined( __parallel )
    2300     CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, ft_3d, ierr )
    2301     CALL MPI_TYPE_COMMIT( ft_3d, ierr )
    2302 #endif
    2303 
    2304  END SUBROUTINE rs_mpi_io_create_filetypes
     2560    start3(2) = sm_io%io_grid%nxl
     2561    start3(3) = sm_io%io_grid%nys
     2562
     2563#if defined( __parallel )
     2564    IF ( sm_io%iam_io_pe )  THEN
     2565       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, ft_3d, &
     2566                                      ierr )
     2567       CALL MPI_TYPE_COMMIT( ft_3d, ierr )
     2568    ENDIF
     2569#endif
     2570
     2571 END SUBROUTINE rd_mpi_io_create_filetypes
    23052572
    23062573
    … …  
    23252592    INTEGER, DIMENSION(3) ::  start3
    23262593
     2594
     2595    IF ( sm_io%is_sm_active() )  THEN
     2596       CALL sm_io%sm_allocate_shared( array_3d_soil, nzb_soil, nzt_soil, sm_io%io_grid%nxl,        &
     2597                                      sm_io%io_grid%nxr, sm_io%io_grid%nys, sm_io%io_grid%nyn,     &
     2598                                      win_3ds )
     2599    ELSE
     2600       ALLOCATE( array_3d_soil(nzb_soil:nzt_soil,lb%nxl:lb%nxr,lb%nys:lb%nyn) )
     2601       sm_io%io_grid = lb
     2602    ENDIF
    23272603
    23282604!
    … …  
    23332609
    23342610    lize3(1)  = dims3(1)
    2335     lize3(2)  = lb%nnx
    2336     lize3(3)  = lb%nny
     2611    lize3(2)  = sm_io%io_grid%nnx
     2612    lize3(3)  = sm_io%io_grid%nny
    23372613
    23382614    start3(1) = nzb_soil
    2339     start3(2) = lb%nxl
    2340     start3(3) = lb%nys
    2341 
    2342     CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL,           &
    2343                                    ft_3dsoil, ierr )
    2344     CALL MPI_TYPE_COMMIT( ft_3dsoil, ierr )
     2615    start3(2) = sm_io%io_grid%nxl
     2616    start3(3) = sm_io%io_grid%nys
     2617
     2618    IF ( sm_io%iam_io_pe )  THEN
     2619       CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL,        &
     2620                                      ft_3dsoil, ierr )
     2621       CALL MPI_TYPE_COMMIT( ft_3dsoil, ierr )
     2622    ENDIF
    23452623
    23462624 END SUBROUTINE rd_mpi_io_create_filetypes_3dsoil
    … …  
    23542632!> Free all file types that have been created for MPI-IO.
    23552633!--------------------------------------------------------------------------------------------------!
    2356  SUBROUTINE rs_mpi_io_free_filetypes
     2634 SUBROUTINE rd_mpi_io_free_filetypes
    23572635
    23582636    IMPLICIT NONE
    … …  
    23612639#if defined( __parallel )
    23622640    IF ( filetypes_created )  THEN
    2363        CALL MPI_TYPE_FREE( ft_2d, ierr )
    2364        CALL MPI_TYPE_FREE( ft_2di_nb, ierr )
    2365        CALL MPI_TYPE_FREE( ft_3d, ierr )
     2641
     2642       IF ( sm_io%iam_io_pe )  THEN
     2643          CALL MPI_TYPE_FREE( ft_2d, ierr )
     2644          CALL MPI_TYPE_FREE( ft_2di_nb, ierr )
     2645          CALL MPI_TYPE_FREE( ft_3d, ierr )
     2646       ENDIF
     2647
     2648       IF ( sm_io%is_sm_active() )  THEN
     2649          CALL sm_io%sm_free_shared( win_2dr )
     2650          CALL sm_io%sm_free_shared( win_2di )
     2651          CALL sm_io%sm_free_shared( win_3dr )
     2652       ELSE
     2653          DEALLOCATE( array_2d, array_2di, array_3d )
     2654       ENDIF
     2655
    23662656    ENDIF
    23672657!
    23682658!-- Free last surface filetype
    2369     IF ( ft_surf /= -1 )  THEN 
     2659    IF ( sm_io%iam_io_pe .AND. ft_surf /= -1 )  THEN
    23702660       CALL MPI_TYPE_FREE( ft_surf, ierr )
    23712661    ENDIF
    2372 #endif
    2373 
    2374  END SUBROUTINE rs_mpi_io_free_filetypes
     2662
     2663    IF ( sm_io%is_sm_active() .AND.  win_surf /= -1 )  THEN
     2664       CALL sm_io%sm_free_shared( win_surf )
     2665    ENDIF
     2666
     2667    ft_surf  = -1
     2668    win_surf = -1
     2669#else
     2670    DEALLOCATE( array_2d, array_2di, array_3d )
     2671#endif
     2672
     2673 END SUBROUTINE rd_mpi_io_free_filetypes
    23752674
    23762675
    … …  
    23812680!> Print the restart data file header (MPI-IO format) for debugging.
    23822681!--------------------------------------------------------------------------------------------------!
    2383  SUBROUTINE rs_mpi_io_print_header
     2682 SUBROUTINE rd_mpi_io_print_header
    23842683
    23852684    IMPLICIT NONE
    … …  
    24222721    print_header_now = .FALSE.
    24232722
    2424  END SUBROUTINE rs_mpi_io_print_header
     2723 END SUBROUTINE rd_mpi_io_print_header
    24252724
    24262725
    … …  
    24312730!> Print error messages for reading/writing restart data with MPI-IO
    24322731!--------------------------------------------------------------------------------------------------!
    2433  SUBROUTINE rs_mpi_io_error( error_number )
     2732 SUBROUTINE rd_mpi_io_error( error_number )
    24342733
    24352734    IMPLICIT NONE
    … …  
    24542753             WRITE(6,*)  'posix IO: ERROR Opening Restart File'
    24552754          CASE DEFAULT
    2456              WRITE(6,*)  'rs_mpi_io_error: illegal error number: ',error_number
     2755             WRITE(6,*)  'rd_mpi_io_error: illegal error number: ',error_number
    24572756
    24582757       END SELECT
    … …  
    24602759    ENDIF
    24612760#if defined( __parallel )
    2462     CALL MPI_BARRIER( comm2d, ierr )
    2463     CALL MPI_ABORT( comm2d, 1, ierr )
     2761    IF ( .NOT. sm_io%iam_io_pe )  RETURN
     2762
     2763    CALL MPI_BARRIER( comm_io, ierr )
     2764    CALL MPI_ABORT( comm_io, 1, ierr )
    24642765#else
    24652766    CALL ABORT
    24662767#endif
    24672768
    2468  END SUBROUTINE rs_mpi_io_error
     2769 END SUBROUTINE rd_mpi_io_error
    24692770
    24702771
    … …  
    24772778!> the first 4 bytes of the pointer are equal 1 (little endian) or not.
    24782779!--------------------------------------------------------------------------------------------------!
    2479  SUBROUTINE rs_mpi_io_check_endian( i_endian )
     2780 SUBROUTINE rd_mpi_io_check_endian( i_endian )
    24802781
    24812782    IMPLICIT NONE
    … …  
    25022803    ENDIF
    25032804
    2504  END SUBROUTINE rs_mpi_io_check_endian
     2805 END SUBROUTINE rd_mpi_io_check_endian
    25052806
    25062807 END MODULE restart_data_mpi_io_mod
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |