Changeset 4649 for palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
- Timestamp:
- Aug 25, 2020 12:11:17 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
r4629 r4649 1 1 !> @file pmc_handle_communicator_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 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/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------! 17 !--------------------------------------------------------------------------------------------------! 18 ! 19 19 ! 20 20 ! Current revisions: 21 ! ----------------- -21 ! ----------------- 22 22 ! 23 23 ! … … 25 25 ! ----------------- 26 26 ! $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 ! 29 33 ! 4360 2020-01-07 11:25:50Z suehring 30 34 ! Corrected "Former revisions" section 31 ! 35 ! 32 36 ! 3888 2019-04-12 09:18:10Z hellstea 33 37 ! Missing MPI_BCAST of anterpolation_buffer_width added. 34 ! 38 ! 35 39 ! 3885 2019-04-11 11:29:34Z kanani 36 ! Changes related to global restructuring of location messages and introduction 37 ! of additional debugmessages38 ! 40 ! Changes related to global restructuring of location messages and introduction of additional debug 41 ! messages 42 ! 39 43 ! 3819 2019-03-27 11:01:36Z hellstea 40 ! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled 41 ! by the newnesting_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 ! 43 47 ! 3655 2019-01-07 16:51:22Z knoop 44 48 ! nestpar renamed to nesting_parameters 45 ! 49 ! 46 50 ! 1762 2016-02-25 12:31:13Z hellstea 47 51 ! Initial revision by K. Ketelsen … … 50 54 ! ------------ 51 55 ! Handle MPI communicator in PALM model coupler 52 !------------------------------------------------------------------------------- !56 !--------------------------------------------------------------------------------------------------! 53 57 MODULE PMC_handle_communicator 54 58 #if defined( __parallel ) … … 57 61 USE MPI 58 62 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, & 62 70 ONLY: message_string 63 71 … … 67 75 TYPE pmc_layout 68 76 69 CHARACTER(LEN=32) :: name 70 71 INTEGER 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 !< 74 82 75 83 REAL(wp) :: lower_left_x !< … … 78 86 END TYPE pmc_layout 79 87 80 PUBLIC pmc_status_ok, pmc_status_error 88 PUBLIC pmc_status_ok, pmc_status_error !< 81 89 82 90 INTEGER, PARAMETER, PUBLIC :: pmc_error_npes = 1 !< illegal number of processes … … 84 92 INTEGER, PARAMETER, PUBLIC :: pmc_no_namelist_found = 3 !< no couple layout namelist found 85 93 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 86 97 INTEGER :: m_world_comm !< global nesting communicator 87 INTEGER :: m_my_cpl_id !< coupler id of this model88 INTEGER :: m_parent_id !< coupler id of parent of this model89 INTEGER :: m_ncpl !< number of couplers given in nesting_parameters namelist90 98 91 99 TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) :: m_couplers !< information of all couplers 92 100 93 101 INTEGER, PUBLIC :: m_model_comm !< communicator of this model 102 INTEGER, PUBLIC :: m_model_npes !< 103 INTEGER, PUBLIC :: m_model_rank !< 94 104 INTEGER, PUBLIC :: m_to_parent_comm !< communicator to the parent 95 105 INTEGER, PUBLIC :: m_world_rank !< 106 INTEGER :: m_parent_remote_size !< number of processes in the parent model 96 107 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 model100 108 INTEGER :: peer_comm !< peer_communicator for inter communicators 101 109 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 105 117 106 118 INTERFACE pmc_is_rootmodel … … 108 120 END INTERFACE pmc_is_rootmodel 109 121 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 115 125 116 126 CONTAINS 117 127 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, & 119 135 anterpolation_buffer_width, pmc_status ) 120 136 121 USE control_parameters, &137 USE control_parameters, & 122 138 ONLY: message_string 123 139 124 USE pegrid, &140 USE pegrid, & 125 141 ONLY: myid 126 142 127 143 IMPLICIT NONE 128 144 145 CHARACTER(LEN=7), INTENT(INOUT) :: nesting_datatransfer_mode !< 129 146 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 !< 135 151 136 152 INTEGER :: childcount !< … … 141 157 INTEGER :: tag !< 142 158 143 INTEGER, DIMENSION(pmc_max_models) :: activeparent ! I am active parent for this child ID144 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 !< 145 161 146 162 pmc_status = pmc_status_ok … … 158 174 IF ( m_world_rank == 0 ) THEN 159 175 160 CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode, &176 CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode, & 161 177 anterpolation_buffer_width, pmc_status ) 162 178 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 ) & 165 181 THEN 166 182 ! … … 172 188 173 189 ! 174 !-- The sum of numbers of processes requested by all the domains 175 !-- must be equal to the totalnumber of processes of the run190 !-- The sum of numbers of processes requested by all the domains must be equal to the total 191 !-- number of processes of the run 176 192 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,')' 181 197 CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 ) 182 198 ENDIF … … 186 202 ENDIF 187 203 ! 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). 192 207 CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) 193 208 … … 200 215 ELSEIF ( pmc_status == pmc_namelist_error ) THEN 201 216 ! 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 and204 !-- comm2d have not yet been assigned at thispoint.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. 205 220 IF ( m_world_rank == 0 ) THEN 206 221 message_string = 'errors in \$nesting_parameters' … … 215 230 !-- Broadcast coupling layout 216 231 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 ), & 218 233 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, & 220 235 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, & 222 237 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, & 224 239 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, & 226 241 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, & 228 243 MPI_COMM_WORLD, istat ) 229 244 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, & 231 247 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 ) 236 249 ! 237 250 !-- Assign global MPI processes to individual models by setting the couple id 238 251 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 241 253 m_my_cpl_id = i 242 254 EXIT … … 245 257 m_my_cpl_rank = m_world_rank - start_pe(i) 246 258 ! 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 ) 252 263 ! 253 264 !-- Get size and rank of the model running on this process … … 257 268 !-- Broadcast (from process 0) the parent id and id of every model 258 269 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 ) 263 272 ENDDO 264 273 ! … … 268 277 ! 269 278 !-- 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 ) 276 283 DO i = 2, m_ncpl 277 284 IF ( m_couplers(i)%parent_id == m_my_cpl_id ) THEN 278 285 ! 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. 282 288 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 ) 285 291 childcount = childcount + 1 286 292 activeparent(i) = 1 287 293 ELSEIF ( i == m_my_cpl_id) THEN 288 294 ! 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. 291 296 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 ) 295 299 ENDIF 296 300 ENDDO 297 301 ! 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. 301 304 ALLOCATE( pmc_parent_for_child(childcount+1) ) 302 305 … … 311 314 !-- Get the size of the parent model 312 315 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 ) 315 317 ELSE 316 318 ! … … 319 321 ENDIF 320 322 ! 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. 327 328 IF ( m_world_rank /= 0 ) myid = 1 328 329 … … 330 331 331 332 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 ) 336 340 ! 337 341 !-- Provide module private variables of the pmc for PALM … … 407 411 408 412 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 ) 411 420 412 421 IMPLICIT NONE 413 422 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 428 440 ! 429 441 !-- Initialize some coupling variables … … 435 447 !-- Open the NAMELIST-file and read the nesting layout 436 448 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 readthe inipar-NAMELIST449 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 441 453 REWIND ( 11 ) 442 454 … … 473 485 ENDDO 474 486 ! 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 477 488 IF ( nesting_mode == 'vertical' ) THEN 478 489 bad_llcorner = 0 479 490 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. & 481 492 domain_layouts(i)%lower_left_y /= 0.0_wp ) THEN 482 493 bad_llcorner = bad_llcorner + 1 … … 486 497 ENDDO 487 498 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 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)' 491 502 CALL message( 'read_coupling_layout', 'PA0427', 0, 0, 0, 6, 0 ) 492 503 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
