Changeset 15014 for NEMO/trunk/src/ICE/icedyn_rhg_vp.F90
- Timestamp:
- 2021-06-17T19:02:04+02:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icedyn_rhg_vp.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_rhg_vp.F90
r14433 r15014 59 59 INTEGER :: nvarid_ures_xy, nvarid_vres_xy 60 60 61 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmsk00, zmsk15 62 61 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: fimask ! mask at F points for the ice 62 63 !! * Substitutions 64 # include "do_loop_substitute.h90" 63 65 !!---------------------------------------------------------------------- 64 66 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 158 160 REAL(wp) :: zAA3, zw, ztau, zuerr_max, zverr_max 159 161 ! 160 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice161 162 REAL(wp), DIMENSION(jpi,jpj) :: za_iU , za_iV ! ice fraction on U/V points 162 163 REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! Acceleration term contribution to RHS … … 197 198 !!! REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 198 199 ! 200 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15 199 201 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! mask for lots of ice (1), little ice (0) 200 202 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence (1), no ice (0) … … 238 240 239 241 ! for diagnostics and convergence tests 240 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 242 DO_2D( 1, 1, 1, 1 ) 243 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 244 END_2D 245 IF( nn_rhg_chkcvg > 0 ) THEN 246 DO_2D( 1, 1, 1, 1 ) 244 247 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 245 END DO246 END DO248 END_2D 249 ENDIF 247 250 248 251 IF ( lp_zebra_vp ) THEN; nn_zebra_vp = 2 … … 292 295 ! -- F-mask (code from EVP) 293 296 !------------------------------ 294 ! MartinV: 295 ! In EVP routine, zfmask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 296 ! I am not sure the same recipe applies here 297 298 ! - ocean/land mask 299 DO jj = 1, jpj - 1 300 DO ji = 1, jpi - 1 301 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 302 END DO 303 END DO 304 305 ! Lateral boundary conditions on velocity (modify zfmask) 306 ! Can be computed once for all, at first time step, for all rheologies 307 DO jj = 2, jpj - 1 308 DO ji = 2, jpi - 1 ! vector opt. 309 IF( zfmask(ji,jj) == 0._wp ) THEN 310 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 311 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 312 ENDIF 313 END DO 314 END DO 315 DO jj = 2, jpj - 1 316 IF( zfmask(1,jj) == 0._wp ) THEN 317 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 297 IF( kt == nit000 ) THEN 298 ! MartinV: 299 ! In EVP routine, fimask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 300 ! I am not sure the same recipe applies here 301 302 ! - ocean/land mask 303 ALLOCATE( fimask(jpi,jpj) ) 304 IF( rn_ishlat == 0._wp ) THEN 305 DO_2D( 0, 0, 0, 0 ) 306 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 307 END_2D 308 ELSE 309 DO_2D( 0, 0, 0, 0 ) 310 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 311 ! Lateral boundary conditions on velocity (modify fimask) 312 IF( fimask(ji,jj) == 0._wp ) THEN 313 fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 314 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 315 ENDIF 316 END_2D 318 317 ENDIF 319 IF( zfmask(jpi,jj) == 0._wp ) THEN 320 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpi - 1,jj,1), umask(jpi,jj-1,1) ) ) 321 ENDIF 322 END DO 323 DO ji = 2, jpi - 1 324 IF( zfmask(ji,1) == 0._wp ) THEN 325 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 326 ENDIF 327 IF( zfmask(ji,jpj) == 0._wp ) THEN 328 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpj - 1,1) ) ) 329 ENDIF 330 END DO 331 332 CALL lbc_lnk( 'icedyn_rhg_vp', zfmask, 'F', 1._wp ) 318 319 CALL lbc_lnk( 'icedyn_rhg_vp', fimask, 'F', 1._wp ) 320 ENDIF 333 321 334 322 !---------------------------------------------------------------------------------------------------------- … … 455 443 zds(ji,jj) = ( ( zu_c(ji,jj+1) * r1_e1u(ji,jj+1) - zu_c(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 456 444 & + ( zv_c(ji+1,jj) * r1_e2v(ji+1,jj) - zv_c(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 457 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)445 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 458 446 459 447 END DO … … 521 509 522 510 ! Temporary zef factor at F-point 523 zef(ji,jj) = zp_deltastar_f * r1_e1e2f(ji,jj) * z1_ecc2 * zfmask(ji,jj)511 zef(ji,jj) = zp_deltastar_f * r1_e1e2f(ji,jj) * z1_ecc2 * fimask(ji,jj) 524 512 525 513 END DO … … 611 599 612 600 ! --- Stress contributions at f-points 613 ! MV NOTE: I applied zfmask on zds, by mimetism on EVP, but without deep understanding of what I was doing601 ! MV NOTE: I applied fimask on zds, by mimetism on EVP, but without deep understanding of what I was doing 614 602 ! My guess is that this is the way to enforce boundary conditions on strain rate tensor 615 603 … … 620 608 621 609 ! sig12 contribution to RHS of U equation at F-points 622 zs12_rhsu(ji,jj) = - zef(ji,jj) * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) - r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * zfmask(ji,jj)610 zs12_rhsu(ji,jj) = - zef(ji,jj) * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) - r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * fimask(ji,jj) 623 611 624 612 ! sig12 contribution to RHS of V equation at F-points 625 zs12_rhsv(ji,jj) = zef(ji,jj) * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) - r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * zfmask(ji,jj)613 zs12_rhsv(ji,jj) = zef(ji,jj) * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) - r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * fimask(ji,jj) 626 614 627 615 END DO … … 1181 1169 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 1182 1170 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 1183 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)1171 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 1184 1172 1185 1173 END DO … … 1501 1489 ENDIF 1502 1490 1503 DEALLOCATE( zmsk00, zmsk15 )1504 1505 1491 END SUBROUTINE ice_dyn_rhg_vp 1506 1492
Note: See TracChangeset
for help on using the changeset viewer.
