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 10292 for NEMO/branches – NEMO

Changeset 10292 for NEMO/branches


Ignore:
Timestamp:
2018-11-09T16:35:08+01:00 (5 years ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 4b: reduce communications in si3, see #2133

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

Legend:

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

    r10068 r10292  
    198198   REAL(wp), PUBLIC, PARAMETER ::   epsi20 = 1.e-20_wp  !: small number  
    199199 
     200   !                                     !!** some other parameters for advection using the ULTIMATE-MACHO scheme 
     201   LOGICAL, PUBLIC, DIMENSION(2) :: l_split_advumx = .FALSE.    ! force one iteration at the first time-step 
    200202 
    201203   !                                     !!** define arrays 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icedyn_adv_umx.F90

    r10180 r10292  
    8383      ALLOCATE( zpato(jpi,jpj,1) ) 
    8484      ! 
    85       ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- !         
    86       zcfl  =            MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
    87       zcfl  = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    88       IF( lk_mpp )   CALL mpp_max( zcfl ) 
    89  
    90       IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    91       ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     85      ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- ! 
     86      !     When needed, the advection split is applied at the next time-step in order to avoid blocking global comm. 
     87      !     ...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 
     93       
     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 
    9299      ENDIF 
    93100 
     
    120127      DO jt = 1, initad 
    121128         CALL adv_umx( k_order, kt,   1, zdt, zudy, zvdx, zcu_box, zcv_box, zpato(:,:,1) )        ! Open water area  
     129         CALL lbc_lnk( 'icedyn_adv_umx', zpato, 'T',  1. ) 
    122130         CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pa_i(:,:,:) )         ! Ice area 
    123131         CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_i(:,:,:) )         ! Ice  volume 
     
    127135            CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pe_i(:,:,jk,:) )   ! Ice  heat content 
    128136         END DO 
     137         CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T',  1. ) 
     138 
    129139         CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_s(:,:,:) )         ! Snow volume 
    130140         DO jk = 1, nlay_s 
    131141            CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pe_s(:,:,jk,:) )   ! Snow heat content 
    132142         END DO 
     143         CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T',  1. ) 
     144 
    133145         IF ( ln_pnd_H12 ) THEN 
    134146            CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pa_ip(:,:,:) )     ! Melt pond fraction 
    135147            CALL adv_umx( k_order, kt, jpl, zdt, zudy, zvdx, zcu_box, zcv_box, pv_ip(:,:,:) )     ! Melt pond volume 
     148            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i, 'T',  1., pv_i, 'T',  1., psv_i, 'T',  1., & 
     149                                                & poa_i, 'T',  1., pv_s, 'T',  1., pa_ip, 'T',  1., & 
     150                                                & pv_ip, 'T',  1. ) 
     151         ELSE 
     152            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i, 'T',  1., pv_i, 'T',  1., psv_i, 'T',  1., & 
     153                                                & poa_i, 'T',  1., pv_s, 'T',  1. ) 
    136154         ENDIF 
    137155      END DO 
     
    249267         END DO 
    250268      END DO 
    251       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. ) 
    252269      ! 
    253270   END SUBROUTINE adv_umx 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/iceistate.F90

    r10069 r10292  
    406406      u_ice (:,:) = 0._wp 
    407407      v_ice (:,:) = 0._wp 
     408      ! fields needed for ice_dyn_adv_umx 
     409      l_split_advumx(1) = .FALSE. 
    408410      ! 
    409411      !---------------------------------------------- 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icerst.F90

    r10069 r10292  
    175175      CHARACTER(len=25) ::   znam 
    176176      CHARACTER(len=2)  ::   zchar, zchar1 
    177       REAL(wp)          ::   zfice, ziter 
     177      REAL(wp)          ::   zfice, ziter, zcfl 
    178178      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace 
    179179      !!---------------------------------------------------------------------- 
     
    236236      CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 
    237237      CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 
     238 
     239      ! fields needed for ice_dyn_adv_umx 
     240      zcfl =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
     241      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) 
     247 
    238248      ! fields needed for Met Office (Jules) coupling 
    239249      IF( ln_cpl ) THEN 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90

    r10180 r10292  
    8383   PUBLIC   mpp_lbc_north_icb 
    8484   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
     85   PUBLIC   mpp_ilor 
    8586   PUBLIC   mpp_max_multiple 
    8687   PUBLIC   mppscatter, mppgather 
     
    633634      ptab = zwork 
    634635   END SUBROUTINE mppmax_real 
     636   !! 
     637   SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 
     638      ! WARNING: must be used only once (by ice_dyn_adv_umx) because ll_switch and ireq are SAVE 
     639      !!---------------------------------------------------------------------- 
     640      LOGICAL, INTENT(inout), DIMENSION(2) ::   ld_switch 
     641      LOGICAL, INTENT(in   ), OPTIONAL     ::   ldlast 
     642      INTEGER, INTENT(in   ), OPTIONAL     ::   kcom  
     643      INTEGER  ::   ierror, ilocalcomm 
     644      LOGICAL, SAVE ::   ll_switch  
     645      INTEGER, SAVE ::   ireq = -1 
     646      !!---------------------------------------------------------------------- 
     647      ilocalcomm = mpi_comm_oce 
     648      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     649       
     650      IF ( ireq /= -1 ) THEN   ! get ld_switch(2) from ll_switch (from previous call) 
     651         CALL mpi_wait(ireq, MPI_STATUS_IGNORE, ierror ) 
     652         ld_switch(2) = ll_switch 
     653      ENDIF 
     654      IF( .NOT. ldlast ) &     ! send ll_switch to be received on next call 
     655         CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 
     656 
     657   END SUBROUTINE mpp_ilor 
    635658 
    636659 
     
    17201743   END SUBROUTINE mpp_maxloc3d 
    17211744 
     1745   SUBROUTINE mpp_ilor( ld_switch, ldlast, kcom ) 
     1746      LOGICAL, INTENT(in   ), DIMENSION(2) ::   ld_switch 
     1747      LOGICAL, INTENT(in   ), OPTIONAL     ::   ldlast 
     1748      INTEGER, INTENT(in   ), OPTIONAL     ::   kcom    ! ??? 
     1749      WRITE(*,*) 'mpp_ilor: You should not have seen this print! error?', ld_switch 
     1750   END SUBROUTINE mpp_ilor 
     1751 
    17221752   SUBROUTINE mppstop 
    17231753      STOP      ! non MPP case, just stop the run 
Note: See TracChangeset for help on using the changeset viewer.