[1764] | 1 | MODULE PMC_handle_communicator |
---|
[1762] | 2 | |
---|
| 3 | !--------------------------------------------------------------------------------! |
---|
| 4 | ! This file is part of PALM. |
---|
| 5 | ! |
---|
| 6 | ! PALM is free software: you can redistribute it and/or modify it under the terms |
---|
| 7 | ! of the GNU General Public License as published by the Free Software Foundation, |
---|
| 8 | ! either version 3 of the License, or (at your option) any later 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/>. |
---|
| 16 | ! |
---|
| 17 | ! Copyright 1997-2015 Leibniz Universitaet Hannover |
---|
| 18 | !--------------------------------------------------------------------------------! |
---|
| 19 | ! |
---|
| 20 | ! Current revisions: |
---|
| 21 | ! ------------------ |
---|
[1779] | 22 | ! only the total number of PEs is given in the nestpar-NAMELIST, |
---|
| 23 | ! additional comments included |
---|
[1765] | 24 | ! |
---|
| 25 | ! Former revisions: |
---|
| 26 | ! ----------------- |
---|
| 27 | ! $Id: pmc_handle_communicator.f90 1779 2016-03-03 08:01:28Z raasch $ |
---|
| 28 | ! |
---|
| 29 | ! 1764 2016-02-28 12:45:19Z raasch |
---|
[1764] | 30 | ! pmc_layout type: comm_cpl and comm_parent removed, character "name" moved at |
---|
| 31 | ! the beginning of the variable list, |
---|
| 32 | ! domain layout is read with new NAMELIST nestpar from standard file PARIN, |
---|
| 33 | ! MPI-datatype REAL8 replaced by REAL, kind=8 replaced by wp, |
---|
| 34 | ! variable domain_layouts instead of m_couplers introduced for this NAMELIST, |
---|
| 35 | ! general format changed to PALM style |
---|
[1762] | 36 | ! |
---|
[1763] | 37 | ! 1762 2016-02-25 12:31:13Z hellstea |
---|
| 38 | ! Initial revision by K. Ketelsen |
---|
| 39 | ! |
---|
[1762] | 40 | ! Description: |
---|
| 41 | ! ------------ |
---|
[1764] | 42 | ! Handle MPI communicator in PALM model coupler |
---|
[1762] | 43 | !------------------------------------------------------------------------------! |
---|
| 44 | |
---|
[1764] | 45 | #if defined( __parallel ) |
---|
| 46 | USE kinds |
---|
[1762] | 47 | |
---|
[1764] | 48 | #if defined( __lc ) |
---|
| 49 | USE MPI |
---|
| 50 | #else |
---|
| 51 | INCLUDE "mpif.h" |
---|
| 52 | #endif |
---|
[1762] | 53 | |
---|
[1764] | 54 | USE pmc_general, & |
---|
| 55 | ONLY: pmc_status_ok, pmc_status_error, pmc_max_modell |
---|
[1762] | 56 | |
---|
[1764] | 57 | IMPLICIT NONE |
---|
[1762] | 58 | |
---|
[1764] | 59 | TYPE pmc_layout |
---|
[1762] | 60 | |
---|
[1764] | 61 | CHARACTER(len=32) :: name |
---|
[1762] | 62 | |
---|
[1764] | 63 | INTEGER :: id |
---|
| 64 | INTEGER :: parent_id |
---|
[1779] | 65 | INTEGER :: npe_total |
---|
[1762] | 66 | |
---|
[1764] | 67 | REAL(wp) :: lower_left_x |
---|
| 68 | REAL(wp) :: lower_left_y |
---|
[1762] | 69 | |
---|
[1764] | 70 | END TYPE pmc_layout |
---|
| 71 | |
---|
| 72 | PUBLIC pmc_status_ok, pmc_status_error |
---|
| 73 | |
---|
| 74 | INTEGER, PARAMETER, PUBLIC :: pmc_error_npes = 1 ! illegal number of PEs |
---|
| 75 | INTEGER, PARAMETER, PUBLIC :: pmc_namelist_error = 2 ! error(s) in nestpar namelist |
---|
| 76 | INTEGER, PARAMETER, PUBLIC :: pmc_no_namelist_found = 3 ! No couple layout file found |
---|
| 77 | |
---|
[1762] | 78 | ! Coupler Setup |
---|
| 79 | |
---|
| 80 | INTEGER :: m_my_CPL_id !Coupler id of this model |
---|
| 81 | INTEGER :: m_Parent_id !Coupler id of parent of this model |
---|
| 82 | INTEGER :: m_NrOfCpl !Number of Coupler in layout file |
---|
[1764] | 83 | TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers !Information of all coupler |
---|
[1762] | 84 | |
---|
| 85 | ! MPI settings |
---|
| 86 | |
---|
| 87 | INTEGER,PUBLIC :: m_model_comm !Communicator of this model |
---|
| 88 | INTEGER,PUBLIC :: m_to_server_comm !Communicator to the server |
---|
| 89 | INTEGER,DIMENSION(PMC_MAX_MODELL) :: m_to_client_comm !Communicator to the client(s) |
---|
| 90 | INTEGER,PUBLIC :: m_world_rank |
---|
| 91 | INTEGER :: m_world_npes |
---|
| 92 | INTEGER,PUBLIC :: m_model_rank |
---|
| 93 | INTEGER,PUBLIC :: m_model_npes |
---|
| 94 | INTEGER :: m_server_remote_size !Number of Server PE's |
---|
| 95 | |
---|
| 96 | PUBLIC m_to_client_comm |
---|
| 97 | |
---|
| 98 | !Indicates this PE is server for Cleint NR |
---|
| 99 | |
---|
| 100 | INTEGER,DIMENSION(:),POINTER,PUBLIC :: PMC_Server_for_Client |
---|
| 101 | |
---|
[1764] | 102 | INTERFACE pmc_is_rootmodel |
---|
| 103 | MODULE PROCEDURE pmc_is_rootmodel |
---|
| 104 | END INTERFACE pmc_is_rootmodel |
---|
[1762] | 105 | |
---|
| 106 | INTERFACE PMC_get_local_model_info |
---|
| 107 | MODULE PROCEDURE PMC_get_local_model_info |
---|
| 108 | END INTERFACE PMC_get_local_model_info |
---|
| 109 | |
---|
[1764] | 110 | PUBLIC pmc_get_local_model_info, pmc_init_model, pmc_is_rootmodel |
---|
[1762] | 111 | |
---|
[1764] | 112 | CONTAINS |
---|
[1762] | 113 | |
---|
[1764] | 114 | SUBROUTINE pmc_init_model( comm, nesting_mode, pmc_status ) |
---|
[1762] | 115 | |
---|
[1764] | 116 | USE control_parameters, & |
---|
| 117 | ONLY: message_string |
---|
| 118 | |
---|
| 119 | USE pegrid, & |
---|
| 120 | ONLY: myid |
---|
| 121 | |
---|
| 122 | IMPLICIT NONE |
---|
| 123 | |
---|
| 124 | CHARACTER(LEN=7), INTENT(OUT) :: nesting_mode |
---|
| 125 | |
---|
| 126 | INTEGER, INTENT(OUT) :: comm |
---|
| 127 | INTEGER, INTENT(OUT) :: pmc_status |
---|
| 128 | |
---|
| 129 | INTEGER :: i, ierr, istat |
---|
| 130 | INTEGER,DIMENSION(pmc_max_modell+1) :: start_pe |
---|
| 131 | INTEGER :: m_my_cpl_rank |
---|
| 132 | INTEGER :: tag, clientcount |
---|
| 133 | INTEGER,DIMENSION(pmc_max_modell) :: activeserver ! I am active server for this client ID |
---|
| 134 | |
---|
| 135 | pmc_status = pmc_status_ok |
---|
[1762] | 136 | comm = -1 |
---|
[1764] | 137 | m_my_cpl_id = -1 |
---|
| 138 | clientcount = 0 |
---|
| 139 | activeserver = -1 |
---|
| 140 | start_pe(:) = 0 |
---|
[1762] | 141 | |
---|
[1764] | 142 | CALL MPI_COMM_RANK( MPI_COMM_WORLD, m_world_rank, istat ) |
---|
| 143 | CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat ) |
---|
| 144 | ! |
---|
| 145 | !-- Only PE 0 of root model reads |
---|
| 146 | IF ( m_world_rank == 0 ) THEN |
---|
[1762] | 147 | |
---|
[1764] | 148 | CALL read_coupling_layout( nesting_mode, pmc_status ) |
---|
[1762] | 149 | |
---|
[1764] | 150 | IF ( pmc_status /= pmc_no_namelist_found .AND. & |
---|
| 151 | pmc_status /= pmc_namelist_error ) & |
---|
| 152 | THEN |
---|
| 153 | ! |
---|
| 154 | !-- Calculate start PE of every model |
---|
| 155 | start_pe(1) = 0 |
---|
| 156 | DO i = 2, m_nrofcpl+1 |
---|
[1779] | 157 | start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total |
---|
[1764] | 158 | ENDDO |
---|
[1762] | 159 | |
---|
[1764] | 160 | ! |
---|
| 161 | !-- The number of cores provided with the run must be the same as the |
---|
| 162 | !-- total sum of cores required by all nest domains |
---|
| 163 | IF ( start_pe(m_nrofcpl+1) /= m_world_npes ) THEN |
---|
[1779] | 164 | WRITE ( message_string, '(A,I6,A,I6,A)' ) & |
---|
| 165 | 'nesting-setup requires more MPI procs (', & |
---|
| 166 | start_pe(m_nrofcpl+1), ') than provided (', & |
---|
| 167 | m_world_npes,')' |
---|
| 168 | CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 ) |
---|
[1764] | 169 | ENDIF |
---|
[1762] | 170 | |
---|
[1764] | 171 | ENDIF |
---|
[1762] | 172 | |
---|
[1764] | 173 | ENDIF |
---|
| 174 | ! |
---|
| 175 | !-- Broadcast the read status. This synchronises all other PEs with PE 0 of |
---|
| 176 | !-- the root model. Without synchronisation, they would not behave in the |
---|
| 177 | !-- correct way (e.g. they would not return in case of a missing NAMELIST) |
---|
| 178 | CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) |
---|
[1762] | 179 | |
---|
[1764] | 180 | IF ( pmc_status == pmc_no_namelist_found ) THEN |
---|
| 181 | ! |
---|
| 182 | !-- Not a nested run; return the MPI_WORLD communicator |
---|
| 183 | comm = MPI_COMM_WORLD |
---|
| 184 | RETURN |
---|
[1762] | 185 | |
---|
[1764] | 186 | ELSEIF ( pmc_status == pmc_namelist_error ) THEN |
---|
| 187 | ! |
---|
| 188 | !-- Only the root model gives the error message. Others are aborted by the |
---|
| 189 | !-- message-routine with MPI_ABORT. Must be done this way since myid and |
---|
| 190 | !-- comm2d have not yet been assigned at this point. |
---|
| 191 | IF ( m_world_rank == 0 ) THEN |
---|
| 192 | message_string = 'errors in \$nestpar' |
---|
| 193 | CALL message( 'pmc_init_model', 'PA0223', 3, 2, 0, 6, 0 ) |
---|
| 194 | ENDIF |
---|
[1762] | 195 | |
---|
[1764] | 196 | ENDIF |
---|
[1762] | 197 | |
---|
[1764] | 198 | CALL MPI_BCAST( m_nrofcpl, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) |
---|
| 199 | CALL MPI_BCAST( start_pe, m_nrofcpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) |
---|
[1762] | 200 | |
---|
[1764] | 201 | ! |
---|
| 202 | !-- Broadcast coupling layout |
---|
| 203 | DO i = 1, m_nrofcpl |
---|
| 204 | CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat ) |
---|
| 205 | CALL MPI_BCAST( m_couplers(i)%id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) |
---|
| 206 | CALL MPI_BCAST( m_couplers(i)%Parent_id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) |
---|
[1779] | 207 | CALL MPI_BCAST( m_couplers(i)%npe_total, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) |
---|
[1764] | 208 | CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL, 0, MPI_COMM_WORLD, istat ) |
---|
| 209 | CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL, 0, MPI_COMM_WORLD, istat ) |
---|
| 210 | ENDDO |
---|
[1762] | 211 | |
---|
[1764] | 212 | ! |
---|
| 213 | !-- Assign global MPI processes to individual models by setting the couple id |
---|
| 214 | DO i = 1, m_nrofcpl |
---|
| 215 | IF ( m_world_rank >= start_pe(i) .AND. m_world_rank < start_pe(i+1) ) & |
---|
| 216 | THEN |
---|
| 217 | m_my_cpl_id = i |
---|
| 218 | EXIT |
---|
| 219 | ENDIF |
---|
| 220 | ENDDO |
---|
| 221 | m_my_cpl_rank = m_world_rank - start_pe(i) |
---|
[1762] | 222 | |
---|
[1764] | 223 | ! |
---|
| 224 | !-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach). |
---|
| 225 | !-- The communictors for the individual models as created by MPI_COMM_SPLIT. |
---|
| 226 | !-- The color of the model is represented by the coupler id |
---|
| 227 | CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm, & |
---|
| 228 | istat ) |
---|
| 229 | ! |
---|
| 230 | !-- Get size and rank of the model running on this PE |
---|
| 231 | CALL MPI_COMM_RANK( comm, m_model_rank, istat ) |
---|
| 232 | CALL MPI_COMM_SIZE( comm, m_model_npes, istat ) |
---|
[1762] | 233 | |
---|
[1764] | 234 | ! |
---|
| 235 | !-- Broadcast (from PE 0) the parent id and id of every model |
---|
| 236 | DO i = 1, m_nrofcpl |
---|
| 237 | CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, & |
---|
| 238 | MPI_COMM_WORLD, istat ) |
---|
| 239 | CALL MPI_BCAST( m_couplers(i)%id, 1, MPI_INTEGER, 0, & |
---|
| 240 | MPI_COMM_WORLD, istat ) |
---|
| 241 | ENDDO |
---|
[1762] | 242 | |
---|
[1764] | 243 | ! |
---|
[1779] | 244 | !-- Save the current model communicator for PMC internal use |
---|
[1762] | 245 | m_model_comm = comm |
---|
| 246 | |
---|
[1764] | 247 | ! |
---|
| 248 | !-- Create intercommunicator between server and clients. |
---|
| 249 | !-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of |
---|
| 250 | !-- different colors. |
---|
| 251 | !-- The grouping was done above with MPI_COMM_SPLIT |
---|
| 252 | DO i = 2, m_nrofcpl |
---|
[1762] | 253 | |
---|
[1764] | 254 | IF ( m_couplers(i)%parent_id == m_my_cpl_id ) THEN |
---|
| 255 | ! |
---|
[1779] | 256 | !-- Collect server PEs. |
---|
| 257 | !-- Every model exept the root model has a parent model which acts as |
---|
| 258 | !-- server model. Create an intercommunicator to connect current PE to |
---|
| 259 | !-- all client PEs |
---|
[1764] | 260 | tag = 500 + i |
---|
| 261 | CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i), & |
---|
| 262 | tag, m_to_client_comm(i), istat) |
---|
| 263 | clientcount = clientcount + 1 |
---|
| 264 | activeserver(i) = 1 |
---|
[1762] | 265 | |
---|
[1764] | 266 | ELSEIF ( i == m_my_cpl_id) THEN |
---|
| 267 | ! |
---|
[1779] | 268 | !-- Collect client PEs. |
---|
| 269 | !-- Every model exept the root model has a paremt model which acts as |
---|
| 270 | !-- server model. Create an intercommunicator to connect current PE to |
---|
| 271 | !-- all server PEs |
---|
[1764] | 272 | tag = 500 + i |
---|
| 273 | CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, & |
---|
| 274 | start_pe(m_couplers(i)%parent_id), & |
---|
| 275 | tag, m_to_server_comm, istat ) |
---|
| 276 | ENDIF |
---|
[1762] | 277 | |
---|
[1764] | 278 | ENDDO |
---|
[1762] | 279 | |
---|
[1764] | 280 | ! |
---|
| 281 | !-- If I am server, count the number of clients that I have |
---|
| 282 | !-- Although this loop is symmetric on all processes, the "activeserver" flag |
---|
| 283 | !-- is true (==1) on the respective individual PE only. |
---|
| 284 | ALLOCATE( pmc_server_for_client(clientcount+1) ) |
---|
[1762] | 285 | |
---|
[1764] | 286 | clientcount = 0 |
---|
| 287 | DO i = 2, m_nrofcpl |
---|
| 288 | IF ( activeserver(i) == 1 ) THEN |
---|
| 289 | clientcount = clientcount + 1 |
---|
| 290 | pmc_server_for_client(clientcount) = i |
---|
| 291 | ENDIF |
---|
| 292 | ENDDO |
---|
| 293 | ! |
---|
| 294 | !-- Get the size of the server model |
---|
| 295 | IF ( m_my_cpl_id > 1 ) THEN |
---|
| 296 | CALL MPI_COMM_REMOTE_SIZE( m_to_server_comm, m_server_remote_size, & |
---|
| 297 | istat) |
---|
| 298 | ELSE |
---|
| 299 | ! |
---|
| 300 | !-- The root model does not have a server |
---|
| 301 | m_server_remote_size = -1 ! |
---|
| 302 | ENDIF |
---|
| 303 | ! |
---|
| 304 | !-- Set myid to non-tero value except for the root domain. This is a setting |
---|
| 305 | !-- for the message routine which is called at the end of pmci_init. That |
---|
| 306 | !-- routine outputs messages for myid = 0, only. However, myid has not been |
---|
| 307 | !-- assigened so far, so that all PEs of the root model would output a |
---|
| 308 | !-- message. To avoid this, set myid to some other value except for PE0 of the |
---|
| 309 | !-- root domain. |
---|
| 310 | IF ( m_world_rank /= 0 ) myid = 1 |
---|
[1762] | 311 | |
---|
| 312 | END SUBROUTINE PMC_init_model |
---|
| 313 | |
---|
| 314 | |
---|
[1764] | 315 | ! |
---|
| 316 | !-- Make module private variables available to palm |
---|
| 317 | SUBROUTINE pmc_get_local_model_info( my_cpl_id, my_cpl_parent_id, cpl_name, & |
---|
[1779] | 318 | npe_total, lower_left_x, lower_left_y ) |
---|
[1762] | 319 | |
---|
[1764] | 320 | USE kinds |
---|
[1762] | 321 | |
---|
[1764] | 322 | IMPLICIT NONE |
---|
[1762] | 323 | |
---|
[1764] | 324 | CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: cpl_name |
---|
| 325 | INTEGER, INTENT(OUT), OPTIONAL :: my_cpl_id |
---|
| 326 | INTEGER, INTENT(OUT), OPTIONAL :: my_cpl_parent_id |
---|
[1779] | 327 | INTEGER, INTENT(OUT), OPTIONAL :: npe_total |
---|
[1764] | 328 | REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_x |
---|
| 329 | REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_y |
---|
[1762] | 330 | |
---|
[1764] | 331 | IF ( PRESENT( my_cpl_id ) ) my_cpl_id = m_my_cpl_id |
---|
| 332 | IF ( PRESENT( my_cpl_parent_id ) ) my_cpl_parent_id = m_couplers(my_cpl_id)%parent_id |
---|
| 333 | IF ( PRESENT( cpl_name ) ) cpl_name = m_couplers(my_cpl_id)%name |
---|
[1779] | 334 | IF ( PRESENT( npe_total ) ) npe_total = m_couplers(my_cpl_id)%npe_total |
---|
[1764] | 335 | IF ( PRESENT( lower_left_x ) ) lower_left_x = m_couplers(my_cpl_id)%lower_left_x |
---|
| 336 | IF ( PRESENT( lower_left_y ) ) lower_left_y = m_couplers(my_cpl_id)%lower_left_y |
---|
[1762] | 337 | |
---|
[1764] | 338 | END SUBROUTINE pmc_get_local_model_info |
---|
[1762] | 339 | |
---|
[1764] | 340 | |
---|
| 341 | |
---|
| 342 | LOGICAL function pmc_is_rootmodel( ) |
---|
| 343 | |
---|
| 344 | IMPLICIT NONE |
---|
| 345 | |
---|
| 346 | pmc_is_rootmodel = ( m_my_cpl_id == 1 ) |
---|
| 347 | |
---|
| 348 | END FUNCTION pmc_is_rootmodel |
---|
| 349 | |
---|
| 350 | |
---|
| 351 | |
---|
| 352 | SUBROUTINE read_coupling_layout( nesting_mode, pmc_status ) |
---|
[1762] | 353 | |
---|
[1764] | 354 | IMPLICIT NONE |
---|
[1762] | 355 | |
---|
[1764] | 356 | CHARACTER(LEN=7) :: nesting_mode |
---|
| 357 | |
---|
| 358 | INTEGER, INTENT(INOUT) :: pmc_status |
---|
| 359 | INTEGER :: i, istat, iunit |
---|
| 360 | |
---|
| 361 | TYPE(pmc_layout), DIMENSION(pmc_max_modell) :: domain_layouts |
---|
| 362 | |
---|
| 363 | |
---|
| 364 | NAMELIST /nestpar/ domain_layouts, nesting_mode |
---|
| 365 | |
---|
| 366 | ! |
---|
| 367 | !-- Initialize some coupling variables |
---|
| 368 | domain_layouts(1:pmc_max_modell)%id = -1 |
---|
| 369 | m_nrofcpl = 0 |
---|
[1762] | 370 | iunit = 345 |
---|
| 371 | |
---|
[1764] | 372 | pmc_status = pmc_status_ok |
---|
| 373 | |
---|
| 374 | ! |
---|
| 375 | !-- Open the NAMELIST-file and read the nesting layout |
---|
| 376 | CALL check_open( 11 ) |
---|
| 377 | READ ( 11, nestpar, IOSTAT=istat ) |
---|
| 378 | |
---|
| 379 | IF ( istat < 0 ) THEN |
---|
| 380 | ! |
---|
| 381 | !-- No nestpar-NAMELIST found |
---|
| 382 | pmc_status = pmc_no_namelist_found |
---|
| 383 | ! |
---|
| 384 | !-- Set filepointer to the beginning of the file. Otherwise PE0 will later |
---|
| 385 | !-- be unable to read the inipar-NAMELIST |
---|
| 386 | REWIND ( 11 ) |
---|
[1762] | 387 | RETURN |
---|
| 388 | |
---|
[1764] | 389 | ELSEIF ( istat > 0 ) THEN |
---|
| 390 | ! |
---|
| 391 | !-- Errors in reading nestpar-NAMELIST |
---|
| 392 | pmc_status = pmc_namelist_error |
---|
| 393 | RETURN |
---|
[1762] | 394 | |
---|
[1764] | 395 | ENDIF |
---|
[1762] | 396 | |
---|
[1764] | 397 | ! |
---|
| 398 | !-- Output location message |
---|
| 399 | CALL location_message( 'initialize communicators for nesting', .FALSE. ) |
---|
| 400 | ! |
---|
| 401 | !-- Assign the layout to the internally used variable |
---|
| 402 | m_couplers = domain_layouts |
---|
[1762] | 403 | |
---|
[1764] | 404 | ! |
---|
| 405 | !-- Get the number of nested models given in the nestpar-NAMELIST |
---|
| 406 | DO i = 1, pmc_max_modell |
---|
[1762] | 407 | |
---|
[1764] | 408 | IF ( m_couplers(i)%id /= -1 .AND. i <= pmc_max_modell ) THEN |
---|
[1779] | 409 | WRITE ( 0, '(A,A,1X,3I7,1X,2F10.2)' ) 'Set up Model ', & |
---|
| 410 | TRIM( m_couplers(i)%name ), m_couplers(i)%id, & |
---|
| 411 | m_couplers(i)%Parent_id, m_couplers(i)%npe_total, & |
---|
| 412 | m_couplers(i)%lower_left_x, & |
---|
| 413 | m_couplers(i)%lower_left_y |
---|
[1764] | 414 | ELSE |
---|
| 415 | ! |
---|
| 416 | !-- When id=-1 is found for the first time, the list of domains is |
---|
| 417 | !-- finished (or latest after pmc_max_modell entries |
---|
| 418 | m_nrofcpl = i - 1 |
---|
| 419 | EXIT |
---|
| 420 | ENDIF |
---|
| 421 | |
---|
| 422 | ENDDO |
---|
| 423 | |
---|
| 424 | END SUBROUTINE read_coupling_layout |
---|
| 425 | |
---|
| 426 | #endif |
---|
| 427 | END MODULE pmc_handle_communicator |
---|