Changeset 1791 for palm/trunk/SOURCE/pmc_handle_communicator.f90
- Timestamp:
- Mar 11, 2016 10:41:25 AM (8 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_handle_communicator.f90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_handle_communicator.f90
r1787 r1791 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! m_nrofcpl renamed m_ncpl, 23 ! pmc_get_local_model_info renamed pmc_get_model_info, some keywords also 24 ! renamed and some added, 25 ! debug write-statements commented out 23 26 ! 24 27 ! Former revisions: … … 86 89 INTEGER :: m_my_CPL_id !Coupler id of this model 87 90 INTEGER :: m_Parent_id !Coupler id of parent of this model 88 INTEGER :: m_NrOfCpl !Number of Coupler in layout file 89 TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers !Information of all coupler 91 INTEGER :: m_ncpl !Number of Couplers in layout file 92 93 TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers !Information of all couplers 90 94 91 95 ! MPI settings … … 110 114 END INTERFACE pmc_is_rootmodel 111 115 112 INTERFACE PMC_get_local_model_info113 MODULE PROCEDURE PMC_get_local_model_info114 END INTERFACE PMC_get_local_model_info115 116 PUBLIC pmc_get_ local_model_info, pmc_init_model, pmc_is_rootmodel116 INTERFACE pmc_get_model_info 117 MODULE PROCEDURE pmc_get_model_info 118 END INTERFACE pmc_get_model_info 119 120 PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel 117 121 118 122 CONTAINS … … 160 164 !-- Calculate start PE of every model 161 165 start_pe(1) = 0 162 DO i = 2, m_n rofcpl+1166 DO i = 2, m_ncpl+1 163 167 start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total 164 168 ENDDO … … 167 171 !-- The number of cores provided with the run must be the same as the 168 172 !-- total sum of cores required by all nest domains 169 IF ( start_pe(m_n rofcpl+1) /= m_world_npes ) THEN173 IF ( start_pe(m_ncpl+1) /= m_world_npes ) THEN 170 174 WRITE ( message_string, '(A,I6,A,I6,A)' ) & 171 175 'nesting-setup requires more MPI procs (', & 172 start_pe(m_n rofcpl+1), ') than provided (',&176 start_pe(m_ncpl+1), ') than provided (', & 173 177 m_world_npes,')' 174 178 CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 ) … … 202 206 ENDIF 203 207 204 CALL MPI_BCAST( m_n rofcpl, 1,MPI_INTEGER, 0, MPI_COMM_WORLD, istat)205 CALL MPI_BCAST( start_pe, m_n rofcpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)208 CALL MPI_BCAST( m_ncpl, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) 209 CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat) 206 210 207 211 ! 208 212 !-- Broadcast coupling layout 209 DO i = 1, m_n rofcpl213 DO i = 1, m_ncpl 210 214 CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat ) 211 215 CALL MPI_BCAST( m_couplers(i)%id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat ) … … 219 223 ! 220 224 !-- Assign global MPI processes to individual models by setting the couple id 221 DO i = 1, m_n rofcpl225 DO i = 1, m_ncpl 222 226 IF ( m_world_rank >= start_pe(i) .AND. m_world_rank < start_pe(i+1) ) & 223 227 THEN … … 241 245 ! 242 246 !-- Broadcast (from PE 0) the parent id and id of every model 243 DO i = 1, m_n rofcpl247 DO i = 1, m_ncpl 244 248 CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, & 245 249 MPI_COMM_WORLD, istat ) … … 257 261 !-- different colors. 258 262 !-- The grouping was done above with MPI_COMM_SPLIT 259 DO i = 2, m_n rofcpl263 DO i = 2, m_ncpl 260 264 261 265 IF ( m_couplers(i)%parent_id == m_my_cpl_id ) THEN … … 292 296 293 297 clientcount = 0 294 DO i = 2, m_n rofcpl298 DO i = 2, m_ncpl 295 299 IF ( activeserver(i) == 1 ) THEN 296 300 clientcount = clientcount + 1 … … 321 325 322 326 ! 323 !-- Make module private variables available to palm 324 SUBROUTINE pmc_get_local_model_info( my_cpl_id, my_cpl_parent_id, cpl_name, & 325 npe_total, lower_left_x, lower_left_y ) 327 !-- Provide module private variables of the pmc for PALM 328 SUBROUTINE pmc_get_model_info( cpl_id, cpl_name, cpl_parent_id, & 329 lower_left_x, lower_left_y, ncpl, npe_total,& 330 request_for_cpl_id ) 326 331 327 332 USE kinds … … 330 335 331 336 CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: cpl_name 332 INTEGER, INTENT(OUT), OPTIONAL :: my_cpl_id 333 INTEGER, INTENT(OUT), OPTIONAL :: my_cpl_parent_id 334 INTEGER, INTENT(OUT), OPTIONAL :: npe_total 335 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_x 336 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_y 337 338 IF ( PRESENT( my_cpl_id ) ) my_cpl_id = m_my_cpl_id 339 IF ( PRESENT( my_cpl_parent_id ) ) my_cpl_parent_id = m_couplers(my_cpl_id)%parent_id 340 IF ( PRESENT( cpl_name ) ) cpl_name = m_couplers(my_cpl_id)%name 341 IF ( PRESENT( npe_total ) ) npe_total = m_couplers(my_cpl_id)%npe_total 342 IF ( PRESENT( lower_left_x ) ) lower_left_x = m_couplers(my_cpl_id)%lower_left_x 343 IF ( PRESENT( lower_left_y ) ) lower_left_y = m_couplers(my_cpl_id)%lower_left_y 344 345 END SUBROUTINE pmc_get_local_model_info 337 338 INTEGER, INTENT(IN), OPTIONAL :: request_for_cpl_id 339 340 INTEGER, INTENT(OUT), OPTIONAL :: cpl_id 341 INTEGER, INTENT(OUT), OPTIONAL :: cpl_parent_id 342 INTEGER, INTENT(OUT), OPTIONAL :: ncpl 343 INTEGER, INTENT(OUT), OPTIONAL :: npe_total 344 345 INTEGER :: requested_cpl_id 346 347 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_x 348 REAL(wp), INTENT(OUT), OPTIONAL :: lower_left_y 349 350 ! 351 !-- Set the requested coupler id 352 IF ( PRESENT( request_for_cpl_id ) ) THEN 353 requested_cpl_id = request_for_cpl_id 354 ! 355 !-- Check for allowed range of values 356 IF ( requested_cpl_id < 1 .OR. requested_cpl_id > m_ncpl ) RETURN 357 ELSE 358 requested_cpl_id = m_my_cpl_id 359 ENDIF 360 361 ! 362 !-- Return the requested information 363 IF ( PRESENT( cpl_id ) ) THEN 364 cpl_id = requested_cpl_id 365 ENDIF 366 IF ( PRESENT( cpl_parent_id ) ) THEN 367 cpl_parent_id = m_couplers(requested_cpl_id)%parent_id 368 ENDIF 369 IF ( PRESENT( cpl_name ) ) THEN 370 cpl_name = m_couplers(requested_cpl_id)%name 371 ENDIF 372 IF ( PRESENT( ncpl ) ) THEN 373 ncpl = m_ncpl 374 ENDIF 375 IF ( PRESENT( npe_total ) ) THEN 376 npe_total = m_couplers(requested_cpl_id)%npe_total 377 ENDIF 378 IF ( PRESENT( lower_left_x ) ) THEN 379 lower_left_x = m_couplers(requested_cpl_id)%lower_left_x 380 ENDIF 381 IF ( PRESENT( lower_left_y ) ) THEN 382 lower_left_y = m_couplers(requested_cpl_id)%lower_left_y 383 ENDIF 384 385 END SUBROUTINE pmc_get_model_info 346 386 347 387 … … 364 404 365 405 INTEGER, INTENT(INOUT) :: pmc_status 366 INTEGER :: i, istat , iunit406 INTEGER :: i, istat 367 407 368 408 TYPE(pmc_layout), DIMENSION(pmc_max_modell) :: domain_layouts … … 374 414 !-- Initialize some coupling variables 375 415 domain_layouts(1:pmc_max_modell)%id = -1 376 m_nrofcpl = 0 377 iunit = 345 416 m_ncpl = 0 378 417 379 418 pmc_status = pmc_status_ok … … 412 451 !-- Get the number of nested models given in the nestpar-NAMELIST 413 452 DO i = 1, pmc_max_modell 414 415 IF ( m_couplers(i)%id /= -1 .AND. i <= pmc_max_modell ) THEN 416 WRITE ( 0, '(A,A,1X,3I7,1X,2F10.2)' ) 'Set up Model ', & 417 TRIM( m_couplers(i)%name ), m_couplers(i)%id, & 418 m_couplers(i)%Parent_id, m_couplers(i)%npe_total, & 419 m_couplers(i)%lower_left_x, & 420 m_couplers(i)%lower_left_y 421 ELSE 422 ! 423 !-- When id=-1 is found for the first time, the list of domains is 424 !-- finished (or latest after pmc_max_modell entries 425 m_nrofcpl = i - 1 426 EXIT 453 ! 454 !-- When id=-1 is found for the first time, the list of domains is finished 455 IF ( m_couplers(i)%id == -1 .OR. i == pmc_max_modell ) THEN 456 IF ( m_couplers(i)%id == -1 ) THEN 457 m_ncpl = i - 1 458 EXIT 459 ELSE 460 m_ncpl = pmc_max_modell 461 ENDIF 427 462 ENDIF 428 463
Note: See TracChangeset
for help on using the changeset viewer.
