Changeset 13550 for NEMO/trunk/src
- Timestamp:
- 2020-10-01T12:02:23+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r13497 r13550 129 129 REAl(wp) :: zbetau, zbetav 130 130 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 131 REAL(wp) :: z delta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2! temporary scalars131 REAL(wp) :: zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 132 132 REAL(wp) :: zTauO, zTauB, zRHS, zvel ! temporary scalars 133 133 REAL(wp) :: zkt ! isotropic tensile strength for landfast ice … … 138 138 REAL(wp) :: zshear, zdum1, zdum2 139 139 ! 140 REAL(wp), DIMENSION(jpi,jpj) :: z p_delt !P/delta at T points140 REAL(wp), DIMENSION(jpi,jpj) :: zdelta, zp_delt ! delta and P/delta at T points 141 141 REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017 142 142 ! … … 145 145 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points 146 146 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 148 148 ! 149 149 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear … … 368 368 369 369 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 ) 373 372 374 373 ! shear**2 at T points (doc eq. A16) … … 390 389 391 390 ! 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 397 413 ! alpha for aEVP 398 414 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m … … 411 427 412 428 ! 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_alph1414 zs2(ji,jj) = ( zs2(ji,jj) *zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2429 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 415 431 416 432 END_2D 417 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp )418 433 419 434 ! Save beta at T-points for further computations … … 726 741 727 742 ! delta at T points 728 zdelta 729 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta) ) ! 0 if delta=0730 pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch743 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 731 746 732 747 END_2D
Note: See TracChangeset
for help on using the changeset viewer.