Changeset 15014
- Timestamp:
- 2021-06-17T19:02:04+02:00 (3 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_rhg_eap.F90
r14433 r15014 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) … … 180 178 REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast) 181 179 ! 180 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15 182 181 REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays 183 182 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence 184 REAL(wp), DIMENSION(jpi,jpj) :: zfmask ! mask at F points for the ice185 183 186 184 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter … … 203 201 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology' 204 202 ! 205 IF( kt == nit000 ) THEN 206 ! 207 ! for diagnostics 208 ALLOCATE( aimsk00(jpi,jpj) ) 209 ! for convergence tests 210 IF( nn_rhg_chkcvg > 0 ) ALLOCATE( eap_res(jpi,jpj), aimsk15(jpi,jpj) ) 211 ENDIF 212 ! 203 ! for diagnostics and convergence tests 213 204 DO_2D( 1, 1, 1, 1 ) 214 aimsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice205 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 215 206 END_2D 216 207 IF( nn_rhg_chkcvg > 0 ) THEN 217 208 DO_2D( 1, 1, 1, 1 ) 218 aimsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less209 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 219 210 END_2D 220 211 ENDIF 221 212 ! 222 !!gm for Clem: OPTIMIZATION: I think zfmask can be computed one for all at the initialization....223 213 !------------------------------------------------------------------------------! 224 214 ! 0) mask at F points for the ice 225 215 !------------------------------------------------------------------------------! 226 ! ocean/land mask 227 DO_2D( 1, 0, 1, 0 ) 228 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 229 END_2D 230 CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1._wp ) 231 232 ! Lateral boundary conditions on velocity (modify zfmask) 233 DO_2D( 0, 0, 0, 0 ) 234 IF( zfmask(ji,jj) == 0._wp ) THEN 235 zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 236 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 216 IF( kt == nit000 ) THEN 217 ! ocean/land mask 218 ALLOCATE( fimask(jpi,jpj) ) 219 IF( rn_ishlat == 0._wp ) THEN 220 DO_2D( 0, 0, 0, 0 ) 221 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 222 END_2D 223 ELSE 224 DO_2D( 0, 0, 0, 0 ) 225 fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 226 ! Lateral boundary conditions on velocity (modify fimask) 227 IF( fimask(ji,jj) == 0._wp ) THEN 228 fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 229 & vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 230 ENDIF 231 END_2D 237 232 ENDIF 238 END_2D 239 DO jj = 2, jpjm1 240 IF( zfmask(1,jj) == 0._wp ) THEN 241 zfmask(1 ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 242 ENDIF 243 IF( zfmask(jpi,jj) == 0._wp ) THEN 244 zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 245 ENDIF 246 END DO 247 DO ji = 2, jpim1 248 IF( zfmask(ji,1) == 0._wp ) THEN 249 zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 250 ENDIF 251 IF( zfmask(ji,jpj) == 0._wp ) THEN 252 zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 253 ENDIF 254 END DO 255 CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1.0_wp ) 233 CALL lbc_lnk( 'icedyn_rhg_eap', fimask, 'F', 1.0_wp ) 234 ENDIF 256 235 257 236 !------------------------------------------------------------------------------! … … 401 380 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) & 402 381 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 403 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)382 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 404 383 405 384 END_2D … … 760 739 761 740 ! convergence test 762 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice )741 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 763 742 ! 764 743 ! ! ==================== ! … … 777 756 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) & 778 757 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 779 & ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)758 & ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 780 759 781 760 END_2D … … 830 809 & ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 831 810 ! 832 CALL iom_put( 'utau_oi' , ztaux_oi * aimsk00 )833 CALL iom_put( 'vtau_oi' , ztauy_oi * aimsk00 )834 CALL iom_put( 'utau_ai' , ztaux_ai * aimsk00 )835 CALL iom_put( 'vtau_ai' , ztauy_ai * aimsk00 )836 CALL iom_put( 'utau_bi' , ztaux_bi * aimsk00 )837 CALL iom_put( 'vtau_bi' , ztauy_bi * aimsk00 )811 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 812 CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 813 CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 814 CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 815 CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 816 CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 838 817 ENDIF 839 818 840 819 ! --- divergence, shear and strength --- ! 841 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * aimsk00 ) ! divergence842 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * aimsk00 ) ! shear843 IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , pdelta_i * aimsk00 ) ! delta844 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * aimsk00 ) ! strength820 IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence 821 IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear 822 IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , pdelta_i * zmsk00 ) ! delta 823 IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength 845 824 846 825 ! --- Stress tensor invariants (SIMIP diags) --- ! … … 867 846 ! 868 847 ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 869 IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * aimsk00(:,:) ) ! Normal stress870 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * aimsk00(:,:) ) ! Maximum shear stress848 IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 849 IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 871 850 872 851 DEALLOCATE ( zsig_I, zsig_II ) … … 914 893 CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 915 894 916 CALL iom_put( 'yield11', zyield11 * aimsk00 )917 CALL iom_put( 'yield22', zyield22 * aimsk00 )918 CALL iom_put( 'yield12', zyield12 * aimsk00 )895 CALL iom_put( 'yield11', zyield11 * zmsk00 ) 896 CALL iom_put( 'yield22', zyield22 * zmsk00 ) 897 CALL iom_put( 'yield12', zyield12 * zmsk00 ) 919 898 ENDIF 920 899 … … 922 901 IF( iom_use('aniso') ) THEN 923 902 CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp ) 924 CALL iom_put( 'aniso' , paniso_11 * aimsk00 )903 CALL iom_put( 'aniso' , paniso_11 * zmsk00 ) 925 904 ENDIF 926 905 … … 933 912 & zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 934 913 935 CALL iom_put( 'dssh_dx' , zspgU * aimsk00 ) ! Sea-surface tilt term in force balance (x)936 CALL iom_put( 'dssh_dy' , zspgV * aimsk00 ) ! Sea-surface tilt term in force balance (y)937 CALL iom_put( 'corstrx' , zCorU * aimsk00 ) ! Coriolis force term in force balance (x)938 CALL iom_put( 'corstry' , zCorV * aimsk00 ) ! Coriolis force term in force balance (y)939 CALL iom_put( 'intstrx' , zfU * aimsk00 ) ! Internal force term in force balance (x)940 CALL iom_put( 'intstry' , zfV * aimsk00 ) ! Internal force term in force balance (y)914 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) 915 CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y) 916 CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x) 917 CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y) 918 CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x) 919 CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y) 941 920 ENDIF 942 921 … … 949 928 DO_2D( 0, 0, 0, 0 ) 950 929 ! 2D ice mass, snow mass, area transport arrays (X, Y) 951 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * aimsk00(ji,jj)952 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * aimsk00(ji,jj)930 zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 931 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 953 932 954 933 zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component … … 984 963 IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 985 964 CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 986 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * aimsk15(:,:) )965 & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 987 966 ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 988 967 CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 989 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * aimsk15(:,:) )968 & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 990 969 ENDIF 991 970 ENDIF … … 995 974 996 975 997 SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb )976 SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 998 977 !!---------------------------------------------------------------------- 999 978 !! *** ROUTINE rhg_cvg_eap *** … … 1010 989 INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index 1011 990 REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities 991 REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15 1012 992 !! 1013 993 INTEGER :: it, idtime, istatus … … 1044 1024 zresm = 0._wp 1045 1025 ELSE 1046 DO_2D( 1, 1, 1, 1 ) 1047 eap_res(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 1048 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * aimsk15(ji,jj) 1026 zresm = 0._wp 1027 DO_2D( 0, 0, 0, 0 ) 1028 zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 1029 & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 1049 1030 END_2D 1050 1051 zresm = MAXVAL( eap_res )1052 1031 CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain 1053 1032 ENDIF -
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r14433 r15014 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 -
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 -
NEMO/trunk/src/OCE/BDY/bdyini.F90
r14433 r15014 44 44 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn ! 45 45 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs ! 46 47 !! * Substitutions 48 # include "do_loop_substitute.h90" 46 49 !!---------------------------------------------------------------------- 47 50 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 140 143 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 141 144 !!---------------------------------------------------------------------- 145 INTEGER :: ji, jj ! dummy loop indices 142 146 INTEGER :: ib_bdy, ii, ij, igrd, ib, ir, iseg ! dummy loop indices 143 147 INTEGER :: icount, icountr, icountr0, ibr_max ! local integers … … 630 634 ! For the flagu/flagv calculation below we require a version of fmask without 631 635 ! the land boundary condition (shlat) included: 632 DO ij = 1, jpjm1 633 DO ii = 1, jpim1 634 zfmask(ii,ij) = ztmask(ii,ij ) * ztmask(ii+1,ij ) & 635 & * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 636 END DO 637 END DO 636 DO_2D( 0, 0, 0, 0 ) 637 zfmask(ji,jj) = ztmask(ji,jj ) * ztmask(ji+1,jj ) & 638 & * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 639 END_2D 638 640 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 639 641 … … 646 648 647 649 ! Derive mask on U and V grid from mask on T grid 648 DO ij = 1, jpjm1 649 DO ii = 1, jpim1 650 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij ) 651 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 652 END DO 653 END DO 650 DO_2D( 0, 0, 0, 0 ) 651 bdyumask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji+1,jj ) 652 bdyvmask(ji,jj) = bdytmask(ji,jj) * bdytmask(ji ,jj+1) 653 END_2D 654 654 CALL lbc_lnk( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp ) ! Lateral boundary cond. 655 655 … … 687 687 688 688 ! Recompute zfmask 689 DO ij = 1, jpjm1 690 DO ii = 1, jpim1 691 zfmask(ii,ij) = ztmask(ii,ij ) * ztmask(ii+1,ij ) & 692 & * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 693 END DO 694 END DO 689 DO_2D( 0, 0, 0, 0 ) 690 zfmask(ji,jj) = ztmask(ji,jj ) * ztmask(ji+1,jj ) & 691 & * ztmask(ji,jj+1) * ztmask(ji+1,jj+1) 692 END_2D 695 693 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 696 694 -
NEMO/trunk/src/OCE/DOM/domain.F90
r14834 r15014 148 148 END DO 149 149 ! 150 DO jk = 1, jpkm1151 hf_0( 1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk)152 END DO150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 151 hf_0(ji,jj) = hf_0(ji,jj) + e3f_0(ji,jj,jk)*vmask(ji,jj,jk)*vmask(ji+1,jj,jk) 152 END_3D 153 153 CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 154 154 ! -
NEMO/trunk/src/OCE/DOM/dommsk.F90
r14433 r15014 182 182 ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 183 183 IF( lk_SWE ) THEN ! Shallow Water Eq. case : redefine ssfmask 184 DO_2D( 0, 0, 0,0)184 DO_2D( 0, 0, 0, 0 ) 185 185 ssfmask(ji,jj) = MAX( ssmask(ji,jj+1), ssmask(ji+1,jj+1), & 186 186 & ssmask(ji,jj ), ssmask(ji+1,jj ) ) … … 202 202 ! Lateral boundary conditions on velocity (modify fmask) 203 203 ! --------------------------------------- 204 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition204 IF( rn_shlat /= 0._wp ) THEN ! Not free-slip lateral boundary condition 205 205 ! 206 DO jk = 1, jpk 207 DO_2D( 0, 0, 0, 0 ) 208 IF( fmask(ji,jj,jk) == 0._wp ) THEN 209 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 210 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 211 ENDIF 212 END_2D 213 DO jj = 2, jpjm1 214 IF( fmask(1,jj,jk) == 0._wp ) THEN 215 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 216 ENDIF 217 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 218 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 219 ENDIF 220 END DO 221 DO ji = 2, jpim1 222 IF( fmask(ji,1,jk) == 0._wp ) THEN 223 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 224 ENDIF 225 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 226 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 227 ENDIF 228 END DO 229 END DO 230 ! 206 DO_3D( 0, 0, 0, 0, 1, jpk ) 207 IF( fmask(ji,jj,jk) == 0._wp ) THEN 208 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 209 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 210 ENDIF 211 END_3D 231 212 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 232 213 ! -
NEMO/trunk/src/OCE/DOM/domqco.F90
r14834 r15014 184 184 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 185 185 186 DO_2D_OVR( nn_hls , nn_hls-1, nn_hls, nn_hls-1 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line186 DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 187 187 ! round brackets added to fix the order of floating point operations 188 188 ! needed to ensure halo 1 - halo 2 compatibility … … 197 197 !!st ELSE !- Flux Form (simple averaging) 198 198 #else 199 DO_2D_OVR( nn_hls , nn_hls-1, nn_hls, nn_hls-1 )199 DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 200 200 ! round brackets added to fix the order of floating point operations 201 201 ! needed to ensure halo 1 - halo 2 compatibility 202 202 pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj ) + pssh(ji+1,jj ) ) & 203 & + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)&203 & + ( pssh(ji,jj+1) + pssh(ji+1,jj+1) & 204 204 & ) & ! bracket for halo 1 - halo 2 compatibility 205 205 & ) * r1_hf_0(ji,jj) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r14834 r15014 713 713 ! 714 714 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 715 DO_3D( 1, 0, 1, 0, 1, jpk )715 DO_3D( 0, 0, 0, 0, 1, jpk ) 716 716 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 717 717 & * r1_e1e2f(ji,jj) & -
NEMO/trunk/src/OCE/DOM/domzgr.F90
r14433 r15014 340 340 ! ! N.B. top k-index of W-level = mikt 341 341 ! ! bottom k-index of W-level = mbkt+1 342 DO_2D( 1, 0, 1, 0 )342 DO_2D( 0, 0, 0, 0 ) 343 343 miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) ) 344 344 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) … … 349 349 END_2D 350 350 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 351 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 352 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 353 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 354 ! 355 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 356 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 351 DO_2D( 0, 0, 0, 0 ) 352 zk(ji,jj) = REAL( miku(ji,jj), wp ) 353 END_2D 354 CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 355 miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 356 357 DO_2D( 0, 0, 0, 0 ) 358 zk(ji,jj) = REAL( mikv(ji,jj), wp ) 359 END_2D 360 CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 361 mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 362 363 DO_2D( 0, 0, 0, 0 ) 364 zk(ji,jj) = REAL( mikf(ji,jj), wp ) 365 END_2D 366 CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) 367 mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 368 ! 369 DO_2D( 0, 0, 0, 0 ) 370 zk(ji,jj) = REAL( mbku(ji,jj), wp ) 371 END_2D 372 CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) 373 mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 374 375 DO_2D( 0, 0, 0, 0 ) 376 zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 377 END_2D 378 CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) 379 mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 357 380 ! 358 381 END SUBROUTINE zgr_top_bot -
NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90
r14834 r15014 80 80 pah1(:,:,jk) = pahs1(:,:) * ( zratio + zc * ( 1._wp + TANH( - ( gdept_0(:,:,jk) - zh ) * zw) ) ) 81 81 END DO 82 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 ) ! pah2 at F-point (zdep2 is an approximation in zps-coord.)82 DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 ) ! pah2 at F-point (zdep2 is an approximation in zps-coord.) 83 83 zdep2 = ( gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk) & 84 84 & + gdept_0(ji,jj ,jk) + gdept_0(ji+1,jj ,jk) ) * r1_4 … … 88 88 ! 89 89 CASE( 'TRA' ) ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.) 90 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 )90 DO_3DS( 0, 0, 0, 0, jpkm1, 1, -1 ) 91 91 zdep1 = ( gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk) ) * 0.5_wp 92 92 zdep2 = ( gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk) ) * 0.5_wp -
NEMO/trunk/src/OCE/LDF/ldfdyn.F90
r14433 r15014 385 385 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 386 386 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) 387 zu2pv2_ij_p1 = uu(ji ,jj+1,jk,Kbb) * uu(ji ,jj+1,jk,Kbb) + vv(ji+1,jj ,jk,Kbb) * vv(ji+1,jj ,jk,Kbb) 387 388 zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 388 389 ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk) ! 288= 12*12 * 2 389 END_2D390 DO_2D( 1, 0, 1, 0 )391 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb)392 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb)393 390 zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 394 391 ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk) ! 288= 12*12 * 2 … … 400 397 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 401 398 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) 399 zu2pv2_ij_p1 = uu(ji ,jj+1,jk,Kbb) * uu(ji ,jj+1,jk,Kbb) + vv(ji+1,jj ,jk,Kbb) * vv(ji+1,jj ,jk,Kbb) 402 400 zemax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 403 401 ahmt(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax ) * zemax * tmask(ji,jj,jk) 404 END_2D405 DO_2D( 1, 0, 1, 0 )406 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb)407 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb)408 402 zemax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 409 403 ahmf(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax ) * zemax * fmask(ji,jj,jk) … … 487 481 DO_2D( 0, 0, 0, 0 ) 488 482 ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 489 END_2D490 DO_2D( 1, 0, 1, 0 )491 483 ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 492 484 END_2D
Note: See TracChangeset
for help on using the changeset viewer.