- Timestamp:
- 2020-11-05T15:18:53+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_12905_xios_restart
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/icedyn_rhg_evp.F90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_12905_xios_restart
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedyn_rhg_evp.F90
r12969 r13727 41 41 USE prtctl ! Print control 42 42 43 USE netcdf ! NetCDF library for convergence test 43 44 IMPLICIT NONE 44 45 PRIVATE … … 49 50 !! * Substitutions 50 51 # include "do_loop_substitute.h90" 52 # include "domzgr_substitute.h90" 53 54 !! for convergence tests 55 INTEGER :: ncvgid ! netcdf file id 56 INTEGER :: nvarid ! netcdf variable id 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmsk00, zmsk15 51 58 !!---------------------------------------------------------------------- 52 59 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 120 127 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 121 128 REAL(wp) :: zalph1, z1_alph1, zalph2, z1_alph2 ! alpha coef from Bouillon 2009 or Kimmritz 2017 129 REAl(wp) :: zbetau, zbetav 122 130 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 123 REAL(wp) :: z delta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2! temporary scalars131 REAL(wp) :: zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 124 132 REAL(wp) :: zTauO, zTauB, zRHS, zvel ! temporary scalars 125 133 REAL(wp) :: zkt ! isotropic tensile strength for landfast ice 126 134 REAL(wp) :: zvCr ! critical ice volume above which ice is landfast 127 135 ! 128 REAL(wp) :: zresm ! Maximal error on ice velocity129 136 REAL(wp) :: zintb, zintn ! dummy argument 130 137 REAL(wp) :: zfac_x, zfac_y 131 138 REAL(wp) :: zshear, zdum1, zdum2 132 139 ! 133 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 134 141 REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017 135 142 ! … … 138 145 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points 139 146 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 140 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 141 148 ! 142 149 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 150 REAL(wp), DIMENSION(jpi,jpj) :: zten_i ! tension 143 151 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 144 !!$ REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence145 152 REAL(wp), DIMENSION(jpi,jpj) :: zsshdyn ! array used for the calculation of ice surface slope: 146 153 ! ! ocean surface (ssh_m) if ice is not embedded … … 156 163 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 157 164 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 158 REAL(wp), DIMENSION(jpi,jpj) :: zfmask , zwf! mask at F points for the ice165 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice 159 166 160 167 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 161 168 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small 162 169 REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small 170 !! --- check convergence 171 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice 163 172 !! --- diags 164 REAL(wp) , DIMENSION(jpi,jpj) :: zmsk00165 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig 1, zsig2, zsig3173 REAL(wp) :: zsig1, zsig2, zsig12, zfac, z1_strength 174 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig_I, zsig_II, zsig1_p, zsig2_p 166 175 !! --- SIMIP diags 167 176 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) … … 175 184 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 176 185 ! 177 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 186 ! for diagnostics and convergence tests 187 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 188 DO_2D( 1, 1, 1, 1 ) 189 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 190 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 191 END_2D 192 ! 193 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 178 194 !------------------------------------------------------------------------------! 179 195 ! 0) mask at F points for the ice 180 196 !------------------------------------------------------------------------------! 181 197 ! ocean/land mask 182 DO_2D _10_10198 DO_2D( 1, 0, 1, 0 ) 183 199 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 184 200 END_2D … … 186 202 187 203 ! Lateral boundary conditions on velocity (modify zfmask) 188 zwf(:,:) = zfmask(:,:) 189 DO_2D_00_00 204 DO_2D( 0, 0, 0, 0 ) 190 205 IF( zfmask(ji,jj) == 0._wp ) THEN 191 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 206 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 207 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 192 208 ENDIF 193 209 END_2D 194 210 DO jj = 2, jpjm1 195 211 IF( zfmask(1,jj) == 0._wp ) THEN 196 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )212 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 197 213 ENDIF 198 214 IF( zfmask(jpi,jj) == 0._wp ) THEN 199 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )200 215 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 216 ENDIF 201 217 END DO 202 218 DO ji = 2, jpim1 203 219 IF( zfmask(ji,1) == 0._wp ) THEN 204 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )220 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 205 221 ENDIF 206 222 IF( zfmask(ji,jpj) == 0._wp ) THEN 207 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )223 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 208 224 ENDIF 209 225 END DO … … 219 235 z1_ecc2 = 1._wp / ecc2 220 236 221 ! Time step for subcycling222 zdtevp = rDt_ice / REAL( nn_nevp )223 z1_dtevp = 1._wp / zdtevp224 225 237 ! alpha parameters (Bouillon 2009) 226 238 IF( .NOT. ln_aEVP ) THEN 227 zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp 239 zdtevp = rDt_ice / REAL( nn_nevp ) 240 zalph1 = 2._wp * rn_relast * REAL( nn_nevp ) 228 241 zalph2 = zalph1 * z1_ecc2 229 242 230 243 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 231 244 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 232 ENDIF 245 ELSE 246 zdtevp = rdt_ice 247 ! zalpha parameters set later on adaptatively 248 ENDIF 249 z1_dtevp = 1._wp / zdtevp 233 250 234 251 ! Initialise stress tensor … … 241 258 242 259 ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 243 IF( ln_landfast_L16 ) THEN ; zkt = rn_ tensile260 IF( ln_landfast_L16 ) THEN ; zkt = rn_lf_tensile 244 261 ELSE ; zkt = 0._wp 245 262 ENDIF … … 253 270 zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 254 271 255 DO_2D _00_00272 DO_2D( 0, 0, 0, 0 ) 256 273 257 274 ! ice fraction at U-V points … … 299 316 300 317 END_2D 301 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1. , zdt_m, 'T', 1.)318 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 302 319 ! 303 320 ! !== Landfast ice parameterization ==! 304 321 ! 305 322 IF( ln_landfast_L16 ) THEN !-- Lemieux 2016 306 DO_2D _00_00323 DO_2D( 0, 0, 0, 0 ) 307 324 ! ice thickness at U-V points 308 325 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 309 326 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 310 327 ! ice-bottom stress at U points 311 zvCr = zaU(ji,jj) * rn_ depfra * hu(ji,jj,Kmm)312 ztaux_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )328 zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 329 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 313 330 ! ice-bottom stress at V points 314 zvCr = zaV(ji,jj) * rn_ depfra * hv(ji,jj,Kmm)315 ztauy_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )331 zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 332 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 316 333 ! ice_bottom stress at T points 317 zvCr = at_i(ji,jj) * rn_ depfra * ht(ji,jj)318 tau_icebfr(ji,jj) = - rn_ icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )334 zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 335 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 319 336 END_2D 320 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )337 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 321 338 ! 322 339 ELSE !-- no landfast 323 DO_2D _00_00340 DO_2D( 0, 0, 0, 0 ) 324 341 ztaux_base(ji,jj) = 0._wp 325 342 ztauy_base(ji,jj) = 0._wp … … 336 353 l_full_nf_update = jter == nn_nevp ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 337 354 ! 338 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 339 !!$ DO jj = 1, jpjm1 340 !!$ zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 341 !!$ zv_ice(:,jj) = v_ice(:,jj) 342 !!$ END DO 343 !!$ ENDIF 355 ! convergence test 356 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 357 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 358 zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 359 zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 360 END_2D 361 ENDIF 344 362 345 363 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 346 DO_2D _10_10364 DO_2D( 1, 0, 1, 0 ) 347 365 348 366 ! shear at F points … … 352 370 353 371 END_2D 354 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 355 356 DO_2D_01_01 372 373 DO_2D( 0, 0, 0, 0 ) 357 374 358 375 ! shear**2 at T points (doc eq. A16) … … 374 391 375 392 ! delta at T points 376 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 377 378 ! P/delta at T points 379 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 380 381 ! alpha & beta for aEVP 393 zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 394 395 END_2D 396 CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp ) 397 398 ! P/delta at T points 399 DO_2D( 1, 1, 1, 1 ) 400 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 401 END_2D 402 403 DO_2D( 0, 1, 0, 1 ) ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 404 405 ! divergence at T points (duplication to avoid communications) 406 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 407 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 408 & ) * r1_e1e2t(ji,jj) 409 410 ! tension at T points (duplication to avoid communications) 411 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) & 412 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 413 & ) * r1_e1e2t(ji,jj) 414 415 ! alpha for aEVP 382 416 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 383 417 ! alpha = beta = sqrt(4*gamma) … … 387 421 zalph2 = zalph1 388 422 z1_alph2 = z1_alph1 423 ! explicit: 424 ! z1_alph1 = 1._wp / zalph1 425 ! z1_alph2 = 1._wp / zalph1 426 ! zalph1 = zalph1 - 1._wp 427 ! zalph2 = zalph1 389 428 ENDIF 390 429 391 430 ! stress at T points (zkt/=0 if landfast) 392 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta *(1._wp - zkt) ) ) * z1_alph1393 zs2(ji,jj) = ( zs2(ji,jj) *zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2431 zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1 432 zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 394 433 395 434 END_2D 396 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 397 398 DO_2D_10_10 399 400 ! alpha & beta for aEVP 435 436 ! Save beta at T-points for further computations 437 IF( ln_aEVP ) THEN 438 DO_2D( 1, 1, 1, 1 ) 439 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 440 END_2D 441 ENDIF 442 443 DO_2D( 1, 0, 1, 0 ) 444 445 ! alpha for aEVP 401 446 IF( ln_aEVP ) THEN 402 zalph2 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj)) )447 zalph2 = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 403 448 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 404 zbeta(ji,jj) = zalph2 449 ! explicit: 450 ! z1_alph2 = 1._wp / zalph2 451 ! zalph2 = zalph2 - 1._wp 405 452 ENDIF 406 453 … … 414 461 415 462 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 416 DO_2D _00_00463 DO_2D( 0, 0, 0, 0 ) 417 464 ! !--- U points 418 465 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & … … 442 489 IF( MOD(jter,2) == 0 ) THEN ! even iterations 443 490 ! 444 DO_2D _00_00491 DO_2D( 0, 0, 0, 0 ) 445 492 ! !--- tau_io/(v_oce - v_ice) 446 493 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & … … 468 515 ! 469 516 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 470 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 471 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 472 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 473 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 474 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 517 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 518 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 519 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 520 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 521 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 522 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 523 & ) / ( zbetav + 1._wp ) & 524 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 475 525 & ) * zmsk00y(ji,jj) 476 526 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 477 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity478 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)479 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast480 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0481 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin482 & ) 527 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 528 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 529 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 530 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 531 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 532 & ) * zmsk00y(ji,jj) 483 533 ENDIF 484 534 END_2D 485 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )535 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 486 536 ! 487 537 #if defined key_agrif … … 491 541 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 492 542 ! 493 DO_2D _00_00543 DO_2D( 0, 0, 0, 0 ) 494 544 ! !--- tau_io/(u_oce - u_ice) 495 545 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & … … 517 567 ! 518 568 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 519 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 520 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 521 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 522 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 523 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 569 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 570 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 571 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 572 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 573 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 574 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 575 & ) / ( zbetau + 1._wp ) & 576 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 524 577 & ) * zmsk00x(ji,jj) 525 578 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 526 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity527 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)528 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast529 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0530 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin531 & 579 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 580 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 581 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 582 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 583 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 584 & ) * zmsk00x(ji,jj) 532 585 ENDIF 533 586 END_2D 534 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )587 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 535 588 ! 536 589 #if defined key_agrif … … 542 595 ELSE ! odd iterations 543 596 ! 544 DO_2D _00_00597 DO_2D( 0, 0, 0, 0 ) 545 598 ! !--- tau_io/(u_oce - u_ice) 546 599 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & … … 568 621 ! 569 622 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 570 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 571 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 572 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 573 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 574 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 623 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 624 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 625 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 626 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 627 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 628 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 629 & ) / ( zbetau + 1._wp ) & 630 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 575 631 & ) * zmsk00x(ji,jj) 576 632 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 577 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity578 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)579 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast580 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0581 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin582 & 633 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 634 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 635 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 636 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 637 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 638 & ) * zmsk00x(ji,jj) 583 639 ENDIF 584 640 END_2D 585 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )641 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 586 642 ! 587 643 #if defined key_agrif … … 591 647 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 592 648 ! 593 DO_2D _00_00649 DO_2D( 0, 0, 0, 0 ) 594 650 ! !--- tau_io/(v_oce - v_ice) 595 651 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & … … 617 673 ! 618 674 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 619 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 620 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 621 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 622 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 623 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 675 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 676 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 677 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 678 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 679 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 680 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 681 & ) / ( zbetav + 1._wp ) & 682 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 624 683 & ) * zmsk00y(ji,jj) 625 684 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 626 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity627 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)628 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast629 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0630 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin631 & 685 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 686 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 687 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 688 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 689 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) ) & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 690 & ) * zmsk00y(ji,jj) 632 691 ENDIF 633 692 END_2D 634 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )693 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 635 694 ! 636 695 #if defined key_agrif … … 642 701 ENDIF 643 702 644 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 645 !!$ DO jj = 2 , jpjm1 646 !!$ zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 647 !!$ END DO 648 !!$ zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 649 !!$ CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 650 !!$ ENDIF 703 ! convergence test 704 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 651 705 ! 652 706 ! ! ==================== ! 653 707 END DO ! end loop over jter ! 654 708 ! ! ==================== ! 709 IF( ln_aEVP ) CALL iom_put( 'beta_evp' , zbeta ) 655 710 ! 656 711 !------------------------------------------------------------------------------! 657 712 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 658 713 !------------------------------------------------------------------------------! 659 DO_2D _10_10714 DO_2D( 1, 0, 1, 0 ) 660 715 661 716 ! shear at F points … … 666 721 END_2D 667 722 668 DO_2D _00_00723 DO_2D( 0, 0, 0, 0 ) ! no vector loop 669 724 670 725 ! tension**2 at T points … … 673 728 & ) * r1_e1e2t(ji,jj) 674 729 zdt2 = zdt * zdt 730 731 zten_i(ji,jj) = zdt 675 732 676 733 ! shear**2 at T points (doc eq. A16) … … 688 745 689 746 ! delta at T points 690 z delta = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )691 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta) ) ! 0 if delta=0692 pdelta_i(ji,jj) = z delta + rn_creepl * rswitch747 zfac = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta 748 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zfac ) ) ! 0 if delta=0 749 pdelta_i(ji,jj) = zfac + rn_creepl * rswitch ! delta+creepl 693 750 694 751 END_2D 695 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 752 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 753 & zs1 , 'T', 1._wp, zs2 , 'T', 1._wp, zs12 , 'F', 1._wp ) 696 754 697 755 ! --- Store the stress tensor for the next time step --- ! 698 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )699 756 pstress1_i (:,:) = zs1 (:,:) 700 757 pstress2_i (:,:) = zs2 (:,:) … … 705 762 ! 5) diagnostics 706 763 !------------------------------------------------------------------------------! 707 DO_2D_11_11708 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice709 END_2D710 711 764 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 712 765 IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 713 766 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 714 767 ! 715 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1. , ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., &716 & ztaux_bi, 'U', -1. , ztauy_bi, 'V', -1.)768 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 769 & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 717 770 ! 718 771 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) … … 729 782 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength 730 783 731 ! --- stress tensor--- !732 IF( iom_use(' isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN733 ! 734 ALLOCATE( zsig 1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )784 ! --- Stress tensor invariants (SIMIP diags) --- ! 785 IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN 786 ! 787 ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 735 788 ! 736 DO_2D_00_00 737 zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji ,jj-1) * pstress12_i(ji ,jj-1) + & ! stress12_i at T-point 738 & zmsk00(ji ,jj) * pstress12_i(ji ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) ) & 739 & / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 740 741 zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress 742 743 zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 744 745 !! zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) 746 !! zsig2(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) - zshear ) ! principal stress (x-direction, see Hunke & Dukowicz 2002) 747 !! zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress 748 !! ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11)) 749 zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) ) ! compressive stress, see Bouillon et al. 2015 750 zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear ) ! shear stress 751 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 752 END_2D 753 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 754 ! 755 CALL iom_put( 'isig1' , zsig1 ) 756 CALL iom_put( 'isig2' , zsig2 ) 757 CALL iom_put( 'isig3' , zsig3 ) 758 ! 759 ! Stress tensor invariants (normal and shear stress N/m) 760 IF( iom_use('normstr') ) CALL iom_put( 'normstr' , ( zs1(:,:) + zs2(:,:) ) * zmsk00(:,:) ) ! Normal stress 761 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 762 763 DEALLOCATE( zsig1 , zsig2 , zsig3 ) 764 ENDIF 765 789 DO_2D( 1, 1, 1, 1 ) 790 791 ! Ice stresses 792 ! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013) 793 ! These are NOT stress tensor components, neither stress invariants, neither stress principal components 794 ! I know, this can be confusing... 795 zfac = strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl ) 796 zsig1 = zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) ) 797 zsig2 = zfac * z1_ecc2 * zten_i(ji,jj) 798 zsig12 = zfac * z1_ecc2 * pshear_i(ji,jj) 799 800 ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008) 801 zsig_I (ji,jj) = zsig1 * 0.5_wp ! 1st stress invariant, aka average normal stress, aka negative pressure 802 zsig_II(ji,jj) = SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) ) ! 2nd '' '', aka maximum shear stress 803 804 END_2D 805 ! 806 ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 807 IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 808 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 809 810 DEALLOCATE ( zsig_I, zsig_II ) 811 812 ENDIF 813 814 ! --- Normalized stress tensor principal components --- ! 815 ! This are used to plot the normalized yield curve, see Lemieux & Dupont, 2020 816 ! Recommendation 1 : we use ice strength, not replacement pressure 817 ! Recommendation 2 : need to use deformations at PREVIOUS iterate for viscosities 818 IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN 819 ! 820 ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 821 ! 822 DO_2D( 1, 1, 1, 1 ) 823 824 ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates 825 ! and **deformations** at current iterates 826 ! following Lemieux & Dupont (2020) 827 zfac = zp_delt(ji,jj) 828 zsig1 = zfac * ( pdivu_i(ji,jj) - ( zdelta(ji,jj) + rn_creepl ) ) 829 zsig2 = zfac * z1_ecc2 * zten_i(ji,jj) 830 zsig12 = zfac * z1_ecc2 * pshear_i(ji,jj) 831 832 ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point 833 zsig_I(ji,jj) = zsig1 * 0.5_wp ! 1st stress invariant, aka average normal stress, aka negative pressure 834 zsig_II(ji,jj) = SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) ) ! 2nd '' '', aka maximum shear stress 835 836 ! Normalized principal stresses (used to display the ellipse) 837 z1_strength = 1._wp / MAX( 1._wp, strength(ji,jj) ) 838 zsig1_p(ji,jj) = ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength 839 zsig2_p(ji,jj) = ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength 840 END_2D 841 ! 842 CALL iom_put( 'sig1_pnorm' , zsig1_p ) 843 CALL iom_put( 'sig2_pnorm' , zsig2_p ) 844 845 DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II ) 846 847 ENDIF 848 766 849 ! --- SIMIP --- ! 767 850 IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 768 851 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 769 852 ! 770 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1. , zspgV, 'V', -1., &771 & zCorU, 'U', -1. , zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1.)853 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 854 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 772 855 773 856 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) … … 785 868 & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 786 869 ! 787 DO_2D _00_00870 DO_2D( 0, 0, 0, 0 ) 788 871 ! 2D ice mass, snow mass, area transport arrays (X, Y) 789 872 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) … … 801 884 END_2D 802 885 803 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1. , zdiag_ymtrp_ice, 'V', -1., &804 & zdiag_xmtrp_snw, 'U', -1. , zdiag_ymtrp_snw, 'V', -1., &805 & zdiag_xatrp , 'U', -1. , zdiag_yatrp , 'V', -1.)886 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 887 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 888 & zdiag_xatrp , 'U', -1.0_wp, zdiag_yatrp , 'V', -1.0_wp ) 806 889 807 890 CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s) … … 817 900 ENDIF 818 901 ! 902 ! --- convergence tests --- ! 903 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 904 IF( iom_use('uice_cvg') ) THEN 905 IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 906 CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 907 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 908 ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 909 CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 910 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 911 ENDIF 912 ENDIF 913 ENDIF 914 ! 915 DEALLOCATE( zmsk00, zmsk15 ) 916 ! 819 917 END SUBROUTINE ice_dyn_rhg_evp 918 919 920 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 921 !!---------------------------------------------------------------------- 922 !! *** ROUTINE rhg_cvg *** 923 !! 924 !! ** Purpose : check convergence of oce rheology 925 !! 926 !! ** Method : create a file ice_cvg.nc containing the convergence of ice velocity 927 !! during the sub timestepping of rheology so as: 928 !! uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 929 !! This routine is called every sub-iteration, so it is cpu expensive 930 !! 931 !! ** Note : for the first sub-iteration, uice_cvg is set to 0 (too large otherwise) 932 !!---------------------------------------------------------------------- 933 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 934 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 935 !! 936 INTEGER :: it, idtime, istatus 937 INTEGER :: ji, jj ! dummy loop indices 938 REAL(wp) :: zresm ! local real 939 CHARACTER(len=20) :: clname 940 REAL(wp), DIMENSION(jpi,jpj) :: zres ! check convergence 941 !!---------------------------------------------------------------------- 942 943 ! create file 944 IF( kt == nit000 .AND. kiter == 1 ) THEN 945 ! 946 IF( lwp ) THEN 947 WRITE(numout,*) 948 WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 949 WRITE(numout,*) '~~~~~~~' 950 ENDIF 951 ! 952 IF( lwm ) THEN 953 clname = 'ice_cvg.nc' 954 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 955 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 956 istatus = NF90_DEF_DIM( ncvgid, 'time' , NF90_UNLIMITED, idtime ) 957 istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid ) 958 istatus = NF90_ENDDEF(ncvgid) 959 ENDIF 960 ! 961 ENDIF 962 963 ! time 964 it = ( kt - 1 ) * kitermax + kiter 965 966 ! convergence 967 IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 968 zresm = 0._wp 969 ELSE 970 DO_2D( 1, 1, 1, 1 ) 971 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 972 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 973 END_2D 974 zresm = MAXVAL( zres ) 975 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 976 ENDIF 977 978 IF( lwm ) THEN 979 ! write variables 980 istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 981 ! close file 982 IF( kt == nitend - nn_fsbc + 1 ) istatus = NF90_CLOSE(ncvgid) 983 ENDIF 984 985 END SUBROUTINE rhg_cvg 820 986 821 987 … … 845 1011 ! 846 1012 IF( MIN( id1, id2, id3 ) > 0 ) THEN ! fields exist 847 CALL iom_get( numrir, jpdom_auto glo, 'stress1_i' , stress1_i,ldxios = lrixios )848 CALL iom_get( numrir, jpdom_auto glo, 'stress2_i' , stress2_i,ldxios = lrixios )849 CALL iom_get( numrir, jpdom_auto glo, 'stress12_i', stress12_i, ldxios = lrixios )1013 CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T', ldxios = lrixios ) 1014 CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T', ldxios = lrixios ) 1015 CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F', ldxios = lrixios ) 850 1016 ELSE ! start rheology from rest 851 1017 IF(lwp) WRITE(numout,*) … … 879 1045 END SUBROUTINE rhg_evp_rst 880 1046 1047 881 1048 #else 882 1049 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
