Ignore:
Timestamp:
Aug 25, 2020 12:11:17 PM (4 years ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

    r4629 r4649  
    11!> @file pmc_handle_communicator_mod.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
    1615!
    1716! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     17!--------------------------------------------------------------------------------------------------!
     18!
    1919!
    2020! Current revisions:
    21 ! ------------------
     21! -----------------
    2222!
    2323!
     
    2525! -----------------
    2626! $Id$
    27 ! support for MPI Fortran77 interface (mpif.h) removed
    28 !
     27! File re-formatted to follow the PALM coding standard
     28!
     29!
     30! 4629 2020-07-29 09:37:56Z raasch
     31! Support for MPI Fortran77 interface (mpif.h) removed
     32!
    2933! 4360 2020-01-07 11:25:50Z suehring
    3034! Corrected "Former revisions" section
    31 ! 
     35!
    3236! 3888 2019-04-12 09:18:10Z hellstea
    3337! Missing MPI_BCAST of anterpolation_buffer_width added.
    34 ! 
     38!
    3539! 3885 2019-04-11 11:29:34Z kanani
    36 ! Changes related to global restructuring of location messages and introduction
    37 ! of additional debug messages
    38 ! 
     40! Changes related to global restructuring of location messages and introduction of additional debug
     41! messages
     42!
    3943! 3819 2019-03-27 11:01:36Z hellstea
    40 ! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled
    41 ! by the new nesting_parameters parameter anterpolation_buffer_width.
    42 ! 
     44! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled by the new
     45! nesting_parameters parameter anterpolation_buffer_width.
     46!
    4347! 3655 2019-01-07 16:51:22Z knoop
    4448! nestpar renamed to nesting_parameters
    45 ! 
     49!
    4650! 1762 2016-02-25 12:31:13Z hellstea
    4751! Initial revision by K. Ketelsen
     
    5054! ------------
    5155! Handle MPI communicator in PALM model coupler
    52 !-------------------------------------------------------------------------------!
     56!--------------------------------------------------------------------------------------------------!
    5357 MODULE PMC_handle_communicator
    5458#if defined( __parallel )
     
    5761    USE MPI
    5862
    59     USE pmc_general,                                                            &
    60         ONLY: pmc_status_ok, pmc_status_error, pmc_max_models
    61     USE control_parameters,                                                     &
     63    USE pmc_general,                                                                               &
     64        ONLY: pmc_max_models,                                                                      &
     65              pmc_status_error,                                                                    &
     66              pmc_status_ok
     67
     68
     69    USE control_parameters,                                                                        &
    6270        ONLY: message_string
    6371
     
    6775    TYPE pmc_layout
    6876
    69        CHARACTER(LEN=32) ::  name
    70 
    71        INTEGER  ::  id            !<
    72        INTEGER  ::  parent_id     !<
    73        INTEGER  ::  npe_total     !<
     77       CHARACTER(LEN=32) ::  name  !<
     78
     79       INTEGER ::  id            !<
     80       INTEGER ::  npe_total     !<
     81       INTEGER ::  parent_id     !<
    7482
    7583       REAL(wp) ::  lower_left_x  !<
     
    7886    END TYPE pmc_layout
    7987
    80     PUBLIC  pmc_status_ok, pmc_status_error
     88    PUBLIC  pmc_status_ok, pmc_status_error  !<
    8189
    8290    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of processes
     
    8492    INTEGER, PARAMETER, PUBLIC ::  pmc_no_namelist_found = 3  !< no couple layout namelist found
    8593
     94    INTEGER ::  m_my_cpl_id   !< coupler id of this model
     95    INTEGER ::  m_ncpl        !< number of couplers given in nesting_parameters namelist
     96    INTEGER ::  m_parent_id   !< coupler id of parent of this model
    8697    INTEGER ::  m_world_comm  !< global nesting communicator
    87     INTEGER ::  m_my_cpl_id   !< coupler id of this model
    88     INTEGER ::  m_parent_id   !< coupler id of parent of this model
    89     INTEGER ::  m_ncpl        !< number of couplers given in nesting_parameters namelist
    9098
    9199    TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
    92100
    93101    INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
     102    INTEGER, PUBLIC ::  m_model_npes          !<
     103    INTEGER, PUBLIC ::  m_model_rank          !<
    94104    INTEGER, PUBLIC ::  m_to_parent_comm      !< communicator to the parent
    95105    INTEGER, PUBLIC ::  m_world_rank          !<
     106    INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model
    96107    INTEGER         ::  m_world_npes          !<
    97     INTEGER, PUBLIC ::  m_model_rank          !<
    98     INTEGER, PUBLIC ::  m_model_npes          !<
    99     INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model
    100108    INTEGER         ::  peer_comm             !< peer_communicator for inter communicators
    101109
    102     INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm    !< communicator to the child(ren)
    103     INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_parent_for_child   !<
    104 
     110    INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm   !< communicator to the child(ren)
     111    INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_parent_for_child  !<
     112
     113
     114    INTERFACE pmc_get_model_info
     115       MODULE PROCEDURE pmc_get_model_info
     116    END INTERFACE pmc_get_model_info
    105117
    106118    INTERFACE pmc_is_rootmodel
     
    108120    END INTERFACE pmc_is_rootmodel
    109121
    110     INTERFACE pmc_get_model_info
    111        MODULE PROCEDURE pmc_get_model_info
    112     END INTERFACE pmc_get_model_info
    113 
    114     PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel
     122    PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel   !<
     123
     124
    115125
    116126 CONTAINS
    117127
    118  SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,      &
     128
     129!--------------------------------------------------------------------------------------------------!
     130! Description:
     131! ------------
     132!> @Todo: Missing subroutine description.
     133!--------------------------------------------------------------------------------------------------!
     134 SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,                         &
    119135                            anterpolation_buffer_width, pmc_status )
    120136
    121     USE control_parameters,                                                     &
     137    USE control_parameters,                                                                        &
    122138        ONLY:  message_string
    123139
    124     USE pegrid,                                                                 &
     140    USE pegrid,                                                                                    &
    125141        ONLY:  myid
    126142
    127143      IMPLICIT NONE
    128144
     145    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
    129146    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
    130     CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
    131 
    132     INTEGER, INTENT(INOUT) ::  anterpolation_buffer_width          !< Boundary buffer width for anterpolation
    133     INTEGER, INTENT(INOUT) ::  comm        !<
    134     INTEGER, INTENT(INOUT) ::  pmc_status  !<
     147
     148    INTEGER, INTENT(INOUT) ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
     149    INTEGER, INTENT(INOUT) ::  comm                        !<
     150    INTEGER, INTENT(INOUT) ::  pmc_status                  !<
    135151
    136152    INTEGER ::  childcount     !<
     
    141157    INTEGER ::  tag            !<
    142158
    143     INTEGER, DIMENSION(pmc_max_models)   ::  activeparent  ! I am active parent for this child ID
    144     INTEGER, DIMENSION(pmc_max_models+1) ::  start_pe
     159    INTEGER, DIMENSION(pmc_max_models)   ::  activeparent  !< I am active parent for this child ID
     160    INTEGER, DIMENSION(pmc_max_models+1) ::  start_pe      !<
    145161
    146162    pmc_status   = pmc_status_ok
     
    158174    IF ( m_world_rank == 0 )  THEN
    159175
    160        CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
     176       CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
    161177                                  anterpolation_buffer_width, pmc_status )
    162178
    163        IF ( pmc_status /= pmc_no_namelist_found  .AND.                          &
    164             pmc_status /= pmc_namelist_error )                                  &
     179       IF ( pmc_status /= pmc_no_namelist_found  .AND.                                             &
     180            pmc_status /= pmc_namelist_error )                                                     &
    165181       THEN
    166182!
     
    172188
    173189!
    174 !--       The sum of numbers of processes requested by all the domains
    175 !--       must be equal to the total number of processes of the run
     190!--       The sum of numbers of processes requested by all the domains must be equal to the total
     191!--       number of processes of the run
    176192          IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
    177              WRITE ( message_string, '(2A,I6,2A,I6,A)' )                        &
    178                              'nesting-setup requires different number of ',     &
    179                              'MPI procs (', start_pe(m_ncpl+1), ') than ',      &
    180                              'provided (', m_world_npes,')'
     193             WRITE( message_string, '(2A,I6,2A,I6,A)' )                                            &
     194                                                'nesting-setup requires different number of ',     &
     195                                                'MPI procs (', start_pe(m_ncpl+1), ') than ',      &
     196                                                'provided (', m_world_npes,')'
    181197             CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
    182198          ENDIF
     
    186202    ENDIF
    187203!
    188 !-- Broadcast the read status. This synchronises all other processes with
    189 !-- process 0 of the root model. Without synchronisation, they would not
    190 !-- behave in the correct way (e.g. they would not return in case of a
    191 !-- missing NAMELIST).
     204!-- Broadcast the read status. This synchronises all other processes with process 0 of the root
     205!-- model. Without synchronisation, they would not behave in the correct way (e.g. they would not
     206!-- return in case of a missing NAMELIST).
    192207    CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
    193208
     
    200215    ELSEIF ( pmc_status == pmc_namelist_error )  THEN
    201216!
    202 !--    Only the root model gives the error message. Others are aborted by the
    203 !--    message-routine with MPI_ABORT. Must be done this way since myid and
    204 !--    comm2d have not yet been assigned at this point.
     217!--    Only the root model gives the error message. Others are aborted by the message-routine with
     218!--    MPI_ABORT. Must be done this way since myid and comm2d have not yet been assigned at this
     219!--    point.
    205220       IF ( m_world_rank == 0 )  THEN
    206221          message_string = 'errors in \$nesting_parameters'
     
    215230!-- Broadcast coupling layout
    216231    DO  i = 1, m_ncpl
    217        CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),           &
     232       CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),                              &
    218233                       MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    219        CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,           &
     234       CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,                              &
    220235                       MPI_COMM_WORLD, istat )
    221        CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,           &
     236       CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,                              &
    222237                       MPI_COMM_WORLD, istat )
    223        CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,           &
     238       CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,                              &
    224239                       MPI_COMM_WORLD, istat )
    225        CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,           &
     240       CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,                              &
    226241                       MPI_COMM_WORLD, istat )
    227        CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,           &
     242       CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,                              &
    228243                       MPI_COMM_WORLD, istat )
    229244    ENDDO
    230     CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0,        &
     245    CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
     246    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode), MPI_CHARACTER, 0,   &
    231247                    MPI_COMM_WORLD, istat )
    232     CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode),  &
    233                     MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    234     CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD,  &
    235                     istat )
     248    CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD, istat )
    236249!
    237250!-- Assign global MPI processes to individual models by setting the couple id
    238251    DO  i = 1, m_ncpl
    239        IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) )  &
    240        THEN
     252       IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) )  THEN
    241253          m_my_cpl_id = i
    242254          EXIT
     
    245257    m_my_cpl_rank = m_world_rank - start_pe(i)
    246258!
    247 !-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach).
    248 !-- The communictors for the individual models as created by MPI_COMM_SPLIT.
    249 !-- The color of the model is represented by the coupler id
    250     CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm,      &
    251                          istat )
     259!-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach). The communictors for the
     260!-- individual models as created by MPI_COMM_SPLIT. The color of the model is represented by the
     261!-- coupler id
     262    CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm, istat )
    252263!
    253264!-- Get size and rank of the model running on this process
     
    257268!-- Broadcast (from process 0) the parent id and id of every model
    258269    DO  i = 1, m_ncpl
    259        CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,              &
    260                        MPI_COMM_WORLD, istat )
    261        CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0,              &
    262                        MPI_COMM_WORLD, istat )
     270       CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
     271       CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
    263272    ENDDO
    264273!
     
    268277!
    269278!-- Create intercommunicator between the parent and children.
    270 !-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of
    271 !-- different colors.
    272 !-- The grouping was done above with MPI_COMM_SPLIT.
    273 !-- A duplicate of MPI_COMM_WORLD is created and used as peer communicator
    274 !-- (peer_comm) for MPI_INTERCOMM_CREATE.
    275     CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr )
     279!-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of different colors. The
     280!-- grouping was done above with MPI_COMM_SPLIT. A duplicate of MPI_COMM_WORLD is created and used
     281!-- as peer communicator (peer_comm) for MPI_INTERCOMM_CREATE.
     282    CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr )
    276283    DO  i = 2, m_ncpl
    277284       IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
    278285!
    279 !--       Identify all children models of the current model and create
    280 !--       inter-communicators to connect between the current model and its
    281 !--       children models.
     286!--       Identify all children models of the current model and create inter-communicators to
     287!--       connect between the current model and its children models.
    282288          tag = 500 + i
    283           CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i),           &
    284                                      tag, m_to_child_comm(i), istat)
     289          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i), tag, m_to_child_comm(i),     &
     290                                     istat )
    285291          childcount = childcount + 1
    286292          activeparent(i) = 1
    287293       ELSEIF ( i == m_my_cpl_id)  THEN
    288294!
    289 !--       Create an inter-communicator to connect between the current
    290 !--       model and its parent model.   
     295!--       Create an inter-communicator to connect between the current model and its parent model.
    291296          tag = 500 + i
    292           CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm,                        &
    293                                      start_pe(m_couplers(i)%parent_id),         &
    294                                      tag, m_to_parent_comm, istat )
     297          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(m_couplers(i)%parent_id), tag,   &
     298                                     m_to_parent_comm, istat )
    295299       ENDIF
    296300    ENDDO
    297301!
    298 !-- If I am a parent, count the number of children I have.
    299 !-- Although this loop is symmetric on all processes, the "activeparent" flag
    300 !-- is true (==1) on the respective individual process only.
     302!-- If I am a parent, count the number of children I have. Although this loop is symmetric on all
     303!-- processes, the "activeparent" flag is true (==1) on the respective individual process only.
    301304    ALLOCATE( pmc_parent_for_child(childcount+1) )
    302305
     
    311314!-- Get the size of the parent model
    312315    IF ( m_my_cpl_id > 1 )  THEN
    313        CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size,       &
    314                                   istat )
     316       CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size, istat )
    315317    ELSE
    316318!
     
    319321    ENDIF
    320322!
    321 !-- Set myid to non-zero value except for the root domain. This is a setting
    322 !-- for the message routine which is called at the end of pmci_init. That
    323 !-- routine outputs messages for myid = 0, only. However, myid has not been
    324 !-- assigened so far, so that all processes of the root model would output a
    325 !-- message. To avoid this, set myid to some other value except for process 0
    326 !-- of the root domain.
     323!-- Set myid to non-zero value except for the root domain. This is a setting for the message routine
     324!-- which is called at the end of pmci_init. That routine outputs messages for myid = 0, only.
     325!-- However, myid has not been assigened so far, so that all processes of the root model would
     326!-- output a message. To avoid this, set myid to some other value except for process 0 of the root
     327!-- domain.
    327328    IF ( m_world_rank /= 0 )  myid = 1
    328329
     
    330331
    331332
    332 
    333  SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name,           &
    334                                 cpl_parent_id, lower_left_x, lower_left_y,      &
    335                                 ncpl, npe_total, request_for_cpl_id )
     333!--------------------------------------------------------------------------------------------------!
     334! Description:
     335! ------------
     336!> @Todo: Missing subroutine description.
     337!--------------------------------------------------------------------------------------------------!
     338 SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name, cpl_parent_id, lower_left_x, &
     339                                lower_left_y, ncpl, npe_total, request_for_cpl_id )
    336340!
    337341!-- Provide module private variables of the pmc for PALM
     
    407411
    408412
    409  SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    410       anterpolation_buffer_width, pmc_status )
     413!--------------------------------------------------------------------------------------------------!
     414! Description:
     415! ------------
     416!> @Todo: Missing subroutine description.
     417!--------------------------------------------------------------------------------------------------!
     418 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
     419                                  anterpolation_buffer_width, pmc_status )
    411420
    412421    IMPLICIT NONE
    413422
    414     CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode
    415     CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode
    416    
    417     INTEGER, INTENT(INOUT)      ::  anterpolation_buffer_width     !< Boundary buffer width for anterpolation
    418     INTEGER(iwp), INTENT(INOUT) ::  pmc_status
    419     INTEGER(iwp)                ::  bad_llcorner
    420     INTEGER(iwp)                ::  i
    421     INTEGER(iwp)                ::  istat
    422 
    423     TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  domain_layouts
    424 
    425     NAMELIST /nesting_parameters/  domain_layouts, nesting_datatransfer_mode,  &
    426                                    nesting_mode, anterpolation_buffer_width
    427    
     423    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
     424    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
     425
     426    INTEGER, INTENT(INOUT)      ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
     427    INTEGER(iwp), INTENT(INOUT) ::  pmc_status                  !<
     428
     429    INTEGER(iwp) ::  bad_llcorner  !<
     430    INTEGER(iwp) ::  i             !<
     431    INTEGER(iwp) ::  istat         !<
     432
     433    TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  domain_layouts  !<
     434
     435    NAMELIST /nesting_parameters/  domain_layouts,                                                 &
     436                                   nesting_datatransfer_mode,                                      &
     437                                   nesting_mode,                                                   &
     438                                   anterpolation_buffer_width
     439
    428440!
    429441!-- Initialize some coupling variables
     
    435447!-- Open the NAMELIST-file and read the nesting layout
    436448    CALL check_open( 11 )
    437     READ ( 11, nesting_parameters, IOSTAT=istat )
    438 !
    439 !-- Set filepointer to the beginning of the file. Otherwise process 0 will later
    440 !-- be unable to read the inipar-NAMELIST
     449    READ ( 11, nesting_parameters, IOSTAT = istat )
     450!
     451!-- Set filepointer to the beginning of the file. Otherwise process 0 will later be unable to read
     452!-- the inipar-NAMELIST
    441453    REWIND ( 11 )
    442454
     
    473485    ENDDO
    474486!
    475 !-- Make sure that all domains have equal lower left corner in case of vertical
    476 !-- nesting
     487!-- Make sure that all domains have equal lower left corner in case of vertical nesting
    477488    IF ( nesting_mode == 'vertical' )  THEN
    478489       bad_llcorner = 0
    479490       DO  i = 1, m_ncpl
    480           IF ( domain_layouts(i)%lower_left_x /= 0.0_wp .OR.                    &
     491          IF ( domain_layouts(i)%lower_left_x /= 0.0_wp .OR.                                       &
    481492               domain_layouts(i)%lower_left_y /= 0.0_wp )  THEN
    482493             bad_llcorner = bad_llcorner + 1
     
    486497       ENDDO
    487498       IF ( bad_llcorner /= 0)  THEN
    488           WRITE ( message_string, *)  'at least one dimension of lower ',       &
    489                                       'left corner of one domain is not 0. ',   &
    490                                       'All lower left corners were set to (0, 0)'
     499          WRITE( message_string, *)  'at least one dimension of lower ',                           &
     500                                     'left corner of one domain is not 0. ',                       &
     501                                     'All lower left corners were set to (0, 0)'
    491502          CALL message( 'read_coupling_layout', 'PA0427', 0, 0, 0, 6, 0 )
    492503       ENDIF
Note: See TracChangeset for help on using the changeset viewer.