- Timestamp:
- 2018-11-25T22:33:50+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90
r10358 r10359 83 83 PUBLIC mpp_lbc_north_icb 84 84 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 85 PUBLIC mpp_ ilor85 PUBLIC mpp_delay_max 86 86 PUBLIC mppscatter, mppgather 87 87 PUBLIC mpp_ini_znl … … 164 164 INTEGER, PUBLIC :: numcom = -1 !: logical unit for communicaton report 165 165 LOGICAL, PUBLIC :: l_full_nf_update = .FALSE. !: logical for a full (2lines) update of bc at North fold report 166 INTEGER, PARAMETER, PUBLIC :: nbdelay = 1 !: number of delayed operations 167 CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC :: c_delaylist !: name (used as id) of allreduce-delayed operations 168 DATA c_delaylist(1) / 'advumx_delay' / 169 REAL(wp), DIMENSION(nbdelay), PUBLIC :: todelay !: current value of the delayed operations 170 INTEGER, DIMENSION(nbdelay), PUBLIC :: ndelayid = -1 !: mpi request id of the delayed operations 166 171 167 172 ! timing summary report … … 566 571 END SUBROUTINE mppscatter 567 572 568 !! 569 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 570 ! WARNING: must be used only once (by ice_dyn_adv_umx) because ll_switch and ireq are SAVE 571 !!---------------------------------------------------------------------- 572 LOGICAL, INTENT(inout), DIMENSION(2) :: ld_switch 573 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 574 INTEGER, INTENT(in ), OPTIONAL :: kcom 575 INTEGER :: ierror, ilocalcomm 576 LOGICAL, SAVE :: ll_switch , lllast 577 INTEGER, SAVE :: ireq = -1 573 574 SUBROUTINE mpp_delay_max( cdname, cdelay, pinout, ldlast, kcom ) 575 !!---------------------------------------------------------------------- 576 !! *** routine mpp_delay_max *** 577 !! 578 !! ** Purpose : performed delayed mpp_max, the result is received on next call 579 !! 580 !!---------------------------------------------------------------------- 581 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 582 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 583 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 584 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 585 INTEGER, INTENT(in ), OPTIONAL :: kcom 586 !! 587 INTEGER :: ji 588 INTEGER :: idvar 589 INTEGER :: ierror, ilocalcomm 578 590 !!---------------------------------------------------------------------- 579 591 ilocalcomm = mpi_comm_oce 580 IF( PRESENT( kcom) ) ilocalcomm = kcom 581 lllast = .FALSE. 582 IF( PRESENT(ldlast) ) lllast = ldlast 583 584 IF ( ireq /= -1 ) THEN ! get ld_switch(2) from ll_switch (from previous call) 585 IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 586 CALL mpi_wait(ireq, MPI_STATUS_IGNORE, ierror ) 587 ld_switch(2) = ll_switch 592 IF( PRESENT(kcom) ) ilocalcomm = kcom 593 594 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 595 596 idvar = -1 597 DO ji = 1, nbdelay 598 IF( TRIM(cdelay) == trim(c_delaylist(ji)) ) idvar = ji 599 END DO 600 IF ( idvar == -1 ) CALL ctl_stop( 'STOP',' mpp_delay_max : please add a new delayed exchange for '//TRIM(cdname) ) 601 602 IF( ndelayid(idvar) == -1 ) THEN ! first call without restart: get pinout(2) from pinout(1) with a blocking allreduce 603 CALL mpi_allreduce( pinout(1), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 604 ELSE IF ( ndelayid(idvar) == 0 ) THEN ! first call with restart: get pinout(2) from todelay with a blocking allreduce 605 CALL mpi_allreduce( todelay(idvar), pinout(2), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierror ) 606 ELSE ! from the second call, get value from previous time step 607 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 608 CALL mpi_wait(ndelayid(idvar), MPI_STATUS_IGNORE, ierror ) ! make sure todelay(idvar) is received 588 609 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 589 ENDIF 590 IF( .NOT. lllast ) & ! send ll_switch to be received on next call 591 CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 592 593 END SUBROUTINE mpp_ilor 610 pinout(2) = todelay(idvar) ! send back pinout(2) from todelay(idvar) defined at previous call 611 ENDIF 612 613 IF( ldlast ) THEN ! last call: put pinout(1) in todelay that will be stored in the restart files 614 todelay(idvar) = pinout(1) 615 ELSE ! send pinout(1) to todelay(idvar), to be received at next call 616 CALL mpi_iallreduce( pinout(1), todelay(idvar), 1, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierror ) 617 ENDIF 618 619 END SUBROUTINE mpp_delay_max 594 620 595 621 !!---------------------------------------------------------------------- … … 1473 1499 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 1474 1500 INTEGER, PUBLIC :: mpi_comm_oce ! opa local communicator 1501 1502 INTEGER, PARAMETER, PUBLIC :: nbdelay = 0 ! make sure we don't enter loops: DO ji = 1, nbdelay 1503 CHARACTER(len=32), DIMENSION(1), PUBLIC :: c_delaylist = 'empty' 1504 REAL(wp), PUBLIC, DIMENSION(1) :: todelay 1505 INTEGER, PUBLIC, DIMENSION(1) :: ndelayid = -1 1475 1506 !!---------------------------------------------------------------------- 1476 1507 CONTAINS … … 1640 1671 # undef OPERATION_MAXLOC 1641 1672 1642 SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 1643 LOGICAL, INTENT(in ), DIMENSION(2) :: ld_switch 1644 LOGICAL, INTENT(in ), OPTIONAL :: ldlast 1645 INTEGER, INTENT(in ), OPTIONAL :: kcom ! ??? 1646 WRITE(*,*) 'mpp_ilor: You should not have seen this print! error?', ld_switch 1647 END SUBROUTINE mpp_ilor 1673 SUBROUTINE mpp_delay_max( cdname, cdelay, pinout, ldlast, kcom ) 1674 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 1675 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 1676 REAL(wp), INTENT(inout), DIMENSION(2) :: pinout ! pinout(1): in data, pinout(2): out data 1677 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine 1678 INTEGER, INTENT(in ), OPTIONAL :: kcom 1679 WRITE(*,*) 'mpp_delay_max: You should not have seen this print! error?', cdname 1680 END SUBROUTINE mpp_delay_max 1648 1681 1649 1682 SUBROUTINE mppstop( ldfinal, ld_force_abort )
Note: See TracChangeset
for help on using the changeset viewer.