- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LDF/ldfslp.F90 (modified) (28 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/LDF/ldfslp.F90
r12377 r13540 75 75 !! * Substitutions 76 76 # include "do_loop_substitute.h90" 77 # include "domzgr_substitute.h90" 77 78 !!---------------------------------------------------------------------- 78 79 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 127 128 IF( ln_timing ) CALL timing_start('ldf_slp') 128 129 ! 129 zeps = 1.e-20_wp !== Local constant initialization ==!130 zeps = 1.e-20_wp !== Local constant initialization ==! 130 131 z1_16 = 1.0_wp / 16._wp 131 132 zm1_g = -1.0_wp / grav … … 136 137 zwz(:,:,:) = 0._wp 137 138 ! 138 DO_3D _10_10( 1, jpk )139 DO_3D( 1, 0, 1, 0, 1, jpk ) !== i- & j-gradient of density ==! 139 140 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 140 141 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 141 142 END_3D 142 143 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 143 DO_2D _10_10144 DO_2D( 1, 0, 1, 0 ) 144 145 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 145 146 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 147 148 ENDIF 148 149 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 149 DO_2D _10_10150 DO_2D( 1, 0, 1, 0 ) 150 151 IF( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 151 152 IF( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) … … 153 154 ENDIF 154 155 ! 155 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) 156 157 DO jk = 2, jpkm1 157 158 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 164 165 END DO 165 166 ! 166 ! !== Slopes just below the mixed layer ==!167 ! !== Slopes just below the mixed layer ==! 167 168 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr, Kmm ) ! output: uslpml, vslpml, wslpiml, wslpjml 168 169 … … 172 173 ! 173 174 IF ( ln_isfcav ) THEN 174 DO_2D _00_00175 DO_2D( 0, 0, 0, 0 ) 175 176 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt (ji+1,jj ), 5._wp) & 176 177 & - MAX(risfdep(ji,jj), risfdep(ji+1,jj ) ) ) … … 179 180 END_2D 180 181 ELSE 181 DO_2D _00_00182 DO_2D( 0, 0, 0, 0 ) 182 183 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 183 184 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) … … 185 186 END IF 186 187 187 DO_3D _00_00( 2, jpkm1 )188 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Slopes at u and v points 188 189 ! ! horizontal and vertical density gradient at u- and v-points 189 190 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) … … 198 199 ! ! max slope = 1/2 * e3 / e1 199 200 IF (ln_zps .AND. jk==mbku(ji,jj)) & 200 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , - 2._wp * e1u(ji,jj) / e3u(ji,jj,jk,Kmm)* ABS( zau ) ) 201 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , & 202 & - 2._wp * e1u(ji,jj) / e3u(ji,jj,jk,Kmm)* ABS( zau ) ) 201 203 IF (ln_zps .AND. jk==mbkv(ji,jj)) & 202 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , - 2._wp * e2v(ji,jj) / e3v(ji,jj,jk,Kmm)* ABS( zav ) ) 204 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , & 205 & - 2._wp * e2v(ji,jj) / e3v(ji,jj,jk,Kmm)* ABS( zav ) ) 203 206 ! ! uslp and vslp output in zwz and zww, resp. 204 207 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) … … 206 209 ! thickness of water column between surface and level k at u/v point 207 210 zdepu = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji+1,jj,jk,Kmm) ) & 208 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u(ji,jj,miku(ji,jj),Kmm) ) 211 & - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) & 212 & - e3u(ji,jj,miku(ji,jj),Kmm) ) 209 213 zdepv = 0.5_wp * ( ( gdept (ji,jj,jk,Kmm) + gdept (ji,jj+1,jk,Kmm) ) & 210 - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v(ji,jj,mikv(ji,jj),Kmm) ) 214 & - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) & 215 & - e3v(ji,jj,mikv(ji,jj),Kmm) ) 211 216 ! 212 217 zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps ) & … … 224 229 !!gm end modif 225 230 END_3D 226 CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1. , zww, 'V', -1.) ! lateral boundary conditions227 ! 228 ! 231 CALL lbc_lnk_multi( 'ldfslp', zwz, 'U', -1.0_wp, zww, 'V', -1.0_wp ) ! lateral boundary conditions 232 ! 233 ! !* horizontal Shapiro filter 229 234 DO jk = 2, jpkm1 230 DO_2D _00_00235 DO_2D( 0, 0, 0, 0 ) ! rows jj=2 and =jpjm1 only 231 236 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 232 237 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & … … 240 245 & + 4.* zww(ji,jj ,jk) ) 241 246 END_2D 242 DO jj = 3, jpj-2 ! other rows247 DO jj = 3, jpj-2 ! other rows 243 248 DO ji = 2, jpim1 ! vector opt. 244 249 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & … … 254 259 END DO 255 260 END DO 256 ! 257 DO_2D _00_00261 ! !* decrease along coastal boundaries 262 DO_2D( 0, 0, 0, 0 ) 258 263 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 259 264 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp … … 267 272 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 268 273 ! 269 DO_3D _00_00(2, jpkm1 )274 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 270 275 ! !* Local vertical density gradient evaluated from N^2 271 276 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) … … 293 298 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 294 299 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 295 ! zck = gdepw(ji,jj,jk ) / MAX( hmlp(ji,jj), 10. )300 ! zck = gdepw(ji,jj,jk,Kmm) / MAX( hmlp(ji,jj), 10. ) 296 301 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 297 302 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 298 303 !!gm end modif 299 304 END_3D 300 CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1. , zww, 'T', -1.) ! lateral boundary conditions305 CALL lbc_lnk_multi( 'ldfslp', zwz, 'T', -1.0_wp, zww, 'T', -1.0_wp ) ! lateral boundary conditions 301 306 ! 302 307 ! !* horizontal Shapiro filter 303 308 DO jk = 2, jpkm1 304 DO_2D _00_00309 DO_2D( 0, 0, 0, 0 ) ! rows jj=2 and =jpjm1 only 305 310 zcofw = wmask(ji,jj,jk) * z1_16 306 311 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & … … 333 338 END DO 334 339 ! !* decrease in vicinity of topography 335 DO_2D _00_00340 DO_2D( 0, 0, 0, 0 ) 336 341 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 337 342 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 … … 343 348 ! IV. Lateral boundary conditions 344 349 ! =============================== 345 CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1. , vslp , 'V', -1. , wslpi, 'W', -1., wslpj, 'W', -1.)350 CALL lbc_lnk_multi( 'ldfslp', uslp , 'U', -1.0_wp , vslp , 'V', -1.0_wp , wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 346 351 347 352 IF(sn_cfctl%l_prtctl) THEN … … 396 401 ! 397 402 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 398 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 399 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 400 405 zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) … … 408 413 ! 409 414 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 410 DO_2D _10_10415 DO_2D( 1, 0, 1, 0 ) 411 416 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 412 417 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature … … 422 427 423 428 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 424 DO_3D _11_11( 1, jpkm1 )425 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 426 431 zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) 427 432 zdks = ( ts(ji,jj,jk+kp-1,jp_sal,Kbb) - ts(ji,jj,jk+kp,jp_sal,Kbb) ) … … 437 442 END DO 438 443 ! 439 DO_2D _11_11444 DO_2D( 1, 1, 1, 1 ) !== Reciprocal depth of the w-point below ML base ==! 440 445 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth 441 446 z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) … … 457 462 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 458 463 DO kp = 0, 1 ! with only the slope-max limit and MASKED 459 DO_2D _10_10464 DO_2D( 1, 0, 1, 0 ) 460 465 ip = jl ; jp = jl 461 466 ! … … 494 499 ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 495 500 znot_thru_surface = REAL( 1-1/(jk+kp), wp ) !jk+kp=1,=0.; otherwise=1.0 496 DO_2D _10_10501 DO_2D( 1, 0, 1, 0 ) 497 502 ! 498 503 ! Calculate slope relative to geopotentials used for GM skew fluxes … … 575 580 wslp2(:,:,1) = 0._wp ! force the surface wslp to zero 576 581 577 CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1. ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked582 CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1.0_wp ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 578 583 ! 579 584 IF( ln_timing ) CALL timing_stop('ldf_slp_triad') … … 623 628 ! 624 629 ! !== surface mixed layer mask ! 625 DO_3D _11_11( 1, jpk )630 DO_3D( 1, 1, 1, 1, 1, jpk ) ! =1 inside the mixed layer, =0 otherwise 626 631 ik = nmln(ji,jj) - 1 627 632 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 641 646 !----------------------------------------------------------------------- 642 647 ! 643 DO_2D _00_00648 DO_2D( 0, 0, 0, 0 ) 644 649 ! !== Slope at u- & v-points just below the Mixed Layer ==! 645 650 ! … … 684 689 END_2D 685 690 !!gm this lbc_lnk should be useless.... 686 CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1. , vslpml , 'V', -1. , wslpiml, 'W', -1. , wslpjml, 'W', -1.)691 CALL lbc_lnk_multi( 'ldfslp', uslpml , 'U', -1.0_wp , vslpml , 'V', -1.0_wp , wslpiml, 'W', -1.0_wp , wslpjml, 'W', -1.0_wp ) 687 692 ! 688 693 END SUBROUTINE ldf_slp_mxl
Note: See TracChangeset
for help on using the changeset viewer.
