Changeset 15026
- Timestamp:
- 2021-06-18T18:22:11+02:00 (3 years ago)
- Location:
- NEMO/trunk/tests/ICE_RHEO/MY_SRC
- Files:
-
- 2 edited
-
icedyn_rhg_eap.F90 (modified) (16 diffs)
-
icedyn_rhg_evp.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
r14433 r15026 58 58 59 59 REAL(wp), DIMENSION(nx_yield, ny_yield, na_yield) :: s11r, s12r, s22r, s11s, s12s, s22s 60 61 !! * Substitutions 62 # include "do_loop_substitute.h90" 63 # include "domzgr_substitute.h90" 60 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: fimask ! mask at F points for the ice 64 61 65 62 !! for convergence tests 66 63 INTEGER :: ncvgid ! netcdf file id 67 64 INTEGER :: nvarid ! netcdf variable id 68 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: aimsk00 69 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: eap_res , aimsk15 65 66 !! * Substitutions 67 # include "do_loop_substitute.h90" 70 68 !!---------------------------------------------------------------------- 71 69 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 182 180 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 183 181 ! 182 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15 184 183 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 185 184 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 186 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice187 185 188 186 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 205 203 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology' 206 204 ! 207 IF( kt == nit000 ) THEN 208 ! 209 ! for diagnostics 210 ALLOCATE( aimsk00(jpi,jpj) ) 211 ! for convergence tests 212 IF( nn_rhg_chkcvg > 0 ) ALLOCATE( eap_res(jpi,jpj), aimsk15(jpi,jpj) ) 213 ENDIF 214 ! 205 ! for diagnostics and convergence tests 215 206 DO_2D( 1, 1, 1, 1 ) 216 aimsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice207 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 217 208 END_2D 218 209 IF( nn_rhg_chkcvg > 0 ) THEN 219 210 DO_2D( 1, 1, 1, 1 ) 220 aimsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less211 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 221 212 END_2D 222 213 ENDIF 223 214 ! 224 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization....225 215 !------------------------------------------------------------------------------! 226 216 ! 0) mask at F points for the ice 227 217 !------------------------------------------------------------------------------! 228 ! ocean/land mask 229 DO_2D( 1, 0, 1, 0 ) 230 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 231 END_2D 232 CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1._wp ) 233 234 ! Lateral boundary conditions on velocity (modify zfmask) 235 DO_2D( 0, 0, 0, 0 ) 236 IF( zfmask(ji,jj) == 0._wp ) THEN 237 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 238 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 218 IF( kt == nit000 ) THEN 219 ! ocean/land mask 220 ALLOCATE( fimask(jpi,jpj) ) 221 IF( rn_ishlat == 0._wp ) THEN 222 DO_2D( 0, 0, 0, 0 ) 223 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 224 END_2D 225 ELSE 226 DO_2D( 0, 0, 0, 0 ) 227 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 228 ! Lateral boundary conditions on velocity (modify fimask) 229 IF( fimask(ji,jj) == 0._wp ) THEN 230 fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 231 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 232 ENDIF 233 END_2D 239 234 ENDIF 240 END_2D 241 DO jj = 2, jpjm1 242 IF( zfmask(1,jj) == 0._wp ) THEN 243 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 244 ENDIF 245 IF( zfmask(jpi,jj) == 0._wp ) THEN 246 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 247 ENDIF 248 END DO 249 DO ji = 2, jpim1 250 IF( zfmask(ji,1) == 0._wp ) THEN 251 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 252 ENDIF 253 IF( zfmask(ji,jpj) == 0._wp ) THEN 254 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 255 ENDIF 256 END DO 257 CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1.0_wp ) 235 CALL lbc_lnk( 'icedyn_rhg_eap', fimask, 'F', 1.0_wp ) 236 ENDIF 258 237 259 238 !------------------------------------------------------------------------------! … … 405 384 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) & 406 385 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 407 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)386 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 408 387 409 388 END_2D … … 782 761 783 762 ! convergence test 784 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )763 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 785 764 ! 786 765 ! ! ==================== ! … … 799 778 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) & 800 779 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 801 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)780 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 802 781 803 782 END_2D … … 852 831 & ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 853 832 ! 854 CALL iom_put( 'utau_oi' , ztaux_oi * aimsk00 )855 CALL iom_put( 'vtau_oi' , ztauy_oi * aimsk00 )856 CALL iom_put( 'utau_ai' , ztaux_ai * aimsk00 )857 CALL iom_put( 'vtau_ai' , ztauy_ai * aimsk00 )858 CALL iom_put( 'utau_bi' , ztaux_bi * aimsk00 )859 CALL iom_put( 'vtau_bi' , ztauy_bi * aimsk00 )833 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 834 CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 835 CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 836 CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 837 CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 838 CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 860 839 ENDIF 861 840 862 841 ! --- divergence, shear and strength --- ! 863 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * aimsk00 ) ! divergence864 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * aimsk00 ) ! shear865 IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , pdelta_i * aimsk00 ) ! delta866 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * aimsk00 ) ! strength842 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence 843 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear 844 IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , pdelta_i * zmsk00 ) ! delta 845 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength 867 846 868 847 ! --- Stress tensor invariants (SIMIP diags) --- ! … … 889 868 ! 890 869 ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 891 IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * aimsk00(:,:) ) ! Normal stress892 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * aimsk00(:,:) ) ! Maximum shear stress870 IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 871 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 893 872 894 873 DEALLOCATE ( zsig_I, zsig_II ) … … 936 915 CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 937 916 938 CALL iom_put( 'yield11', zyield11 * aimsk00 )939 CALL iom_put( 'yield22', zyield22 * aimsk00 )940 CALL iom_put( 'yield12', zyield12 * aimsk00 )917 CALL iom_put( 'yield11', zyield11 * zmsk00 ) 918 CALL iom_put( 'yield22', zyield22 * zmsk00 ) 919 CALL iom_put( 'yield12', zyield12 * zmsk00 ) 941 920 ENDIF 942 921 … … 944 923 IF( iom_use('aniso') ) THEN 945 924 CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp ) 946 CALL iom_put( 'aniso' , paniso_11 * aimsk00 )925 CALL iom_put( 'aniso' , paniso_11 * zmsk00 ) 947 926 ENDIF 948 927 … … 955 934 & zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 956 935 957 CALL iom_put( 'dssh_dx' , zspgU * aimsk00 ) ! Sea-surface tilt term in force balance (x)958 CALL iom_put( 'dssh_dy' , zspgV * aimsk00 ) ! Sea-surface tilt term in force balance (y)959 CALL iom_put( 'corstrx' , zCorU * aimsk00 ) ! Coriolis force term in force balance (x)960 CALL iom_put( 'corstry' , zCorV * aimsk00 ) ! Coriolis force term in force balance (y)961 CALL iom_put( 'intstrx' , zfU * aimsk00 ) ! Internal force term in force balance (x)962 CALL iom_put( 'intstry' , zfV * aimsk00 ) ! Internal force term in force balance (y)936 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) 937 CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y) 938 CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x) 939 CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y) 940 CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x) 941 CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y) 963 942 ENDIF 964 943 … … 971 950 DO_2D( 0, 0, 0, 0 ) 972 951 ! 2D ice mass, snow mass, area transport arrays (X, Y) 973 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * aimsk00(ji,jj)974 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * aimsk00(ji,jj)952 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 953 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 975 954 976 955 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component … … 1006 985 IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 1007 986 CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 1008 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * aimsk15(:,:) )987 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 1009 988 ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 1010 989 CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 1011 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * aimsk15(:,:) )990 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 1012 991 ENDIF 1013 992 ENDIF … … 1017 996 1018 997 1019 SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb )998 SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 1020 999 !!---------------------------------------------------------------------- 1021 1000 !! *** ROUTINE rhg_cvg_eap *** … … 1032 1011 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 1033 1012 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 1013 REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15 1034 1014 !! 1035 1015 INTEGER :: it, idtime, istatus … … 1066 1046 zresm = 0._wp 1067 1047 ELSE 1068 DO_2D( 1, 1, 1, 1 ) 1069 eap_res(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 1070 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * aimsk15(ji,jj) 1048 zresm = 0._wp 1049 DO_2D( 0, 0, 0, 0 ) 1071 1050 ! cut of the boundary of the box (forced velocities) 1072 IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN 1073 eap_res(ji,jj) = 0._wp 1074 END IF 1051 IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN 1052 zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 1053 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 1054 ENDIF 1075 1055 END_2D 1076 1077 zresm = MAXVAL( eap_res )1078 1056 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 1079 1057 ENDIF -
NEMO/trunk/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
r14433 r15026 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) … … 163 162 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 164 163 ! 164 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15 165 165 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 166 166 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 167 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice168 167 169 168 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 187 186 ! 188 187 ! for diagnostics and convergence tests 189 ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) )190 188 DO_2D( 1, 1, 1, 1 ) 191 189 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 192 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less193 190 END_2D 194 ! 195 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization.... 191 IF( nn_rhg_chkcvg > 0 ) THEN 192 DO_2D( 1, 1, 1, 1 ) 193 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 194 END_2D 195 ENDIF 196 ! 196 197 !------------------------------------------------------------------------------! 197 198 ! 0) mask at F points for the ice 198 199 !------------------------------------------------------------------------------! 199 ! ocean/land mask 200 DO_2D( 1, 0, 1, 0 ) 201 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 202 END_2D 203 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 204 205 ! Lateral boundary conditions on velocity (modify zfmask) 206 DO_2D( 0, 0, 0, 0 ) 207 IF( zfmask(ji,jj) == 0._wp ) THEN 208 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 209 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 200 IF( kt == nit000 ) THEN 201 ! ocean/land mask 202 ALLOCATE( fimask(jpi,jpj) ) 203 IF( rn_ishlat == 0._wp ) THEN 204 DO_2D( 0, 0, 0, 0 ) 205 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 206 END_2D 207 ELSE 208 DO_2D( 0, 0, 0, 0 ) 209 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 210 ! Lateral boundary conditions on velocity (modify fimask) 211 IF( fimask(ji,jj) == 0._wp ) THEN 212 fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 213 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 214 ENDIF 215 END_2D 210 216 ENDIF 211 END_2D 212 DO jj = 2, jpjm1 213 IF( zfmask(1,jj) == 0._wp ) THEN 214 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 215 ENDIF 216 IF( zfmask(jpi,jj) == 0._wp ) THEN 217 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 218 ENDIF 219 END DO 220 DO ji = 2, jpim1 221 IF( zfmask(ji,1) == 0._wp ) THEN 222 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 223 ENDIF 224 IF( zfmask(ji,jpj) == 0._wp ) THEN 225 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 226 ENDIF 227 END DO 228 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 229 217 CALL lbc_lnk( 'icedyn_rhg_evp', fimask, 'F', 1._wp ) 218 ENDIF 230 219 !------------------------------------------------------------------------------! 231 220 ! 1) define some variables and initialize arrays … … 371 360 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) & 372 361 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 373 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)362 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 374 363 375 364 END_2D … … 722 711 723 712 ! convergence test 724 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )713 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 725 714 ! 726 715 ! ! ==================== ! … … 737 726 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) & 738 727 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 739 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)728 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 740 729 741 730 END_2D … … 932 921 ENDIF 933 922 ENDIF 934 ENDIF 935 ! 936 DEALLOCATE( zmsk00, zmsk15 ) 923 ENDIF 937 924 ! 938 925 END SUBROUTINE ice_dyn_rhg_evp 939 926 940 927 941 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb )928 SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 942 929 !!---------------------------------------------------------------------- 943 930 !! *** ROUTINE rhg_cvg *** … … 954 941 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 955 942 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 943 REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15 956 944 !! 957 945 INTEGER :: it, idtime, istatus … … 959 947 REAL(wp) :: zresm ! local real 960 948 CHARACTER(len=20) :: clname 961 REAL(wp), DIMENSION(jpi,jpj) :: zres ! check convergence962 949 !!---------------------------------------------------------------------- 963 950 … … 989 976 zresm = 0._wp 990 977 ELSE 991 DO_2D( 1, 1, 1, 1 ) 992 zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 993 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 978 zresm = 0._wp 979 DO_2D( 0, 0, 0, 0 ) 980 ! cut of the boundary of the box (forced velocities) 981 IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN 982 zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 983 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 984 ENDIF 994 985 END_2D 995 996 ! cut of the boundary of the box (forced velocities)997 IF (mjg(jj)<=30 .or. mjg(jj)>970 .or. mig(ji)<=30 .or. mig(ji)>970) THEN998 zres(ji,jj) = 0._wp999 END IF1000 1001 zresm = MAXVAL( zres )1002 986 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 1003 987 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
