Changeset 10359


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

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

Location:
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_adv_umx.F90

    r10345 r10359  
    7373      INTEGER  ::   ipl                     ! third dimention of tracer array 
    7474 
    75       REAL(wp) ::   zcfl , zusnit, zdt      !   -      - 
     75      REAL(wp) ::   zcfl(2), zusnit, zdt      !   -      - 
    7676      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zudy, zvdx, zcu_box, zcv_box 
    7777      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zpato 
     
    8686      !     When needed, the advection split is applied at the next time-step in order to avoid blocking global comm. 
    8787      !     ...this should not affect too much the stability... Was ok on the tests we did... 
    88       zcfl =            MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
    89       zcfl = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    90       IF( zcfl > 0.5 ) THEN   ;   l_split_advumx(1) = .TRUE.    ! split advection time-step if CFL violated 
    91       ELSE                    ;   l_split_advumx(1) = .FALSE. 
    92       ENDIF 
     88      zcfl(1) =               MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
     89      zcfl(1) = MAX( zcfl(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    9390       
    94       ! non-blocking global communication send l_split_advumx(1) and receive l_split_advumx(2) 
    95       IF( lk_mpp )   CALL mpp_ilor( l_split_advumx, ldlast = kt == nitend - nn_fsbc + 1 ) 
    96  
    97       IF( l_split_advumx(2) ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp    ! split defined at the previous time-step 
    98       ELSE                           ;   initad = 1   ;   zusnit = 1.0_wp 
     91      ! non-blocking global communication send zcfl(1) and receive zcfl(2) 
     92      IF( lk_mpp )   CALL mpp_delay_max( 'icedyn_adv_umx', 'advumx_delay', zcfl, kt == nitend - nn_fsbc + 1 ) 
     93 
     94      IF( zcfl(2) > .5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp   ! zcfl(2) corresponding to zcfl(1) of the previous time-step 
     95      ELSE                      ;   initad = 1   ;   zusnit = 1.0_wp 
    9996      ENDIF 
    10097 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icerst.F90

    r10292 r10359  
    9898      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    9999      !! 
    100       INTEGER ::   jk ,jl   ! dummy loop indices 
     100      INTEGER ::   ji, jk ,jl   ! dummy loop indices 
    101101      INTEGER ::   iter 
    102102      CHARACTER(len=25) ::   znam 
     
    118118      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step  
    119119      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date 
     120      DO ji = 1, nbdelay 
     121         CALL iom_rstput( iter, nitrst, numriw, c_delaylist(ji), todelay(ji) ) 
     122      END DO 
    120123 
    121124      ! Prognostic variables 
     
    169172      !! ** purpose  :   read restart file 
    170173      !!---------------------------------------------------------------------- 
    171       INTEGER           ::   jk, jl 
     174      INTEGER           ::   ji, jk, jl 
    172175      LOGICAL           ::   llok 
    173176      INTEGER           ::   id1            ! local integer 
     
    240243      zcfl =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
    241244      zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    242       ! define split from previous run, so we ca used mpp_ilor 
    243       IF( zcfl > 0.5 ) THEN   ;   l_split_advumx(1) = .TRUE. 
    244       ELSE                    ;   l_split_advumx(1) = .FALSE. 
    245       ENDIF 
    246       IF( lk_mpp )   CALL mpp_ilor( l_split_advumx )   ! non-blocking global communication send l_split_advumx(1) 
     245 
     246      DO ji = 1, nbdelay 
     247         IF( iom_varid( numrir, c_delaylist(ji), ldstop = .FALSE. ) > 0 )  THEN 
     248            CALL iom_get( numrir, c_delaylist(ji), todelay(ji) ) 
     249            ndelayid(ji) = 0   ! set to 0 to speficy that the value was read in the restart 
     250         ENDIF 
     251      END DO 
    247252 
    248253      ! fields needed for Met Office (Jules) coupling 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/restart.F90

    r10068 r10359  
    143143      !!---------------------------------------------------------------------- 
    144144      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
     145      INTEGER             :: ji 
    145146      !!---------------------------------------------------------------------- 
    146147                     IF(lwxios) CALL iom_swap(      cwxios_context          ) 
    147148                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step 
     149                     DO ji = 1, nbdelay 
     150                        CALL iom_rstput( kt, nitrst, numrow, c_delaylist(ji), todelay(ji), ldxios = lwxios) 
     151                     END DO 
    148152 
    149153      IF ( .NOT. ln_diurnal_only ) THEN 
     
    251255      !!---------------------------------------------------------------------- 
    252256      REAL(wp) ::   zrdt 
    253       INTEGER  ::   jk 
     257      INTEGER  ::   ji, jk 
    254258      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 
    255259      !!---------------------------------------------------------------------- 
     
    263267      ENDIF 
    264268 
     269      DO ji = 1, nbdelay 
     270         IF( iom_varid( numror, c_delaylist(ji), ldstop = .FALSE. ) > 0 )  THEN 
     271            CALL iom_get( numror, c_delaylist(ji), todelay(ji), ldxios = lrxios ) 
     272            ndelayid(ji) = 0   ! set to 0 to speficy that the value was read in the restart 
     273         ENDIF 
     274      END DO 
     275       
    265276      ! Diurnal DSST  
    266277      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios )  
  • 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.