Changeset 2599 for palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
- Timestamp:
- Nov 1, 2017 1:18:45 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
r2516 r2599 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Separate peer communicator peer_comm introduced for MPI_INTERCOMM_CREATE. 29 ! Some cleanup and commenting improvements. 30 ! 31 ! 2516 2017-10-04 11:03:04Z suehring 28 32 ! Remove tabs 29 33 ! … … 127 131 PUBLIC pmc_status_ok, pmc_status_error 128 132 129 INTEGER, PARAMETER, PUBLIC :: pmc_error_npes = 1 !< illegal number of PEs133 INTEGER, PARAMETER, PUBLIC :: pmc_error_npes = 1 !< illegal number of processes 130 134 INTEGER, PARAMETER, PUBLIC :: pmc_namelist_error = 2 !< error(s) in nestpar namelist 131 135 INTEGER, PARAMETER, PUBLIC :: pmc_no_namelist_found = 3 !< no couple layout namelist found … … 144 148 INTEGER, PUBLIC :: m_model_rank !< 145 149 INTEGER, PUBLIC :: m_model_npes !< 146 INTEGER :: m_parent_remote_size !< number of parent PEs 150 INTEGER :: m_parent_remote_size !< number of processes in the parent model 151 INTEGER :: peer_comm !< peer_communicator for inter communicators 147 152 148 153 INTEGER, DIMENSION(pmc_max_models), PUBLIC :: m_to_child_comm !< communicator to the child(ren) … … 200 205 CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat ) 201 206 ! 202 !-- Only PE0 of root model reads207 !-- Only process 0 of root model reads 203 208 IF ( m_world_rank == 0 ) THEN 204 209 … … 210 215 THEN 211 216 ! 212 !-- Calculate start PE of everymodel217 !-- Determine the first process id of each model 213 218 start_pe(1) = 0 214 219 DO i = 2, m_ncpl+1 … … 217 222 218 223 ! 219 !-- The number of cores provided with the run must be the same as the220 !-- total sum of cores required by all nest domains224 !-- The sum of numbers of processes requested by all the domains 225 !-- must be equal to the total number of processes of the run 221 226 IF ( start_pe(m_ncpl+1) /= m_world_npes ) THEN 222 227 WRITE ( message_string, '(2A,I6,2A,I6,A)' ) & … … 231 236 ENDIF 232 237 ! 233 !-- Broadcast the read status. This synchronises all other PEs with PE 0 of 234 !-- the root model. Without synchronisation, they would not behave in the 235 !-- correct way (e.g. they would not return in case of a missing NAMELIST) 238 !-- Broadcast the read status. This synchronises all other processes with 239 !-- process 0 of the root model. Without synchronisation, they would not 240 !-- behave in the correct way (e.g. they would not return in case of a 241 !-- missing NAMELIST). 236 242 CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) 237 243 … … 254 260 ENDIF 255 261 256 CALL MPI_BCAST( m_ncpl, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) 257 CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) 258 262 CALL MPI_BCAST( m_ncpl, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) 263 CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) 259 264 ! 260 265 !-- Broadcast coupling layout … … 277 282 CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode), & 278 283 MPI_CHARACTER, 0, MPI_COMM_WORLD, istat ) 279 280 284 ! 281 285 !-- Assign global MPI processes to individual models by setting the couple id … … 288 292 ENDDO 289 293 m_my_cpl_rank = m_world_rank - start_pe(i) 290 291 294 ! 292 295 !-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach). … … 296 299 istat ) 297 300 ! 298 !-- Get size and rank of the model running on this PE301 !-- Get size and rank of the model running on this process 299 302 CALL MPI_COMM_RANK( comm, m_model_rank, istat ) 300 303 CALL MPI_COMM_SIZE( comm, m_model_npes, istat ) 301 302 ! 303 !-- Broadcast (from PE 0) the parent id and id of every model 304 ! 305 !-- Broadcast (from process 0) the parent id and id of every model 304 306 DO i = 1, m_ncpl 305 307 CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, & … … 308 310 MPI_COMM_WORLD, istat ) 309 311 ENDDO 310 311 312 ! 312 313 !-- Save the current model communicator for pmc internal use … … 314 315 315 316 ! 316 !-- Create intercommunicator between parent and children.317 !-- Create intercommunicator between the parent and children. 317 318 !-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of 318 319 !-- different colors. 319 !-- The grouping was done above with MPI_COMM_SPLIT 320 !-- The grouping was done above with MPI_COMM_SPLIT. 321 !-- A duplicate of MPI_COMM_WORLD is created and used as peer communicator 322 !-- (peer_comm) for MPI_INTERCOMM_CREATE. 323 CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr ) 320 324 DO i = 2, m_ncpl 321 322 325 IF ( m_couplers(i)%parent_id == m_my_cpl_id ) THEN 323 326 ! 324 !-- Collect parent PEs. 325 !-- Every model exept the root model has a parent model which acts as 326 !-- parent model. Create an intercommunicator to connect current PE to 327 !-- all children PEs 327 !-- Identify all children models of the current model and create 328 !-- inter-communicators to connect between the current model and its 329 !-- children models. 328 330 tag = 500 + i 329 CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i),&331 CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i), & 330 332 tag, m_to_child_comm(i), istat) 331 333 childcount = childcount + 1 332 334 activeparent(i) = 1 333 334 335 ELSEIF ( i == m_my_cpl_id) THEN 335 336 ! 336 !-- Collect children PEs. 337 !-- Every model except the root model has a parent model. 338 !-- Create an intercommunicator to connect current PE to all parent PEs 337 !-- Create an inter-communicator to connect between the current 338 !-- model and its parent model. 339 339 tag = 500 + i 340 CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD,&340 CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, & 341 341 start_pe(m_couplers(i)%parent_id), & 342 342 tag, m_to_parent_comm, istat ) 343 343 ENDIF 344 345 344 ENDDO 346 347 ! 348 !-- If I am parent, count the number of children that I have 345 ! 346 !-- If I am a parent, count the number of children I have. 349 347 !-- Although this loop is symmetric on all processes, the "activeparent" flag 350 !-- is true (==1) on the respective individual PEonly.348 !-- is true (==1) on the respective individual process only. 351 349 ALLOCATE( pmc_parent_for_child(childcount+1) ) 352 350 … … 362 360 IF ( m_my_cpl_id > 1 ) THEN 363 361 CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size, & 364 istat )362 istat ) 365 363 ELSE 366 364 ! … … 369 367 ENDIF 370 368 ! 371 !-- Set myid to non- tero value except for the root domain. This is a setting369 !-- Set myid to non-zero value except for the root domain. This is a setting 372 370 !-- for the message routine which is called at the end of pmci_init. That 373 371 !-- routine outputs messages for myid = 0, only. However, myid has not been 374 !-- assigened so far, so that all PEs of the root model would output a375 !-- message. To avoid this, set myid to some other value except for PE0 of the376 !-- root domain.372 !-- assigened so far, so that all processes of the root model would output a 373 !-- message. To avoid this, set myid to some other value except for process 0 374 !-- of the root domain. 377 375 IF ( m_world_rank /= 0 ) myid = 1 378 376 … … 401 399 INTEGER, INTENT(OUT), OPTIONAL :: npe_total !< 402 400 403 INTEGER :: requested_cpl_id !<404 405 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_x !<406 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_y !<401 INTEGER :: requested_cpl_id !< 402 403 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_x !< 404 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_y !< 407 405 408 406 ! … … 416 414 requested_cpl_id = m_my_cpl_id 417 415 ENDIF 418 419 416 ! 420 417 !-- Return the requested information … … 459 456 460 457 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode, & 461 458 pmc_status ) 462 459 463 460 IMPLICIT NONE … … 481 478 482 479 pmc_status = pmc_status_ok 483 484 480 ! 485 481 !-- Open the NAMELIST-file and read the nesting layout … … 487 483 READ ( 11, nestpar, IOSTAT=istat ) 488 484 ! 489 !-- Set filepointer to the beginning of the file. Otherwise PE0 will later485 !-- Set filepointer to the beginning of the file. Otherwise process 0 will later 490 486 !-- be unable to read the inipar-NAMELIST 491 487 REWIND ( 11 ) 492 488 493 489 IF ( istat < 0 ) THEN 494 495 490 ! 496 491 !-- No nestpar-NAMELIST found 497 492 pmc_status = pmc_no_namelist_found 498 499 493 RETURN 500 501 494 ELSEIF ( istat > 0 ) THEN 502 503 495 ! 504 496 !-- Errors in reading nestpar-NAMELIST 505 497 pmc_status = pmc_namelist_error 506 498 RETURN 507 508 ENDIF 509 499 ENDIF 510 500 ! 511 501 !-- Output location message 512 502 CALL location_message( 'initialize communicators for nesting', .FALSE. ) 513 514 ! 515 !-- Assign the layout to the internally used variable 503 ! 504 !-- Assign the layout to the corresponding internally used variable m_couplers 516 505 m_couplers = domain_layouts 517 518 506 ! 519 507 !-- Get the number of nested models given in the nestpar-NAMELIST … … 521 509 ! 522 510 !-- When id=-1 is found for the first time, the list of domains is finished 523 511 IF ( m_couplers(i)%id == -1 .OR. i == pmc_max_models ) THEN 524 512 IF ( m_couplers(i)%id == -1 ) THEN 525 513 m_ncpl = i - 1 … … 529 517 ENDIF 530 518 ENDIF 531 532 519 ENDDO 533 534 520 ! 535 521 !-- Make sure that all domains have equal lower left corner in case of vertical
Note: See TracChangeset
for help on using the changeset viewer.
