- Timestamp:
- 2021-06-18T15:21:42+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2680_C1D_PAPA/src/ICE/icedyn_rhg_evp.F90
r14433 r15020 48 48 PUBLIC rhg_evp_rst ! called by icedyn_rhg.F90 49 49 50 !! * Substitutions51 # include "do_loop_substitute.h90"52 # include "domzgr_substitute.h90"53 54 50 !! for convergence tests 55 51 INTEGER :: ncvgid ! netcdf file id 56 52 INTEGER :: nvarid ! netcdf variable id 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmsk00, zmsk15 53 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: fimask ! mask at F points for the ice 54 55 !! * Substitutions 56 # include "do_loop_substitute.h90" 58 57 !!---------------------------------------------------------------------- 59 58 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 161 160 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 162 161 ! 162 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15 163 163 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 164 164 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 165 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice166 165 167 166 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 185 184 ! 186 185 ! for diagnostics and convergence tests 187 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) )188 186 DO_2D( 1, 1, 1, 1 ) 189 187 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 less191 188 END_2D 192 ! 193 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 189 IF( nn_rhg_chkcvg > 0 ) THEN 190 DO_2D( 1, 1, 1, 1 ) 191 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 192 END_2D 193 ENDIF 194 ! 194 195 !------------------------------------------------------------------------------! 195 196 ! 0) mask at F points for the ice 196 197 !------------------------------------------------------------------------------! 197 ! ocean/land mask 198 DO_2D( 1, 0, 1, 0 ) 199 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 200 END_2D 201 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 202 203 ! Lateral boundary conditions on velocity (modify zfmask) 204 DO_2D( 0, 0, 0, 0 ) 205 IF( zfmask(ji,jj) == 0._wp ) THEN 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) ) ) 198 IF( kt == nit000 ) THEN 199 ! ocean/land mask 200 ALLOCATE( fimask(jpi,jpj) ) 201 IF( rn_ishlat == 0._wp ) THEN 202 DO_2D( 0, 0, 0, 0 ) 203 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 204 END_2D 205 ELSE 206 DO_2D( 0, 0, 0, 0 ) 207 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 208 ! Lateral boundary conditions on velocity (modify fimask) 209 IF( fimask(ji,jj) == 0._wp ) THEN 210 fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 211 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 212 ENDIF 213 END_2D 208 214 ENDIF 209 END_2D 210 DO jj = 2, jpjm1 211 IF( zfmask(1,jj) == 0._wp ) THEN 212 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 213 ENDIF 214 IF( zfmask(jpi,jj) == 0._wp ) THEN 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 217 END DO 218 DO ji = 2, jpim1 219 IF( zfmask(ji,1) == 0._wp ) THEN 220 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 221 ENDIF 222 IF( zfmask(ji,jpj) == 0._wp ) THEN 223 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 224 ENDIF 225 END DO 226 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 227 215 CALL lbc_lnk( 'icedyn_rhg_evp', fimask, 'F', 1._wp ) 216 ENDIF 228 217 !------------------------------------------------------------------------------! 229 218 ! 1) define some variables and initialize arrays … … 367 356 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) & 368 357 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 369 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)358 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 370 359 371 360 END_2D … … 702 691 703 692 ! convergence test 704 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )693 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 705 694 ! 706 695 ! ! ==================== ! … … 717 706 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) & 718 707 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 719 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)708 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 720 709 721 710 END_2D … … 914 903 ENDIF 915 904 ! 916 DEALLOCATE( zmsk00, zmsk15 )917 !918 905 END SUBROUTINE ice_dyn_rhg_evp 919 906 920 907 921 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb )908 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 922 909 !!---------------------------------------------------------------------- 923 910 !! *** ROUTINE rhg_cvg *** … … 934 921 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 935 922 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 923 REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15 936 924 !! 937 925 INTEGER :: it, idtime, istatus … … 939 927 REAL(wp) :: zresm ! local real 940 928 CHARACTER(len=20) :: clname 941 REAL(wp), DIMENSION(jpi,jpj) :: zres ! check convergence942 929 !!---------------------------------------------------------------------- 943 930 … … 969 956 zresm = 0._wp 970 957 ELSE 971 DO_2D( 1, 1, 1, 1 )972 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &973 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)974 END_2D975 zresm = MAXVAL( zres )958 zresm = 0._wp 959 DO_2D( 0, 0, 0, 0 ) 960 zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 961 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 962 END_2D 976 963 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 977 964 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
