- Timestamp:
- 2020-10-01T13:33:30+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/ICE/icedyn_rhg_evp.F90
r13295 r13553 41 41 USE prtctl ! Print control 42 42 43 USE netcdf ! NetCDF library for convergence test 43 44 IMPLICIT NONE 44 45 PRIVATE … … 50 51 # include "do_loop_substitute.h90" 51 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 52 58 !!---------------------------------------------------------------------- 53 59 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 121 127 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 122 128 REAL(wp) :: zalph1, z1_alph1, zalph2, z1_alph2 ! alpha coef from Bouillon 2009 or Kimmritz 2017 129 REAl(wp) :: zbetau, zbetav 123 130 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV, zvU, zvV ! ice/snow mass and volume 124 REAL(wp) :: z delta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2! temporary scalars131 REAL(wp) :: zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 125 132 REAL(wp) :: zTauO, zTauB, zRHS, zvel ! temporary scalars 126 133 REAL(wp) :: zkt ! isotropic tensile strength for landfast ice 127 134 REAL(wp) :: zvCr ! critical ice volume above which ice is landfast 128 135 ! 129 REAL(wp) :: zresm ! Maximal error on ice velocity130 136 REAL(wp) :: zintb, zintn ! dummy argument 131 137 REAL(wp) :: zfac_x, zfac_y 132 138 REAL(wp) :: zshear, zdum1, zdum2 133 139 ! 134 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 135 141 REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017 136 142 ! … … 139 145 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points 140 146 REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points 141 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 142 148 ! 143 149 REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear 144 150 REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components 145 !!$ REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice, zresr ! check convergence146 151 REAL(wp), DIMENSION(jpi,jpj) :: zsshdyn ! array used for the calculation of ice surface slope: 147 152 ! ! ocean surface (ssh_m) if ice is not embedded … … 157 162 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 158 163 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 159 REAL(wp), DIMENSION(jpi,jpj) :: zfmask , zwf! mask at F points for the ice164 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice 160 165 161 166 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 162 167 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small 163 168 REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small 169 !! --- check convergence 170 REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice 164 171 !! --- diags 165 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00166 172 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig1, zsig2, zsig3 167 173 !! --- SIMIP diags … … 176 182 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 177 183 ! 178 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 184 ! for diagnostics and convergence tests 185 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 186 DO_2D( 1, 1, 1, 1 ) 187 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 188 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 189 END_2D 190 ! 191 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 179 192 !------------------------------------------------------------------------------! 180 193 ! 0) mask at F points for the ice … … 187 200 188 201 ! Lateral boundary conditions on velocity (modify zfmask) 189 zwf(:,:) = zfmask(:,:)190 202 DO_2D( 0, 0, 0, 0 ) 191 203 IF( zfmask(ji,jj) == 0._wp ) THEN 192 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) ) ) 204 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 205 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 193 206 ENDIF 194 207 END_2D 195 208 DO jj = 2, jpjm1 196 209 IF( zfmask(1,jj) == 0._wp ) THEN 197 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )210 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 198 211 ENDIF 199 212 IF( zfmask(jpi,jj) == 0._wp ) THEN 200 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )201 213 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 214 ENDIF 202 215 END DO 203 216 DO ji = 2, jpim1 204 217 IF( zfmask(ji,1) == 0._wp ) THEN 205 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )218 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 206 219 ENDIF 207 220 IF( zfmask(ji,jpj) == 0._wp ) THEN 208 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )221 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 209 222 ENDIF 210 223 END DO … … 220 233 z1_ecc2 = 1._wp / ecc2 221 234 222 ! Time step for subcycling223 zdtevp = rDt_ice / REAL( nn_nevp )224 z1_dtevp = 1._wp / zdtevp225 226 235 ! alpha parameters (Bouillon 2009) 227 236 IF( .NOT. ln_aEVP ) THEN 228 zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp 237 zdtevp = rDt_ice / REAL( nn_nevp ) 238 zalph1 = 2._wp * rn_relast * REAL( nn_nevp ) 229 239 zalph2 = zalph1 * z1_ecc2 230 240 231 241 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 232 242 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 243 ELSE 244 zdtevp = rdt_ice 245 ! zalpha parameters set later on adaptatively 233 246 ENDIF 247 z1_dtevp = 1._wp / zdtevp 234 248 235 249 ! Initialise stress tensor … … 242 256 243 257 ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 244 IF( ln_landfast_L16 ) THEN ; zkt = rn_ tensile258 IF( ln_landfast_L16 ) THEN ; zkt = rn_lf_tensile 245 259 ELSE ; zkt = 0._wp 246 260 ENDIF … … 310 324 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) 311 325 ! ice-bottom stress at U points 312 zvCr = zaU(ji,jj) * rn_ depfra * hu(ji,jj,Kmm)313 ztaux_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )326 zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 327 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 314 328 ! ice-bottom stress at V points 315 zvCr = zaV(ji,jj) * rn_ depfra * hv(ji,jj,Kmm)316 ztauy_base(ji,jj) = - rn_ icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )329 zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 330 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 317 331 ! ice_bottom stress at T points 318 zvCr = at_i(ji,jj) * rn_ depfra * ht(ji,jj)319 tau_icebfr(ji,jj) = - rn_ icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )332 zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 333 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 320 334 END_2D 321 335 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) … … 337 351 l_full_nf_update = jter == nn_nevp ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 338 352 ! 339 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 340 !!$ DO jj = 1, jpjm1 341 !!$ zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 342 !!$ zv_ice(:,jj) = v_ice(:,jj) 343 !!$ END DO 344 !!$ ENDIF 353 ! convergence test 354 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 355 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 356 zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 357 zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 358 END_2D 359 ENDIF 345 360 346 361 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! … … 353 368 354 369 END_2D 355 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 356 357 DO_2D( 0, 1, 0, 1 ) 370 371 DO_2D( 0, 0, 0, 0 ) 358 372 359 373 ! shear**2 at T points (doc eq. A16) … … 375 389 376 390 ! delta at T points 377 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 378 379 ! P/delta at T points 380 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 381 382 ! alpha & beta for aEVP 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 413 ! alpha for aEVP 383 414 ! gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 384 415 ! alpha = beta = sqrt(4*gamma) … … 388 419 zalph2 = zalph1 389 420 z1_alph2 = z1_alph1 421 ! explicit: 422 ! z1_alph1 = 1._wp / zalph1 423 ! z1_alph2 = 1._wp / zalph1 424 ! zalph1 = zalph1 - 1._wp 425 ! zalph2 = zalph1 390 426 ENDIF 391 427 392 428 ! stress at T points (zkt/=0 if landfast) 393 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta *(1._wp - zkt) ) ) * z1_alph1394 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 395 431 396 432 END_2D 397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 398 433 434 ! Save beta at T-points for further computations 435 IF( ln_aEVP ) THEN 436 DO_2D( 1, 1, 1, 1 ) 437 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 438 END_2D 439 ENDIF 440 399 441 DO_2D( 1, 0, 1, 0 ) 400 442 401 ! alpha & betafor aEVP443 ! alpha for aEVP 402 444 IF( ln_aEVP ) THEN 403 zalph2 = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj)) )445 zalph2 = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 404 446 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 405 zbeta(ji,jj) = zalph2 447 ! explicit: 448 ! z1_alph2 = 1._wp / zalph2 449 ! zalph2 = zalph2 - 1._wp 406 450 ENDIF 407 451 … … 469 513 ! 470 514 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 471 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 472 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 473 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 474 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 475 & ) * 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 515 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 516 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 517 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 518 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 519 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 520 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 521 & ) / ( zbetav + 1._wp ) & 522 & ) * 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 476 523 & ) * zmsk00y(ji,jj) 477 524 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 478 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity479 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)480 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast481 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0482 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin483 & ) 525 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 526 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 527 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 528 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 529 & ) * 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 530 & ) * zmsk00y(ji,jj) 484 531 ENDIF 485 532 END_2D … … 518 565 ! 519 566 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 520 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 521 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 522 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 523 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 524 & ) * 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 567 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 568 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 569 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 570 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 571 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 572 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 573 & ) / ( zbetau + 1._wp ) & 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 525 575 & ) * zmsk00x(ji,jj) 526 576 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 527 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity528 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)529 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast530 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0531 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin532 & 577 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 578 & + 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) + landfast 580 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 581 & ) * 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 582 & ) * zmsk00x(ji,jj) 533 583 ENDIF 534 584 END_2D … … 569 619 ! 570 620 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 571 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 572 & + zRHS + zTauO * u_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 573 & / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 574 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 575 & ) * 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 621 zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 622 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) ) & ! previous velocity 623 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 624 & ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 625 & + ( 1._wp - rswitch ) * ( u_ice_b(ji,jj) & 626 & + u_ice (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 627 & ) / ( zbetau + 1._wp ) & 628 & ) * 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 576 629 & ) * zmsk00x(ji,jj) 577 630 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 578 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj)* u_ice(ji,jj) & ! previous velocity579 & + zRHS + zTauO * u_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)580 & / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast581 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0582 & ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin583 & 631 u_ice(ji,jj) = ( ( rswitch * ( zmU_t(ji,jj) * u_ice(ji,jj) & ! previous velocity 632 & + zRHS + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 633 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 634 & + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 635 & ) * 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 636 & ) * zmsk00x(ji,jj) 584 637 ENDIF 585 638 END_2D … … 618 671 ! 619 672 IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 620 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 621 & + zRHS + zTauO * v_ice(ji,jj) ) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 622 & / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 623 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax ) & ! static friction => slow decrease to v=0 624 & ) * 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 673 zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 674 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) ) & ! previous velocity 675 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 676 & ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 677 & + ( 1._wp - rswitch ) * ( v_ice_b(ji,jj) & 678 & + v_ice (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 679 & ) / ( zbetav + 1._wp ) & 680 & ) * 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 625 681 & ) * zmsk00y(ji,jj) 626 682 ELSE !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 627 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj)* v_ice(ji,jj) & ! previous velocity628 & + zRHS + zTauO * v_ice(ji,jj) )& ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)629 & / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )& ! m/dt + tau_io(only ice part) + landfast630 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )& ! static friction => slow decrease to v=0631 & ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )& ! v_ice = v_oce/100 if mass < zmmin & conc < zamin632 & 683 v_ice(ji,jj) = ( ( rswitch * ( zmV_t(ji,jj) * v_ice(ji,jj) & ! previous velocity 684 & + zRHS + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 685 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 686 & + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax ) & ! static friction => slow decrease to v=0 687 & ) * 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 688 & ) * zmsk00y(ji,jj) 633 689 ENDIF 634 690 END_2D … … 643 699 ENDIF 644 700 645 !!$ IF(sn_cfctl%l_prtctl) THEN ! Convergence test 646 !!$ DO jj = 2 , jpjm1 647 !!$ zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 648 !!$ END DO 649 !!$ zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 650 !!$ CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 651 !!$ ENDIF 701 ! convergence test 702 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 652 703 ! 653 704 ! ! ==================== ! 654 705 END DO ! end loop over jter ! 655 706 ! ! ==================== ! 707 IF( ln_aEVP ) CALL iom_put( 'beta_evp' , zbeta ) 656 708 ! 657 709 !------------------------------------------------------------------------------! … … 667 719 END_2D 668 720 669 DO_2D( 0, 0, 0, 0 ) 721 DO_2D( 0, 0, 0, 0 ) ! no vector loop 670 722 671 723 ! tension**2 at T points … … 689 741 690 742 ! delta at T points 691 zdelta 692 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta) ) ! 0 if delta=0693 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 694 746 695 747 END_2D … … 706 758 ! 5) diagnostics 707 759 !------------------------------------------------------------------------------! 708 DO_2D( 1, 1, 1, 1 )709 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice710 END_2D711 712 760 ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 713 761 IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & … … 764 812 DEALLOCATE( zsig1 , zsig2 , zsig3 ) 765 813 ENDIF 766 814 767 815 ! --- SIMIP --- ! 768 816 IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & … … 818 866 ENDIF 819 867 ! 868 ! --- convergence tests --- ! 869 IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 870 IF( iom_use('uice_cvg') ) THEN 871 IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 872 CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 873 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 874 ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 875 CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 876 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 877 ENDIF 878 ENDIF 879 ENDIF 880 ! 881 DEALLOCATE( zmsk00, zmsk15 ) 882 ! 820 883 END SUBROUTINE ice_dyn_rhg_evp 884 885 886 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 887 !!---------------------------------------------------------------------- 888 !! *** ROUTINE rhg_cvg *** 889 !! 890 !! ** Purpose : check convergence of oce rheology 891 !! 892 !! ** Method : create a file ice_cvg.nc containing the convergence of ice velocity 893 !! during the sub timestepping of rheology so as: 894 !! uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 895 !! This routine is called every sub-iteration, so it is cpu expensive 896 !! 897 !! ** Note : for the first sub-iteration, uice_cvg is set to 0 (too large otherwise) 898 !!---------------------------------------------------------------------- 899 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 900 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 901 !! 902 INTEGER :: it, idtime, istatus 903 INTEGER :: ji, jj ! dummy loop indices 904 REAL(wp) :: zresm ! local real 905 CHARACTER(len=20) :: clname 906 REAL(wp), DIMENSION(jpi,jpj) :: zres ! check convergence 907 !!---------------------------------------------------------------------- 908 909 ! create file 910 IF( kt == nit000 .AND. kiter == 1 ) THEN 911 ! 912 IF( lwp ) THEN 913 WRITE(numout,*) 914 WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 915 WRITE(numout,*) '~~~~~~~' 916 ENDIF 917 ! 918 IF( lwm ) THEN 919 clname = 'ice_cvg.nc' 920 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 921 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 922 istatus = NF90_DEF_DIM( ncvgid, 'time' , NF90_UNLIMITED, idtime ) 923 istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid ) 924 istatus = NF90_ENDDEF(ncvgid) 925 ENDIF 926 ! 927 ENDIF 928 929 ! time 930 it = ( kt - 1 ) * kitermax + kiter 931 932 ! convergence 933 IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 934 zresm = 0._wp 935 ELSE 936 DO_2D( 1, 1, 1, 1 ) 937 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 938 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 939 END_2D 940 zresm = MAXVAL( zres ) 941 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 942 ENDIF 943 944 IF( lwm ) THEN 945 ! write variables 946 istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 947 ! close file 948 IF( kt == nitend ) istatus = NF90_CLOSE(ncvgid) 949 ENDIF 950 951 END SUBROUTINE rhg_cvg 821 952 822 953 … … 876 1007 END SUBROUTINE rhg_evp_rst 877 1008 1009 878 1010 #else 879 1011 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
