Changeset 13549


Ignore:
Timestamp:
2020-10-01T12:01:26+02:00 (4 months ago)
Author:
clem
Message:

4.0-HEAD: remove one communication in rheology, so about 100 overall.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icedyn_rhg_evp.F90

    r13346 r13549  
    127127      REAl(wp) ::   zbetau, zbetav 
    128128      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    129       REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
     129      REAL(wp) ::   zp_delf, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars 
    130130      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars 
    131131      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
     
    136136      REAL(wp) ::   zshear, zdum1, zdum2 
    137137      ! 
    138       REAL(wp), DIMENSION(jpi,jpj) ::   zp_delt                         ! P/delta at T points 
     138      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points 
    139139      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017 
    140140      ! 
     
    143143      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    144144      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
    145       REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
     145      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points 
    146146      ! 
    147147      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
     
    372372 
    373373         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    374          DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
     374         DO jj = 1, jpjm1 
    375375            DO ji = 1, jpim1 
    376376 
     
    382382            END DO 
    383383         END DO 
    384          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 
    385  
    386          DO jj = 2, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
    387             DO ji = 2, jpi ! no vector loop 
     384 
     385         DO jj = 2, jpjm1 
     386            DO ji = 2, jpim1 ! no vector loop 
    388387 
    389388               ! shear**2 at T points (doc eq. A16) 
     
    405404                
    406405               ! delta at T points 
    407                zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    408  
    409                ! P/delta at T points 
    410                zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
     406               zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     407 
     408            END DO 
     409         END DO 
     410         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1._wp ) 
     411          
     412         ! P/delta at T points 
     413         DO jj = 1, jpj 
     414            DO ji = 1, jpi 
     415               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
     416            END DO 
     417         END DO 
     418 
     419         DO jj = 2, jpj    ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     420            DO ji = 2, jpi ! no vector loop 
     421 
     422               ! divergence at T points (duplication to avoid communications) 
     423               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     424                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     425                  &    ) * r1_e1e2t(ji,jj) 
     426                
     427               ! tension at T points (duplication to avoid communications) 
     428               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     429                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     430                  &   ) * r1_e1e2t(ji,jj) 
    411431 
    412432               ! alpha for aEVP 
     
    426446                
    427447               ! stress at T points (zkt/=0 if landfast) 
    428                zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
    429                zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
     448               zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1 
     449               zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
    430450              
    431451            END DO 
    432452         END DO 
    433          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 
    434453 
    435454         ! Save beta at T-points for further computations 
     
    759778             
    760779            ! delta at T points 
    761             zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
    762             rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    763             pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     780            zdelta(ji,jj)   = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     781            rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta(ji,jj) ) ) ! 0 if delta=0 
     782            pdelta_i(ji,jj) = zdelta(ji,jj) + rn_creepl * rswitch 
    764783 
    765784         END DO 
Note: See TracChangeset for help on using the changeset viewer.