New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10359 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2018-11-25T22:33:50+01:00 (5 years ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 4c: introduce a better version of the non-blocking mpp_max, see #2133

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90

    r10358 r10359  
    8383   PUBLIC   mpp_lbc_north_icb 
    8484   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    85    PUBLIC   mpp_ilor 
     85   PUBLIC   mpp_delay_max 
    8686   PUBLIC   mppscatter, mppgather 
    8787   PUBLIC   mpp_ini_znl 
     
    164164   INTEGER, PUBLIC                               ::   numcom = -1                  !: logical unit for communicaton report 
    165165   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 
    166171 
    167172   ! timing summary report 
     
    566571   END SUBROUTINE mppscatter 
    567572 
    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 
    578590      !!---------------------------------------------------------------------- 
    579591      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 
    588609         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 
    594620    
    595621   !!---------------------------------------------------------------------- 
     
    14731499   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 
    14741500   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 
    14751506   !!---------------------------------------------------------------------- 
    14761507CONTAINS 
     
    16401671#  undef OPERATION_MAXLOC 
    16411672 
    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 
    16481681 
    16491682   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
Note: See TracChangeset for help on using the changeset viewer.