- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LDF/ldfslp.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/LDF/ldfslp.F90
r13237 r13899 128 128 IF( ln_timing ) CALL timing_start('ldf_slp') 129 129 ! 130 zeps = 1.e-20_wp !== Local constant initialization ==!130 zeps = 1.e-20_wp !== Local constant initialization ==! 131 131 z1_16 = 1.0_wp / 16._wp 132 132 zm1_g = -1.0_wp / grav … … 137 137 zwz(:,:,:) = 0._wp 138 138 ! 139 DO_3D _10_10( 1, jpk )139 DO_3D( 1, 0, 1, 0, 1, jpk ) !== i- & j-gradient of density ==! 140 140 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 141 141 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 142 142 END_3D 143 143 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 144 DO_2D _10_10144 DO_2D( 1, 0, 1, 0 ) 145 145 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 146 146 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 148 148 ENDIF 149 149 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 150 DO_2D _10_10150 DO_2D( 1, 0, 1, 0 ) 151 151 IF( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 152 152 IF( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) … … 154 154 ENDIF 155 155 ! 156 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2)156 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 157 157 DO jk = 2, jpkm1 158 158 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 165 165 END DO 166 166 ! 167 ! !== Slopes just below the mixed layer ==!167 ! !== Slopes just below the mixed layer ==! 168 168 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr, Kmm ) ! output: uslpml, vslpml, wslpiml, wslpjml 169 169 … … 173 173 ! 174 174 IF ( ln_isfcav ) THEN 175 DO_2D _00_00175 DO_2D( 0, 0, 0, 0 ) 176 176 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt (ji+1,jj ), 5._wp) & 177 177 & - MAX(risfdep(ji,jj), risfdep(ji+1,jj ) ) ) … … 180 180 END_2D 181 181 ELSE 182 DO_2D _00_00182 DO_2D( 0, 0, 0, 0 ) 183 183 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 184 184 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) … … 186 186 END IF 187 187 188 DO_3D _00_00( 2, jpkm1 )188 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Slopes at u and v points 189 189 ! ! horizontal and vertical density gradient at u- and v-points 190 190 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) … … 231 231 CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.0_wp, zww, 'V', -1.0_wp ) ! lateral boundary conditions 232 232 ! 233 ! 233 ! !* horizontal Shapiro filter 234 234 DO jk = 2, jpkm1 235 DO_2D _00_00235 DO_2D( 0, 0, 0, 0 ) ! rows jj=2 and =jpjm1 only 236 236 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 237 237 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & … … 245 245 & + 4.* zww(ji,jj ,jk) ) 246 246 END_2D 247 DO jj = 3, jpj-2 ! other rows247 DO jj = 3, jpj-2 ! other rows 248 248 DO ji = 2, jpim1 ! vector opt. 249 249 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & … … 259 259 END DO 260 260 END DO 261 ! 262 DO_2D _00_00261 ! !* decrease along coastal boundaries 262 DO_2D( 0, 0, 0, 0 ) 263 263 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 264 264 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp … … 272 272 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 273 273 ! 274 DO_3D _00_00(2, jpkm1 )274 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 275 275 ! !* Local vertical density gradient evaluated from N^2 276 276 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) … … 307 307 ! !* horizontal Shapiro filter 308 308 DO jk = 2, jpkm1 309 DO_2D _00_00309 DO_2D( 0, 0, 0, 0 ) ! rows jj=2 and =jpjm1 only 310 310 zcofw = wmask(ji,jj,jk) * z1_16 311 311 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & … … 338 338 END DO 339 339 ! !* decrease in vicinity of topography 340 DO_2D _00_00340 DO_2D( 0, 0, 0, 0 ) 341 341 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 342 342 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 … … 401 401 ! 402 402 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 403 DO_3D _10_10( 1, jpkm1 )403 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set 404 404 zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) ) ! i-gradient of T & S at u-point 405 405 zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) … … 413 413 ! 414 414 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 415 DO_2D _10_10415 DO_2D( 1, 0, 1, 0 ) 416 416 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 417 417 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature … … 427 427 428 428 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 429 DO_3D _11_11( 1, jpkm1 )430 IF( jk+kp > 1 ) THEN ! k-gradient of T & S a jk+kp429 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! done each pair of triad ! NB: not masked ==> a minimum value is set 430 IF( jk+kp > 1 ) THEN ! k-gradient of T & S a jk+kp 431 431 zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) 432 432 zdks = ( ts(ji,jj,jk+kp-1,jp_sal,Kbb) - ts(ji,jj,jk+kp,jp_sal,Kbb) ) … … 442 442 END DO 443 443 ! 444 DO_2D _11_11444 DO_2D( 1, 1, 1, 1 ) !== Reciprocal depth of the w-point below ML base ==! 445 445 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth 446 446 z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) … … 462 462 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 463 463 DO kp = 0, 1 ! with only the slope-max limit and MASKED 464 DO_2D _10_10464 DO_2D( 1, 0, 1, 0 ) 465 465 ip = jl ; jp = jl 466 466 ! … … 499 499 ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 500 500 znot_thru_surface = REAL( 1-1/(jk+kp), wp ) !jk+kp=1,=0.; otherwise=1.0 501 DO_2D _10_10501 DO_2D( 1, 0, 1, 0 ) 502 502 ! 503 503 ! Calculate slope relative to geopotentials used for GM skew fluxes … … 628 628 ! 629 629 ! !== surface mixed layer mask ! 630 DO_3D _11_11( 1, jpk )630 DO_3D( 1, 1, 1, 1, 1, jpk ) ! =1 inside the mixed layer, =0 otherwise 631 631 ik = nmln(ji,jj) - 1 632 632 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 646 646 !----------------------------------------------------------------------- 647 647 ! 648 DO_2D _00_00648 DO_2D( 0, 0, 0, 0 ) 649 649 ! !== Slope at u- & v-points just below the Mixed Layer ==! 650 650 !
Note: See TracChangeset
for help on using the changeset viewer.
