Changeset 13550


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

trunk: remove one communication in rheology, so about 100 overall.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/ICE/icedyn_rhg_evp.F90

    r13497 r13550  
    129129      REAl(wp) ::   zbetau, zbetav 
    130130      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    131       REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
     131      REAL(wp) ::   zp_delf, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars 
    132132      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars 
    133133      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
     
    138138      REAL(wp) ::   zshear, zdum1, zdum2 
    139139      ! 
    140       REAL(wp), DIMENSION(jpi,jpj) ::   zp_delt                         ! P/delta at T points 
     140      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points 
    141141      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017 
    142142      ! 
     
    145145      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    146146      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
    147       REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
     147      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points 
    148148      ! 
    149149      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
     
    368368 
    369369         END_2D 
    370          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 
    371  
    372          DO_2D( 0, 1, 0, 1 )   ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 ! no vector loop 
     370 
     371         DO_2D( 0, 0, 0, 0 ) 
    373372 
    374373            ! shear**2 at T points (doc eq. A16) 
     
    390389             
    391390            ! delta at T points 
    392             zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    393  
    394             ! P/delta at T points 
    395             zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
    396  
     391            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     392 
     393         END_2D 
     394         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp ) 
     395 
     396         ! P/delta at T points 
     397         DO_2D( 1, 1, 1, 1 ) 
     398            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
     399         END_2D 
     400 
     401         DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     402 
     403            ! divergence at T points (duplication to avoid communications) 
     404            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     405               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     406               &    ) * r1_e1e2t(ji,jj) 
     407             
     408            ! tension at T points (duplication to avoid communications) 
     409            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)   & 
     410               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     411               &   ) * r1_e1e2t(ji,jj) 
     412             
    397413            ! alpha for aEVP 
    398414            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
     
    411427             
    412428            ! stress at T points (zkt/=0 if landfast) 
    413             zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
    414             zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
     429            zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1 
     430            zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
    415431           
    416432         END_2D 
    417          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    418433 
    419434         ! Save beta at T-points for further computations 
     
    726741          
    727742         ! delta at T points 
    728          zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
    729          rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    730          pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     743         zdelta(ji,jj)   = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     744         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta(ji,jj) ) ) ! 0 if delta=0 
     745         pdelta_i(ji,jj) = zdelta(ji,jj) + rn_creepl * rswitch 
    731746 
    732747      END_2D 
Note: See TracChangeset for help on using the changeset viewer.