Changeset 13497 for NEMO/trunk
- Timestamp:
- 2020-09-21T14:37:46+02:00 (4 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 71 edited
-
ICE/icecor.F90 (modified) (1 diff)
-
ICE/icedyn_adv_pra.F90 (modified) (9 diffs)
-
ICE/icedyn_adv_umx.F90 (modified) (2 diffs)
-
ICE/icedyn_rhg_evp.F90 (modified) (2 diffs)
-
ICE/iceupdate.F90 (modified) (2 diffs)
-
OCE/C1D/dtauvd.F90 (modified) (1 diff)
-
OCE/DIA/diaar5.F90 (modified) (3 diffs)
-
OCE/DIA/diacfl.F90 (modified) (1 diff)
-
OCE/DIA/diahth.F90 (modified) (3 diffs)
-
OCE/DIA/diawri.F90 (modified) (1 diff)
-
OCE/DOM/domvvl.F90 (modified) (3 diffs)
-
OCE/DOM/dtatsd.F90 (modified) (1 diff)
-
OCE/DYN/divhor.F90 (modified) (1 diff)
-
OCE/DYN/dynadv_cen2.F90 (modified) (5 diffs)
-
OCE/DYN/dynadv_ubs.F90 (modified) (5 diffs)
-
OCE/DYN/dynkeg.F90 (modified) (1 diff)
-
OCE/DYN/dynldf_iso.F90 (modified) (2 diffs)
-
OCE/DYN/dynldf_lap_blp.F90 (modified) (1 diff)
-
OCE/DYN/dynspg.F90 (modified) (4 diffs)
-
OCE/DYN/dynspg_exp.F90 (modified) (1 diff)
-
OCE/DYN/dynspg_ts.F90 (modified) (4 diffs)
-
OCE/DYN/dynvor.F90 (modified) (1 diff)
-
OCE/DYN/dynzad.F90 (modified) (5 diffs)
-
OCE/DYN/dynzdf.F90 (modified) (4 diffs)
-
OCE/DYN/sshwzv.F90 (modified) (2 diffs)
-
OCE/DYN/wet_dry.F90 (modified) (1 diff)
-
OCE/LDF/ldfc1d_c2d.F90 (modified) (1 diff)
-
OCE/LDF/ldfdyn.F90 (modified) (3 diffs)
-
OCE/LDF/ldfslp.F90 (modified) (13 diffs)
-
OCE/LDF/ldftra.F90 (modified) (2 diffs)
-
OCE/SBC/sbccpl.F90 (modified) (2 diffs)
-
OCE/SBC/sbcflx.F90 (modified) (1 diff)
-
OCE/SBC/sbcrnf.F90 (modified) (4 diffs)
-
OCE/SBC/sbcwave.F90 (modified) (3 diffs)
-
OCE/TRA/eosbn2.F90 (modified) (1 diff)
-
OCE/TRA/traadv_cen.F90 (modified) (4 diffs)
-
OCE/TRA/traadv_fct.F90 (modified) (24 diffs)
-
OCE/TRA/traadv_mus.F90 (modified) (5 diffs)
-
OCE/TRA/traadv_qck.F90 (modified) (3 diffs)
-
OCE/TRA/traadv_ubs.F90 (modified) (7 diffs)
-
OCE/TRA/trabbl.F90 (modified) (6 diffs)
-
OCE/TRA/traldf_iso.F90 (modified) (5 diffs)
-
OCE/TRA/traldf_lap_blp.F90 (modified) (2 diffs)
-
OCE/TRA/traldf_triad.F90 (modified) (2 diffs)
-
OCE/TRA/tramle.F90 (modified) (5 diffs)
-
OCE/TRA/tranpc.F90 (modified) (1 diff)
-
OCE/TRA/traqsr.F90 (modified) (4 diffs)
-
OCE/TRA/trasbc.F90 (modified) (1 diff)
-
OCE/TRA/trazdf.F90 (modified) (3 diffs)
-
OCE/TRA/zpshde.F90 (modified) (3 diffs)
-
OCE/TRD/trddyn.F90 (modified) (1 diff)
-
OCE/TRD/trdglo.F90 (modified) (2 diffs)
-
OCE/TRD/trdmxl.F90 (modified) (1 diff)
-
OCE/TRD/trdtra.F90 (modified) (2 diffs)
-
OCE/TRD/trdvor.F90 (modified) (1 diff)
-
OCE/USR/usrdef_istate.F90 (modified) (1 diff)
-
OCE/ZDF/zdfddm.F90 (modified) (2 diffs)
-
OCE/ZDF/zdfdrg.F90 (modified) (1 diff)
-
OCE/ZDF/zdfgls.F90 (modified) (8 diffs)
-
OCE/ZDF/zdfiwm.F90 (modified) (7 diffs)
-
OCE/ZDF/zdfmxl.F90 (modified) (2 diffs)
-
OCE/ZDF/zdfosm.F90 (modified) (3 diffs)
-
OCE/ZDF/zdfric.F90 (modified) (2 diffs)
-
OCE/ZDF/zdfsh2.F90 (modified) (2 diffs)
-
OCE/ZDF/zdftke.F90 (modified) (15 diffs)
-
OFF/dtadyn.F90 (modified) (2 diffs)
-
TOP/C14/trcatm_c14.F90 (modified) (1 diff)
-
TOP/CFC/trcsms_cfc.F90 (modified) (1 diff)
-
TOP/PISCES/P2Z/p2zopt.F90 (modified) (3 diffs)
-
TOP/TRP/trdmxl_trc.F90 (modified) (1 diff)
-
TOP/trcdta.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icecor.F90
r13472 r13497 105 105 ! !----------------------------------------------------- 106 106 IF( kn == 2 ) THEN ! Ice drift case: Corrections to avoid wrong values ! 107 DO_2D( 0, 0, 0, 0 ) 107 DO_2D( 0, 0, 0, 0 ) !----------------------------------------------------- 108 108 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 109 109 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side -
NEMO/trunk/src/ICE/icedyn_adv_pra.F90
r13472 r13497 383 383 384 384 ! Calculate fluxes and moments between boxes i<-->i+1 385 DO_2D( 0, 0, 1, 1 ) 385 DO_2D( 0, 0, 1, 1 ) ! Flux from i to i+1 WHEN u GT 0 386 386 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 387 387 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) … … 408 408 END_2D 409 409 410 DO_2D( 0, 0, 1, 0 ) 410 DO_2D( 0, 0, 1, 0 ) ! Flux from i+1 to i when u LT 0. 411 411 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 412 412 zalg (ji,jj) = zalf … … 427 427 END_2D 428 428 429 DO_2D( 0, 0, 0, 0 ) 429 DO_2D( 0, 0, 0, 0 ) ! Readjust moments remaining in the box. 430 430 zbt = zbet(ji-1,jj) 431 431 zbt1 = 1.0 - zbet(ji-1,jj) … … 441 441 442 442 ! Put the temporary moments into appropriate neighboring boxes. 443 DO_2D( 0, 0, 0, 0 ) 443 DO_2D( 0, 0, 0, 0 ) ! Flux from i to i+1 IF u GT 0. 444 444 zbt = zbet(ji-1,jj) 445 445 zbt1 = 1.0 - zbet(ji-1,jj) … … 461 461 END_2D 462 462 463 DO_2D( 0, 0, 0, 0 ) 463 DO_2D( 0, 0, 0, 0 ) ! Flux from i+1 to i IF u LT 0. 464 464 zbt = zbet(ji,jj) 465 465 zbt1 = 1.0 - zbet(ji,jj) … … 540 540 541 541 ! Calculate fluxes and moments between boxes j<-->j+1 542 DO_2D( 1, 1, 0, 0 ) 542 DO_2D( 1, 1, 0, 0 ) ! Flux from j to j+1 WHEN v GT 0 543 543 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 544 544 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) … … 565 565 END_2D 566 566 ! 567 DO_2D( 1, 0, 0, 0 ) 567 DO_2D( 1, 0, 0, 0 ) ! Flux from j+1 to j when v LT 0. 568 568 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 569 569 zalg (ji,jj) = zalf … … 599 599 600 600 ! Put the temporary moments into appropriate neighboring boxes. 601 DO_2D( 0, 0, 0, 0 ) 601 DO_2D( 0, 0, 0, 0 ) ! Flux from j to j+1 IF v GT 0. 602 602 zbt = zbet(ji,jj-1) 603 603 zbt1 = 1.0 - zbet(ji,jj-1) … … 620 620 END_2D 621 621 622 DO_2D( 0, 0, 0, 0 ) 622 DO_2D( 0, 0, 0, 0 ) ! Flux from j+1 to j IF v LT 0. 623 623 zbt = zbet(ji,jj) 624 624 zbt1 = 1.0 - zbet(ji,jj) -
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r13472 r13497 1006 1006 ! !-- Laplacian in j-direction --! 1007 1007 DO jl = 1, jpl 1008 DO_2D( 1, 0, 0, 0 ) 1008 DO_2D( 1, 0, 0, 0 ) ! First derivative (gradient) 1009 1009 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1010 1010 END_2D 1011 DO_2D( 0, 0, 0, 0 ) 1011 DO_2D( 0, 0, 0, 0 ) ! Second derivative (Laplacian) 1012 1012 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1013 1013 END_2D … … 1017 1017 ! !-- BiLaplacian in j-direction --! 1018 1018 DO jl = 1, jpl 1019 DO_2D( 1, 0, 0, 0 ) 1019 DO_2D( 1, 0, 0, 0 ) ! First derivative 1020 1020 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1021 1021 END_2D 1022 DO_2D( 0, 0, 0, 0 ) 1022 DO_2D( 0, 0, 0, 0 ) ! Second derivative 1023 1023 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1024 1024 END_2D -
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r13472 r13497 370 370 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 371 371 372 DO_2D( 0, 1, 0, 1 ) 372 DO_2D( 0, 1, 0, 1 ) ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 ! no vector loop 373 373 374 374 ! shear**2 at T points (doc eq. A16) … … 704 704 END_2D 705 705 706 DO_2D( 0, 0, 0, 0 ) 706 DO_2D( 0, 0, 0, 0 ) ! no vector loop 707 707 708 708 ! tension**2 at T points -
NEMO/trunk/src/ICE/iceupdate.F90
r13472 r13497 332 332 ! 333 333 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 334 DO_2D( 0, 0, 0, 0 ) 334 DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point) 335 335 ! ! 2*(U_ice-U_oce) at T-point 336 336 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) … … 358 358 ENDIF 359 359 ! 360 DO_2D( 0, 0, 0, 0 ) 360 DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle 361 361 ! ice area at u and v-points 362 362 zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) & -
NEMO/trunk/src/OCE/C1D/dtauvd.F90
r13295 r13497 158 158 ENDIF 159 159 ! 160 DO_2D( 1, 1, 1, 1 ) 160 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of U & V current: 161 161 DO jk = 1, jpk 162 162 zl = gdept(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DIA/diaar5.F90
r13295 r13497 144 144 IF( ln_linssh ) THEN 145 145 IF( ln_isfcav ) THEN 146 DO ji = 1, jpi 147 DO jj = 1, jpj 148 iks = mikt(ji,jj) 149 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 150 END DO 151 END DO 146 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 147 iks = mikt(ji,jj) 148 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 149 END_2D 152 150 ELSE 153 151 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) … … 385 383 zvol0 (:,:) = 0._wp 386 384 thick0(:,:) = 0._wp 387 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 385 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) 388 386 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 389 387 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) … … 403 401 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 404 402 IF( ln_zps ) THEN ! z-coord. partial steps 405 DO_2D( 1, 1, 1, 1 ) 403 DO_2D( 1, 1, 1, 1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) 406 404 ik = mbkt(ji,jj) 407 405 IF( ik > 1 ) THEN -
NEMO/trunk/src/OCE/DIA/diacfl.F90
r13458 r13497 66 66 llmsk(:,Nje1: jpj,:) = .FALSE. 67 67 ! 68 DO_3D( 0, 0, 0, 0, 1, jpk ) 68 DO_3D( 0, 0, 0, 0, 1, jpk ) ! calculate Courant numbers 69 69 zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction 70 70 zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v (ji,jj) ! for j-direction -
NEMO/trunk/src/OCE/DIA/diahth.F90
r13295 r13497 170 170 ! MLD: rho = rho(1) + zrho1 ! 171 171 ! ------------------------------------------------------------- ! 172 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 172 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! loop from bottom to 2 173 173 ! 174 174 zzdep = gdepw(ji,jj,jk,Kmm) … … 207 207 ! depth of temperature inversion ! 208 208 ! ------------------------------------------------------------- ! 209 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 209 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10 210 210 ! 211 211 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) … … 305 305 ! --------------------------------------- ! 306 306 iktem(:,:) = 1 307 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 307 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom 308 308 zztmp = ts(ji,jj,jk,jp_tem,Kmm) 309 309 IF( zztmp >= ptem ) iktem(ji,jj) = jk -
NEMO/trunk/src/OCE/DIA/diawri.F90
r13472 r13497 270 270 271 271 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 272 DO_2D( 0, 0, 0, 0 ) 272 DO_2D( 0, 0, 0, 0 ) ! sst gradient 273 273 zztmp = ts(ji,jj,1,jp_tem,Kmm) 274 274 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r13458 r13497 202 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 203 203 gdepw(:,:,1,Kbb) = 0.0_wp 204 DO_3D( 1, 1, 1, 1, 2, jpk ) 204 DO_3D( 1, 1, 1, 1, 2, jpk ) ! vertical sum 205 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) … … 420 420 zwu(:,:) = 0._wp 421 421 zwv(:,:) = 0._wp 422 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 422 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! a - first derivative: diffusive fluxes 423 423 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 424 424 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) … … 428 428 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 429 429 END_3D 430 DO_2D( 1, 1, 1, 1 ) 430 DO_2D( 1, 1, 1, 1 ) ! b - correction for last oceanic u-v points 431 431 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 432 432 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 433 433 END_2D 434 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 434 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! c - second derivative: divergence of diffusive fluxes 435 435 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 436 436 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 437 437 & ) * r1_e1e2t(ji,jj) 438 438 END_3D 439 ! ! d - thickness diffusion transport: boundary conditions439 ! ! d - thickness diffusion transport: boundary conditions 440 440 ! (stored for tracer advction and continuity equation) 441 441 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) -
NEMO/trunk/src/OCE/DOM/dtatsd.F90
r13295 r13497 186 186 ENDIF 187 187 ! 188 DO_2D( 1, 1, 1, 1 ) 188 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 189 189 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 190 zl = gdept_0(ji,jj,jk) -
NEMO/trunk/src/OCE/DYN/divhor.F90
r13295 r13497 77 77 ENDIF 78 78 ! 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 80 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & -
NEMO/trunk/src/OCE/DYN/dynadv_cen2.F90
r13295 r13497 72 72 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 73 73 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 74 DO_2D( 1, 0, 1, 0 ) 74 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point) 75 75 zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 76 76 zfv_f(ji ,jj ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) … … 78 78 zfv_t(ji ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) 79 79 END_2D 80 DO_2D( 0, 0, 0, 0 ) 80 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 81 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 82 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 98 98 ! !== Vertical advection ==! 99 99 ! 100 DO_2D( 0, 0, 0, 0 ) 100 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 101 101 zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp 102 102 zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp … … 109 109 ENDIF 110 110 DO jk = 2, jpkm1 ! interior advective fluxes 111 DO_2D( 0, 1, 0, 1 ) 111 DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport 112 112 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 113 113 END_2D … … 117 117 END_2D 118 118 END DO 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 120 120 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 121 & / e3u(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DYN/dynadv_ubs.F90
r13295 r13497 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 DO_2D( 0, 0, 0, 0 ) 110 DO_2D( 0, 0, 0, 0 ) ! laplacian 111 111 zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj ,jk,Kbb) ) * umask(ji,jj,jk) 112 112 zlv_vv(ji,jj,jk,1) = ( pvv (ji ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) … … 136 136 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 137 137 ! 138 DO_2D( 1, 0, 1, 0 ) 138 DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point 139 139 zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 140 140 zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) … … 168 168 & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v ) 169 169 END_2D 170 DO_2D( 0, 0, 0, 0 ) 170 DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes 171 171 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 172 172 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 187 187 ! ! Vertical advection ! 188 188 ! ! ==================== ! 189 DO_2D( 0, 0, 0, 0 ) 189 DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero 190 190 zfu_uw(ji,jj,jpk) = 0._wp 191 191 zfv_vw(ji,jj,jpk) = 0._wp … … 208 208 END_2D 209 209 END DO 210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence 211 211 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 212 & / e3u(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DYN/dynkeg.F90
r13295 r13497 125 125 END SELECT 126 126 ! 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== grad( KE ) added to the general momentum trends ==! 128 128 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 129 129 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynldf_iso.F90
r13295 r13497 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 DO_3D( 0, 0, 0, 0, 1, jpk ) 130 DO_3D( 0, 0, 0, 0, 1, jpk ) ! set the slopes of iso-level 131 131 uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 132 132 vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) … … 268 268 ! Second derivative (divergence) and add to the general trend 269 269 ! ----------------------------------------------------------- 270 DO_2D( 0, 0, 0, 0 ) 270 DO_2D( 0, 0, 0, 0 ) !!gm Question vectop possible??? !!bug 271 271 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 272 272 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) & -
NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r13295 r13497 84 84 END_2D 85 85 ! 86 DO_2D( 0, 0, 0, 0 ) 86 DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 87 87 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 88 88 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & -
NEMO/trunk/src/OCE/DYN/dynspg.F90
r13295 r13497 102 102 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 103 103 zg_2 = grav * 0.5 104 DO_2D( 0, 0, 0, 0 ) 104 DO_2D( 0, 0, 0, 0 ) ! gradient of Patm using inverse barometer ssh 105 105 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 106 106 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) … … 117 117 CALL upd_tide(zt0step, Kmm) 118 118 ! 119 DO_2D( 0, 0, 0, 0 ) 119 DO_2D( 0, 0, 0, 0 ) ! add tide potential forcing 120 120 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 121 121 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) … … 124 124 IF (ln_scal_load) THEN 125 125 zld = rn_scal_load * grav 126 DO_2D( 0, 0, 0, 0 ) 126 DO_2D( 0, 0, 0, 0 ) ! add scalar approximation for load potential 127 127 spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 128 128 spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) … … 143 143 ENDIF 144 144 ! 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Add all terms to the general trend 146 146 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 147 147 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynspg_exp.F90
r13295 r13497 74 74 IF( ln_linssh ) THEN !* linear free surface : add the surface pressure gradient trend 75 75 ! 76 DO_2D( 0, 0, 0, 0 ) 76 DO_2D( 0, 0, 0, 0 ) ! now surface pressure gradient 77 77 spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 78 78 spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 79 79 END_2D 80 80 ! 81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Add it to the general trend 82 82 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 83 83 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynspg_ts.F90
r13472 r13497 279 279 ENDIF 280 280 ! 281 DO_2D( 0, 0, 0, 0 ) 281 DO_2D( 0, 0, 0, 0 ) ! Remove coriolis term (and possibly spg) from barotropic trend 282 282 zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 283 283 zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) … … 475 475 ! 476 476 ! ! ocean u- and v-depth at mid-step (separate DO-loops remove the need of a lbc_lnk) 477 DO_2D( 1, 1, 1, 0 ) 477 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 478 478 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & 479 479 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 480 480 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 481 481 END_2D 482 DO_2D( 1, 0, 1, 1 ) 482 DO_2D( 1, 0, 1, 1 ) ! not jpj-row 483 483 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj) & 484 484 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & … … 1308 1308 !!---------------------------------------------------------------------- 1309 1309 ! 1310 DO_2D( 1, 1, 1, 0 ) 1310 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 1311 1311 IF ( phU(ji,jj) > 0._wp ) THEN ; pUmsk(ji,jj) = pTmsk(ji ,jj) 1312 1312 ELSE ; pUmsk(ji,jj) = pTmsk(ji+1,jj) … … 1316 1316 END_2D 1317 1317 ! 1318 DO_2D( 1, 0, 1, 1 ) 1318 DO_2D( 1, 0, 1, 1 ) ! not jpj-row 1319 1319 IF ( phV(ji,jj) > 0._wp ) THEN ; pVmsk(ji,jj) = pTmsk(ji,jj ) 1320 1320 ELSE ; pVmsk(ji,jj) = pTmsk(ji,jj+1) -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r13295 r13497 246 246 CASE ( np_CRV ) !* Coriolis + relative vorticity 247 247 DO jk = 1, jpkm1 ! Horizontal slab 248 DO_2D( 1, 0, 1, 0 ) 248 DO_2D( 1, 0, 1, 0 ) ! relative vorticity 249 249 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 250 250 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynzad.F90
r13295 r13497 71 71 ENDIF 72 72 73 IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends73 IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 74 74 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 75 75 ztrdu(:,:,:) = puu(:,:,:,Krhs) … … 77 77 ENDIF 78 78 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical80 DO_2D( 0, 1, 0, 1 ) 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 80 DO_2D( 0, 1, 0, 1 ) ! vertical fluxes 81 81 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 82 82 END_2D 83 DO_2D( 0, 0, 0, 0 ) 83 DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point 84 84 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 85 85 zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) … … 95 95 END_2D 96 96 ! 97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Vertical momentum advection at u- and v-points 98 98 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 99 99 & / e3u(ji,jj,jk,Kmm) … … 102 102 END_3D 103 103 104 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic104 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic 105 105 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 106 106 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) … … 108 108 DEALLOCATE( ztrdu, ztrdv ) 109 109 ENDIF 110 ! ! Control print110 ! ! Control print 111 111 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' zad - Ua: ', mask1=umask, & 112 112 & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) -
NEMO/trunk/src/OCE/DYN/dynzdf.F90
r13472 r13497 131 131 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk) 132 132 END_3D 133 DO_2D( 0, 0, 0, 0 ) 133 DO_2D( 0, 0, 0, 0 ) ! Add bottom/top stress due to barotropic component only 134 134 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 135 135 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 190 190 END_3D 191 191 END SELECT 192 DO_2D( 0, 0, 0, 0 ) 192 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 193 193 zwi(ji,jj,1) = 0._wp 194 194 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & … … 227 227 END_3D 228 228 END SELECT 229 DO_2D( 0, 0, 0, 0 ) 229 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 230 230 zwi(ji,jj,1) = 0._wp 231 231 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 366 366 END_3D 367 367 END SELECT 368 DO_2D( 0, 0, 0, 0 ) 368 DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions 369 369 zwi(ji,jj,1) = 0._wp 370 370 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) -
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r13295 r13497 203 203 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 204 204 ! !==========================================! 205 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence205 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 206 206 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 207 207 & + r1_Dt * ( e3t(:,:,jk,Kaa) & … … 393 393 ! 394 394 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 395 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 395 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 396 396 ! 397 397 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) -
NEMO/trunk/src/OCE/DYN/wet_dry.F90
r13295 r13497 307 307 zwdlmtv(:,:) = 1._wp 308 308 ! 309 DO_2D( 0, 1, 0, 1 ) 309 DO_2D( 0, 1, 0, 1 ) ! Horizontal Flux in u and v direction 310 310 ! 311 311 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells -
NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90
r13295 r13497 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 ) 82 DO_3DS( 1, 0, 1, 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 -
NEMO/trunk/src/OCE/LDF/ldfdyn.F90
r13295 r13497 311 311 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays') 312 312 ! 313 DO_2D( 1, 1, 1, 1 ) 313 DO_2D( 1, 1, 1, 1 ) ! Set local gridscale values 314 314 esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 315 315 esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 … … 434 434 DO jk = 1, jpkm1 435 435 ! 436 DO_2D( 0, 0, 0, 0 ) 436 DO_2D( 0, 0, 0, 0 ) ! T-point value 437 437 ! 438 438 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) … … 448 448 END_2D 449 449 ! 450 DO_2D( 1, 0, 1, 0 ) 450 DO_2D( 1, 0, 1, 0 ) ! F-point value 451 451 ! 452 452 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) -
NEMO/trunk/src/OCE/LDF/ldfslp.F90
r13295 r13497 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( 1, 0, 1, 0, 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) ) … … 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 … … 186 186 END IF 187 187 188 DO_3D( 0, 0, 0, 0, 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( 0, 0, 0, 0 ) 235 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 ! 261 ! !* decrease along coastal boundaries 262 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 & … … 307 307 ! !* horizontal Shapiro filter 308 308 DO jk = 2, jpkm1 309 DO_2D( 0, 0, 0, 0 ) 309 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) & … … 401 401 ! 402 402 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 403 DO_3D( 1, 0, 1, 0, 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) ) … … 427 427 428 428 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 429 DO_3D( 1, 1, 1, 1, 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( 1, 1, 1, 1 ) 444 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) … … 628 628 ! 629 629 ! !== surface mixed layer mask ! 630 DO_3D( 1, 1, 1, 1, 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 -
NEMO/trunk/src/OCE/LDF/ldftra.F90
r13295 r13497 694 694 CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp ) ! lateral boundary condition 695 695 ! 696 DO_2D( 0, 0, 0, 0 ) 696 DO_2D( 0, 0, 0, 0 ) !== aei at u- and v-points ==! 697 697 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) 698 698 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) … … 813 813 CALL iom_put( "voce_eiv", zw3d ) 814 814 ! 815 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 815 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e1 e2 w_eiv = dk[psix] + dk[psix] 816 816 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 817 817 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r13472 r13497 1195 1195 ! 1196 1196 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1197 DO_2D( 0, 0, 0, 0 ) 1197 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1198 1198 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1199 1199 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) … … 1586 1586 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1587 1587 CASE( 'T' ) 1588 DO_2D( 0, 0, 0, 0 ) 1588 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1589 1589 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1590 1590 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) -
NEMO/trunk/src/OCE/SBC/sbcflx.F90
r13491 r13497 133 133 END_2D 134 134 ENDIF 135 DO_2D( 0, 0, 0, 0 ) 135 DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields 136 136 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) 137 137 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r13295 r13497 215 215 END_2D 216 216 ELSE !* variable volume case 217 DO_2D( 1, 1, 1, 1 ) 217 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 218 218 h_rnf(ji,jj) = 0._wp 219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 220 220 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) ! to the bottom of the relevant grid box 221 221 END DO … … 374 374 ENDIF 375 375 END_2D 376 DO_2D( 1, 1, 1, 1 ) 376 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 377 377 h_rnf(ji,jj) = 0._wp 378 378 DO jk = 1, nk_rnf(ji,jj) … … 404 404 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 405 405 ! 406 DO_2D( 1, 1, 1, 1 ) 406 DO_2D( 1, 1, 1, 1 ) ! take in account min depth of ocean rn_hmin 407 407 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 408 408 jk = mbkt(ji,jj) … … 423 423 END_2D 424 424 ! 425 DO_2D( 1, 1, 1, 1 ) 425 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 426 426 h_rnf(ji,jj) = 0._wp 427 427 DO jk = 1, nk_rnf(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcwave.F90
r13295 r13497 121 121 zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp ) 122 122 END_2D 123 DO_2D( 1, 0, 1, 0 ) 123 DO_2D( 1, 0, 1, 0 ) ! exp. wave number & Stokes drift velocity at u- & v-points 124 124 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 125 125 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 164 164 zsqrtpi = SQRT(rpi) 165 165 z_two_thirds = 2.0_wp / 3.0_wp 166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! exp. wave number & Stokes drift velocity at u- & v-points 167 167 zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth 168 168 zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth … … 204 204 ! !== vertical Stokes Drift 3D velocity ==! 205 205 ! 206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) ! Horizontal e3*divergence 207 207 ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) & 208 208 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) & -
NEMO/trunk/src/OCE/TRA/eosbn2.F90
r13295 r13497 873 873 IF( ln_timing ) CALL timing_start('bn2') 874 874 ! 875 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 875 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 876 876 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 877 877 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) -
NEMO/trunk/src/OCE/TRA/traadv_cen.F90
r13457 r13497 112 112 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 113 113 ztv(:,:,jpk) = 0._wp 114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! masked gradient 115 115 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 116 116 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) … … 118 118 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 119 119 ! 120 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 120 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes 121 121 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2) 122 122 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 159 159 ENDIF 160 160 ! 161 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 161 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Divergence of advective fluxes --! 162 162 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 163 163 & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 166 166 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 167 167 END_3D 168 ! ! trend diagnostics168 ! ! trend diagnostics 169 169 IF( l_trd ) THEN 170 170 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) -
NEMO/trunk/src/OCE/TRA/traadv_fct.F90
r13295 r13497 160 160 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji ,jj+1,jk,jn,Kbb) ) 161 161 END_3D 162 ! !* upstream tracer flux in the k direction *!163 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 162 ! !* upstream tracer flux in the k direction *! 163 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 164 164 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 165 165 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 166 166 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 167 167 END_3D 168 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked)169 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface168 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 169 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 170 170 DO_2D( 1, 1, 1, 1 ) 171 171 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 172 172 END_2D 173 ELSE ! no cavities: only at the ocean surface173 ELSE ! no cavities: only at the ocean surface 174 174 DO_2D( 1, 1, 1, 1 ) 175 175 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) … … 178 178 ENDIF 179 179 ! 180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 181 ! ! total intermediate advective trends180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 181 ! ! total intermediate advective trends 182 182 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 183 183 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 184 184 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 185 ! ! update and guess with monotonic sheme185 ! ! update and guess with monotonic sheme 186 186 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra & 187 187 & / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk) … … 194 194 ! 195 195 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 196 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 196 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 197 197 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 198 198 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 227 227 zltv(:,:,jpk) = 0._wp 228 228 DO jk = 1, jpkm1 ! Laplacian 229 DO_2D( 1, 0, 1, 0 ) 229 DO_2D( 1, 0, 1, 0 ) ! 1st derivative (gradient) 230 230 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 231 231 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 232 232 END_2D 233 DO_2D( 0, 0, 0, 0 ) 233 DO_2D( 0, 0, 0, 0 ) ! 2nd derivative * 1/ 6 234 234 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) + ztu(ji-1,jj,jk) ) * r1_6 235 235 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) + ztv(ji,jj-1,jk) ) * r1_6 … … 238 238 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 239 239 ! 240 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 240 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! Horizontal advective fluxes 241 241 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 242 242 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 243 ! ! C4 minus upstream advective fluxes243 ! ! C4 minus upstream advective fluxes 244 244 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 245 245 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) … … 249 249 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 250 250 ztv(:,:,jpk) = 0._wp 251 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 251 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! 1st derivative (gradient) 252 252 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 253 253 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) … … 255 255 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 256 256 ! 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes 258 258 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points (x2) 259 259 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 288 288 ! 289 289 IF ( ll_zAimp ) THEN 290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 291 ! ! total intermediate advective trends290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 291 ! ! total intermediate advective trends 292 292 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 293 293 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & … … 298 298 CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 299 299 ! 300 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 300 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 301 301 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 302 302 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 324 324 ! 325 325 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp 326 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 326 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 327 327 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 328 328 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 454 454 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 455 455 456 ! monotonic flux in the k direction, i.e. pcc457 ! -------------------------------------------456 ! monotonic flux in the k direction, i.e. pcc 457 ! ------------------------------------------- 458 458 za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 459 459 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) … … 481 481 !!---------------------------------------------------------------------- 482 482 483 DO_3D( 1, 1, 1, 1, 3, jpkm1 ) 483 DO_3D( 1, 1, 1, 1, 3, jpkm1 ) !== build the three diagonal matrix ==! 484 484 zwd (ji,jj,jk) = 4._wp 485 485 zwi (ji,jj,jk) = 1._wp … … 495 495 END_3D 496 496 ! 497 jk = 2 497 jk = 2 ! Switch to second order centered at top 498 498 DO_2D( 1, 1, 1, 1 ) 499 499 zwd (ji,jj,jk) = 1._wp … … 504 504 ! 505 505 ! !== tridiagonal solve ==! 506 DO_2D( 1, 1, 1, 1 ) 506 DO_2D( 1, 1, 1, 1 ) ! first recurrence 507 507 zwt(ji,jj,2) = zwd(ji,jj,2) 508 508 END_2D … … 511 511 END_3D 512 512 ! 513 DO_2D( 1, 1, 1, 1 ) 513 DO_2D( 1, 1, 1, 1 ) ! second recurrence: Zk = Yk - Ik / Tk-1 Zk-1 514 514 pt_out(ji,jj,2) = zwrm(ji,jj,2) 515 515 END_2D … … 518 518 END_3D 519 519 520 DO_2D( 1, 1, 1, 1 ) 520 DO_2D( 1, 1, 1, 1 ) ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 521 521 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 522 522 END_2D … … 546 546 ! !== build the three diagonal matrix & the RHS ==! 547 547 ! 548 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 548 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) ! interior (from jk=3 to jpk-1) 549 549 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 550 550 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal … … 565 565 END IF 566 566 ! 567 DO_2D( 0, 0, 0, 0 ) 567 DO_2D( 0, 0, 0, 0 ) ! 2nd order centered at top & bottom 568 568 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 569 569 ikb = MAX(mbkt(ji,jj), 2) ! - above the last wet point … … 582 582 ! !== tridiagonal solver ==! 583 583 ! 584 DO_2D( 0, 0, 0, 0 ) 584 DO_2D( 0, 0, 0, 0 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 585 585 zwt(ji,jj,2) = zwd(ji,jj,2) 586 586 END_2D … … 589 589 END_3D 590 590 ! 591 DO_2D( 0, 0, 0, 0 ) 591 DO_2D( 0, 0, 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 592 592 pt_out(ji,jj,2) = zwrm(ji,jj,2) 593 593 END_2D … … 596 596 END_3D 597 597 598 DO_2D( 0, 0, 0, 0 ) 598 DO_2D( 0, 0, 0, 0 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 599 599 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 600 600 END_2D … … 638 638 kstart = 1 + klev 639 639 ! 640 DO_2D( 0, 0, 0, 0 ) 640 DO_2D( 0, 0, 0, 0 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 641 641 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 642 642 END_2D … … 645 645 END_3D 646 646 ! 647 DO_2D( 0, 0, 0, 0 ) 647 DO_2D( 0, 0, 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 648 648 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 649 649 END_2D … … 652 652 END_3D 653 653 654 DO_2D( 0, 0, 0, 0 ) 654 DO_2D( 0, 0, 0, 0 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 655 655 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 656 656 END_2D -
NEMO/trunk/src/OCE/TRA/traadv_mus.F90
r13295 r13497 148 148 END_3D 149 149 ! 150 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 150 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) !-- Slopes limitation 151 151 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 152 152 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 157 157 END_3D 158 158 ! 159 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 159 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 160 160 ! MUSCL fluxes 161 161 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 175 175 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 176 176 ! 177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend 178 178 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 179 179 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & … … 204 204 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 205 205 END_3D 206 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 206 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) !-- Slopes limitation 207 207 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 208 208 & 2.*ABS( zwx (ji,jj,jk+1) ), & 209 209 & 2.*ABS( zwx (ji,jj,jk ) ) ) 210 210 END_3D 211 DO_3D( 0, 0, 0, 0, 1, jpk-2 ) 211 DO_3D( 0, 0, 0, 0, 1, jpk-2 ) !-- vertical advective flux 212 212 z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) 213 213 zalpha = 0.5 + z0w … … 227 227 ENDIF 228 228 ! 229 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 229 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- vertical advective trend 230 230 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) & 231 231 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traadv_qck.F90
r13295 r13497 142 142 ! 143 143 !!gm why not using a SHIFT instruction... 144 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 144 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask 145 145 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 146 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer … … 327 327 ! ! =========== 328 328 ! 329 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 329 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Interior point (w-masked 2nd order centered flux) 330 330 zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk) 331 331 END_3D … … 340 340 ENDIF 341 341 ! 342 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 342 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Tracer flux divergence added to the general trend ==! 343 343 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 344 344 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traadv_ubs.F90
r13295 r13497 124 124 ! ! =========== 125 125 ! 126 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==!127 DO_2D( 1, 0, 1, 0 ) 126 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==! 127 DO_2D( 1, 0, 1, 0 ) ! First derivative (masked gradient) 128 128 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 129 129 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) … … 131 131 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 132 132 END_2D 133 DO_2D( 0, 0, 0, 0 ) 133 DO_2D( 0, 0, 0, 0 ) ! Second derivative (divergence) 134 134 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 135 135 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef … … 140 140 CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp ) ; CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 141 141 ! 142 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 143 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ! upstream transport (x2)142 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS) 143 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ! upstream transport (x2) 144 144 zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 145 145 zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) … … 166 166 ! 167 167 zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case 168 ! ! and/or in trend diagnostic (l_trd=T)168 ! ! and/or in trend diagnostic (l_trd=T) 169 169 ! 170 170 IF( l_trd ) THEN ! trend diagnostics … … 187 187 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 188 188 ! 189 ! !* upstream advection with initial mass fluxes & intermediate update ==!189 ! !* upstream advection with initial mass fluxes & intermediate update ==! 190 190 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 191 191 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) … … 193 193 ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 194 194 END_3D 195 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked)196 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface195 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked) 196 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 197 197 DO_2D( 1, 1, 1, 1 ) 198 198 ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 199 199 END_2D 200 ELSE ! no cavities: only at the ocean surface200 ELSE ! no cavities: only at the ocean surface 201 201 ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 202 202 ENDIF 203 203 ENDIF 204 204 ! 205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 206 206 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 207 207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 230 230 END SELECT 231 231 ! 232 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 232 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! final trend with corrected fluxes 233 233 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 234 234 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 235 235 END_3D 236 236 ! 237 IF( l_trd ) THEN ! vertical advective trend diagnostics238 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 237 IF( l_trd ) THEN ! vertical advective trend diagnostics 238 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w]) 239 239 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 240 240 & + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) & -
NEMO/trunk/src/OCE/TRA/trabbl.F90
r13295 r13497 197 197 END_2D 198 198 ! 199 DO_2D( 0, 0, 0, 0 ) 199 DO_2D( 0, 0, 0, 0 ) ! Compute the trend 200 200 ik = mbkt(ji,jj) ! bottom T-level index 201 201 pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn) & … … 358 358 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 359 359 ! !-------------------! 360 DO_2D( 1, 0, 1, 0 ) 360 DO_2D( 1, 0, 1, 0 ) ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 361 361 ! ! i-direction 362 362 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point … … 388 388 ! 389 389 CASE( 1 ) != use of upper velocity 390 DO_2D( 1, 0, 1, 0 ) 390 DO_2D( 1, 0, 1, 0 ) ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 391 391 ! ! i-direction 392 392 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point … … 417 417 CASE( 2 ) != bbl velocity = F( delta rho ) 418 418 zgbbl = grav * rn_gambbl 419 DO_2D( 1, 0, 1, 0 ) 419 DO_2D( 1, 0, 1, 0 ) ! criteria: rho_up > rho_down 420 420 ! ! i-direction 421 421 ! down-slope T-point i/k-index (deep) & up-slope T-point i/k-index (shelf) … … 509 509 ! 510 510 ! !* vertical index of "deep" bottom u- and v-points 511 DO_2D( 1, 0, 1, 0 ) 511 DO_2D( 1, 0, 1, 0 ) ! (the "shelf" bottom k-indices are mbku and mbkv) 512 512 mbku_d(ji,jj) = MAX( mbkt(ji+1,jj ) , mbkt(ji,jj) ) ! >= 1 as mbkt=1 over land 513 513 mbkv_d(ji,jj) = MAX( mbkt(ji ,jj+1) , mbkt(ji,jj) ) … … 530 530 END_2D 531 531 ! 532 DO_2D( 1, 0, 1, 0 ) 532 DO_2D( 1, 0, 1, 0 ) !* bbl thickness at u- (v-) point; minimum of top & bottom e3u_0 (e3v_0) 533 533 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 534 534 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) -
NEMO/trunk/src/OCE/TRA/traldf_iso.F90
r13295 r13497 205 205 END_3D 206 206 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 207 DO_2D( 1, 0, 1, 0 ) 207 DO_2D( 1, 0, 1, 0 ) ! bottom correction (partial bottom cell) 208 208 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 209 209 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) … … 229 229 ELSE ; zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 230 230 ENDIF 231 DO_2D( 1, 0, 1, 0 ) 231 DO_2D( 1, 0, 1, 0 ) !== Horizontal fluxes 232 232 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 233 233 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 250 250 END_2D 251 251 ! 252 DO_2D( 0, 0, 0, 0 ) 252 DO_2D( 0, 0, 0, 0 ) !== horizontal divergence and add to pta 253 253 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 254 254 & + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & … … 266 266 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 267 267 268 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 268 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior (2=<jk=<jpk-1) 269 269 ! 270 270 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 311 311 ENDIF 312 312 ! 313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 314 314 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) & 315 315 & / e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90
r13295 r13497 108 108 ! ! =========== ! 109 109 ! 110 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 110 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== First derivative (gradient) ==! 111 111 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) 112 112 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 113 113 END_3D 114 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level115 DO_2D( 1, 0, 1, 0 ) 114 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 115 DO_2D( 1, 0, 1, 0 ) ! bottom 116 116 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 117 117 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 118 118 END_2D 119 IF( ln_isfcav ) THEN ! top in ocean cavities only119 IF( ln_isfcav ) THEN ! top in ocean cavities only 120 120 DO_2D( 1, 0, 1, 0 ) 121 121 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) … … 125 125 ENDIF 126 126 ! 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 128 128 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 129 129 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & -
NEMO/trunk/src/OCE/TRA/traldf_triad.F90
r13295 r13497 211 211 zftv(:,:,:) = 0._wp 212 212 ! 213 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 213 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== before lateral T & S gradients at T-level jk ==! 214 214 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 215 215 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 216 216 END_3D 217 217 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 218 DO_2D( 1, 0, 1, 0 ) 218 DO_2D( 1, 0, 1, 0 ) ! bottom level 219 219 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 220 220 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) … … 361 361 ENDIF 362 362 ! 363 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 363 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Divergence of vertical fluxes added to pta ==! 364 364 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 365 365 & + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & -
NEMO/trunk/src/OCE/TRA/tramle.F90
r13295 r13497 100 100 inml_mle(:,:) = mbkt(:,:) + 1 ! init. to number of ocean w-level (T-level + 1) 101 101 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 102 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 102 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 103 103 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer 104 104 END_3D … … 110 110 zbm (:,:) = 0._wp 111 111 zn2 (:,:) = 0._wp 112 DO_3D( 1, 1, 1, 1, 1, ikmax ) 112 DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 113 113 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 114 114 zmld(ji,jj) = zmld(ji,jj) + zc … … 182 182 zpsi_vw(:,:,:) = 0._wp 183 183 ! 184 DO_3D( 1, 0, 1, 0, 2, ikmax ) 184 DO_3D( 1, 0, 1, 0, 2, ikmax ) ! start from 2 : surface value = 0 185 185 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 186 186 zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) … … 196 196 ! !== transport increased by the MLE induced transport ==! 197 197 DO jk = 1, ikmax 198 DO_2D( 1, 0, 1, 0 ) 198 DO_2D( 1, 0, 1, 0 ) ! CAUTION pu,pv must be defined at row/column i=1 / j=1 199 199 pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 200 200 pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) … … 283 283 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 284 284 z1_t2 = 1._wp / ( rn_time * rn_time ) 285 DO_2D( 0, 1, 0, 1 ) 285 DO_2D( 0, 1, 0, 1 ) ! "coriolis+ time^-1" at u- & v-points 286 286 zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 287 287 zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp -
NEMO/trunk/src/OCE/TRA/tranpc.F90
r13295 r13497 103 103 inpcc = 0 104 104 ! 105 DO_2D( 0, 0, 0, 0 ) 105 DO_2D( 0, 0, 0, 0 ) ! interior column only 106 106 ! 107 107 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points -
NEMO/trunk/src/OCE/TRA/traqsr.F90
r13333 r13497 231 231 END_2D 232 232 ! 233 ! * interior equi-partition in R-G-B depending on vertical profile of Chl233 ! !* interior equi-partition in R-G-B depending on vertical profile of Chl 234 234 DO_3D( 0, 0, 0, 0, 2, nksr + 1 ) 235 235 ze3t = e3t(ji,jj,jk-1,Kmm) … … 246 246 END_3D 247 247 ! 248 DO_3D( 0, 0, 0, 0, 1, nksr ) 248 DO_3D( 0, 0, 0, 0, 1, nksr ) !* now qsr induced heat content 249 249 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 250 250 END_3D … … 256 256 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 257 257 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 258 DO_3D( 0, 0, 0, 0, 1, nksr ) 258 DO_3D( 0, 0, 0, 0, 1, nksr ) ! solar heat absorbed at T-point in the top 400m 259 259 zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r ) 260 260 zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) … … 264 264 END SELECT 265 265 ! 266 ! !-----------------------------! 267 ! ! update to the temp. trend ! 266 268 ! !-----------------------------! 267 269 DO_3D( 0, 0, 0, 0, 1, nksr ) -
NEMO/trunk/src/OCE/TRA/trasbc.F90
r13295 r13497 129 129 END_2D 130 130 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( 0, 1, 0, 0 ) 131 DO_2D( 0, 1, 0, 0 ) !==>> add concentration/dilution effect due to constant volume cell 132 132 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 133 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 134 END_2D 134 END_2D !==>> output c./d. term 135 135 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 136 136 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) -
NEMO/trunk/src/OCE/TRA/trazdf.F90
r13295 r13497 208 208 ! used as a work space array: its value is modified. 209 209 ! 210 DO_2D( 0, 0, 0, 0 ) 210 DO_2D( 0, 0, 0, 0 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) ! done one for all passive tracers (so included in the IF instruction) 211 211 zwt(ji,jj,1) = zwd(ji,jj,1) 212 212 END_2D … … 217 217 ENDIF 218 218 ! 219 DO_2D( 0, 0, 0, 0 ) 219 DO_2D( 0, 0, 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 220 220 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) & 221 221 & + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) … … 227 227 END_3D 228 228 ! 229 DO_2D( 0, 0, 0, 0 ) 229 DO_2D( 0, 0, 0, 0 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 230 230 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 231 231 END_2D -
NEMO/trunk/src/OCE/TRA/zpshde.F90
r13295 r13497 167 167 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 168 168 ! 169 DO_2D( 1, 0, 1, 0 ) 169 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level 170 170 iku = mbku(ji,jj) 171 171 ikv = mbkv(ji,jj) … … 329 329 CALL eos( ztj, zhj, zrj ) 330 330 331 DO_2D( 1, 0, 1, 0 ) 331 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level 332 332 iku = mbku(ji,jj) 333 333 ikv = mbkv(ji,jj) … … 420 420 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 421 421 ! 422 DO_2D( 1, 0, 1, 0 ) 422 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level 423 423 iku = miku(ji,jj) 424 424 ikv = mikv(ji,jj) -
NEMO/trunk/src/OCE/TRD/trddyn.F90
r13295 r13497 124 124 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 125 125 z3dy(:,:,:) = 0._wp 126 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 126 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! no mask as un,vn are masked 127 127 z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) ) 128 128 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) -
NEMO/trunk/src/OCE/TRD/trdglo.F90
r13295 r13497 86 86 ! 87 87 CASE( 'TRA' ) !== Tracers (T & S) ==! 88 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 88 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! global sum of mask volume trend and trend*T (including interior mask) 89 89 zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 90 90 zvt = ptrdx(ji,jj,jk) * zvm … … 218 218 END_3D 219 219 220 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 220 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Density flux divergence at t-point 221 221 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 222 222 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & -
NEMO/trunk/src/OCE/TRD/trdmxl.F90
r13295 r13497 120 120 ! 121 121 wkx(:,:,:) = 0._wp !== now ML weights for vertical averaging ==! 122 DO_3D( 1, 1, 1, 1, 1, jpktrd ) 122 DO_3D( 1, 1, 1, 1, 1, jpktrd ) ! initialize wkx with vertical scale factor in mixed-layer 123 123 IF( jk - kmxln(ji,jj) < 0 ) THEN 124 124 wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) -
NEMO/trunk/src/OCE/TRD/trdtra.F90
r13295 r13497 210 210 !!---------------------------------------------------------------------- 211 211 ! 212 SELECT CASE( cdir ) ! shift depending on the direction212 SELECT CASE( cdir ) ! shift depending on the direction 213 213 CASE( 'X' ) ; ii = 1 ; ij = 0 ; ik = 0 ! i-trend 214 214 CASE( 'Y' ) ; ii = 0 ; ij = 1 ; ik = 0 ! j-trend … … 216 216 END SELECT 217 217 ! 218 ! ! set to zero uncomputed values218 ! ! set to zero uncomputed values 219 219 ptrd(jpi,:,:) = 0._wp ; ptrd(1,:,:) = 0._wp 220 220 ptrd(:,jpj,:) = 0._wp ; ptrd(:,1,:) = 0._wp 221 221 ptrd(:,:,jpk) = 0._wp 222 222 ! 223 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 223 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! advective trend 224 224 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 225 225 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & -
NEMO/trunk/src/OCE/TRD/trdvor.F90
r13295 r13497 103 103 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection 104 104 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad. 105 CASE( jpdyn_zdf ) ! Vertical Diffusion105 CASE( jpdyn_zdf ) ! Vertical Diffusion 106 106 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 107 DO_2D( 0, 0, 0, 0 ) 107 DO_2D( 0, 0, 0, 0 ) ! wind stress trends 108 108 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 109 109 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) -
NEMO/trunk/src/OCE/USR/usrdef_istate.F90
r13295 r13497 57 57 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with an horizontally uniform T and S profiles' 58 58 ! 59 pu (:,:,:) = 0._wp ! ocean at rest59 pu (:,:,:) = 0._wp ! ocean at rest 60 60 pv (:,:,:) = 0._wp 61 61 pssh(:,:) = 0._wp 62 62 ! 63 DO_3D( 1, 1, 1, 1, 1, jpk ) 63 DO_3D( 1, 1, 1, 1, 1, jpk ) ! horizontally uniform T & S profiles 64 64 pts(ji,jj,jk,jp_tem) = ( ( 16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) ) & 65 65 & * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2. & -
NEMO/trunk/src/OCE/ZDF/zdfddm.F90
r13295 r13497 94 94 !!gm and many acces in memory 95 95 96 DO_2D( 1, 1, 1, 1 ) 96 DO_2D( 1, 1, 1, 1 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 97 97 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 98 98 !!gm please, use e3w at Kmm below … … 110 110 END_2D 111 111 112 DO_2D( 1, 1, 1, 1 ) 112 DO_2D( 1, 1, 1, 1 ) !== indicators ==! 113 113 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 114 114 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp -
NEMO/trunk/src/OCE/ZDF/zdfdrg.F90
r13477 r13497 431 431 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 432 432 ! 433 DO_2D( 1, 1, 1, 1 ) 433 DO_2D( 1, 1, 1, 1 ) ! pCd0 = mask (and boosted) logarithmic drag coef. 434 434 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 435 435 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 -
NEMO/trunk/src/OCE/ZDF/zdfgls.F90
r13472 r13497 179 179 180 180 ! Compute surface, top and bottom friction at T-points 181 DO_2D( 0, 0, 0, 0 ) 181 DO_2D( 0, 0, 0, 0 ) !== surface ocean friction 182 182 ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) ! surface friction 183 183 END_2D … … 185 185 !!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that... 186 186 ! 187 IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction)188 DO_2D( 0, 0, 0, 0 ) ! bottom friction (explicit before friction)187 IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction) 188 DO_2D( 0, 0, 0, 0 ) ! bottom friction (explicit before friction) 189 189 zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 190 190 zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) … … 193 193 END_2D 194 194 IF( ln_isfcav ) THEN 195 DO_2D( 0, 0, 0, 0 ) ! top friction195 DO_2D( 0, 0, 0, 0 ) ! top friction 196 196 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 197 197 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) … … 220 220 zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1) + (1._wp - tmask(:,:,1))*rn_hsro 221 221 ! 222 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 222 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !== Compute dissipation rate ==! 223 223 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 224 224 END_3D … … 416 416 ! ---------------------------------------------------------- 417 417 ! 418 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 418 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 419 419 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 420 420 END_3D 421 DO_3D( 0, 0, 0, 0, 2, jpk ) 421 DO_3D( 0, 0, 0, 0, 2, jpk ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 422 422 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 423 423 END_3D 424 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) 424 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 425 425 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 426 426 END_3D … … 610 610 ! ---------------- 611 611 ! 612 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 612 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 613 613 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 614 614 END_3D 615 DO_3D( 0, 0, 0, 0, 2, jpk ) 615 DO_3D( 0, 0, 0, 0, 2, jpk ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 616 616 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 617 617 END_3D 618 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) 618 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 619 619 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 620 620 END_3D … … 652 652 ! Limit dissipation rate under stable stratification 653 653 ! -------------------------------------------------- 654 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 654 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time 655 655 ! limitation 656 656 eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) … … 717 717 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 718 718 zstm(:,:,jpk) = 0. 719 DO_2D( 0, 0, 0, 0 ) 719 DO_2D( 0, 0, 0, 0 ) ! update bottom with good values 720 720 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 721 721 END_2D -
NEMO/trunk/src/OCE/ZDF/zdfiwm.F90
r13417 r13497 164 164 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 165 165 ! using an exponential decay from the seafloor. 166 DO_2D( 0, 0, 0, 0 ) 166 DO_2D( 0, 0, 0, 0 ) ! part independent of the level 167 167 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 168 168 zfact(ji,jj) = rho0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) … … 170 170 END_2D 171 171 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 172 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 172 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 173 173 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 174 174 zemx_iwm(ji,jj,jk) = 0._wp … … 293 293 END_3D 294 294 ! 295 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the296 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 295 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 296 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 297 297 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 298 298 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) … … 303 303 ENDIF 304 304 ! 305 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 305 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 306 306 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) 307 307 END_3D … … 330 330 ! ! ----------------------- ! 331 331 ! 332 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature332 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 333 333 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 334 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 334 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb 335 335 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 336 336 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN … … 347 347 END_3D 348 348 ! 349 ELSE !* update momentum & tracer diffusivity with wave-driven mixing349 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 350 350 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 351 351 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) … … 355 355 ENDIF 356 356 357 ! !* output internal wave-driven mixing coefficient357 ! !* output internal wave-driven mixing coefficient 358 358 CALL iom_put( "av_wave", zav_wave ) 359 !* output useful diagnostics: Kz*N^2 ,359 !* output useful diagnostics: Kz*N^2 , 360 360 !!gm Kz*N2 should take into account the ratio avs/avt if it is used.... (see diaar5) 361 ! vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm)361 ! vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 362 362 IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 363 363 ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) -
NEMO/trunk/src/OCE/ZDF/zdfmxl.F90
r13295 r13497 96 96 ! 97 97 ! w-level of the mixing and mixed layers 98 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2100 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria101 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 98 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point 99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 100 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 101 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) ! Mixed layer level: w-level 102 102 ikt = mbkt(ji,jj) 103 103 hmlp(ji,jj) = & … … 107 107 ! 108 108 ! w-level of the turbocline and mixing layer (iom_use) 109 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point110 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 109 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 110 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 111 111 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 112 112 END_3D -
NEMO/trunk/src/OCE/ZDF/zdfosm.F90
r13295 r13497 1184 1184 ! KPP-style Ri# mixing 1185 1185 IF( ln_kpprimix) THEN 1186 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 1186 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !* Shear production at uw- and vw-points (energy conserving form) 1187 1187 z3du(ji,jj,jk) = 0.5 * ( uu(ji,jj,jk-1,Kmm) - uu(ji ,jj,jk,Kmm) ) & 1188 1188 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & … … 1516 1516 ! 1517 1517 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1518 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1518 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! Mixed layer level: w-level 1519 1519 ikt = mbkt(ji,jj) 1520 1520 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) … … 1629 1629 !code saving tracer trends removed, replace with trdmxl_oce 1630 1630 1631 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1631 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! add non-local u and v fluxes 1632 1632 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) & 1633 1633 & - ( ghamu(ji,jj,jk ) & -
NEMO/trunk/src/OCE/ZDF/zdfric.F90
r13295 r13497 160 160 ! 161 161 ! !== avm and avt = F(Richardson number) ==! 162 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 162 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri) 163 163 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) 164 164 zav = rn_avmri * zcfRi**nn_ric … … 173 173 IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==! 174 174 ! 175 DO_2D( 0, 0, 0, 0 ) 175 DO_2D( 0, 0, 0, 0 ) !* Ekman depth 176 176 zustar = SQRT( taum(ji,jj) * r1_rho0 ) 177 177 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 178 178 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 179 179 END_2D 180 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 180 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer 181 181 IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 182 182 p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk) -
NEMO/trunk/src/OCE/ZDF/zdfsh2.F90
r13295 r13497 60 60 ! 61 61 DO jk = 2, jpkm1 62 DO_2D( 1, 0, 1, 0 ) 62 DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 63 63 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 64 64 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & … … 72 72 & * wvmask(ji,jj,jk) 73 73 END_2D 74 DO_2D( 0, 0, 0, 0 ) 74 DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 75 75 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 76 76 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) -
NEMO/trunk/src/OCE/ZDF/zdftke.F90
r13472 r13497 238 238 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 239 239 ! 240 DO_2D( 0, 0, 0, 0 ) 240 DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 241 241 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 242 242 !! one way around would be to increase zbbirau … … 325 325 ! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 326 326 ! 327 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri )327 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri ) 328 328 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 329 329 ! ! local Richardson number … … 338 338 ENDIF 339 339 ! 340 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 340 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Matrix and right hand side in en 341 341 zcof = zfact1 * tmask(ji,jj,jk) 342 342 ! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical … … 358 358 END_3D 359 359 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 360 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 360 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 361 361 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 362 362 END_3D 363 DO_2D( 0, 0, 0, 0 ) 363 DO_2D( 0, 0, 0, 0 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 364 364 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 365 365 END_2D … … 367 367 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 368 368 END_3D 369 DO_2D( 0, 0, 0, 0 ) 369 DO_2D( 0, 0, 0, 0 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 370 370 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 371 371 END_2D … … 373 373 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 374 374 END_3D 375 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 375 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! set the minimum value of tke 376 376 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 377 377 END_3D … … 396 396 END_2D 397 397 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 398 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 398 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF 399 399 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 400 400 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) … … 470 470 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 471 471 #if ! defined key_si3 && ! defined key_cice 472 DO_2D( 0, 0, 0, 0 ) 472 DO_2D( 0, 0, 0, 0 ) ! No sea-ice 473 473 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 474 474 END_2D … … 481 481 END_2D 482 482 ! 483 CASE( 1 ) 483 CASE( 1 ) ! scaling with constant sea-ice thickness 484 484 DO_2D( 0, 0, 0, 0 ) 485 485 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & … … 487 487 END_2D 488 488 ! 489 CASE( 2 ) 489 CASE( 2 ) ! scaling with mean sea-ice thickness 490 490 DO_2D( 0, 0, 0, 0 ) 491 491 #if defined key_si3 … … 499 499 END_2D 500 500 ! 501 CASE( 3 ) 501 CASE( 3 ) ! scaling with max sea-ice thickness 502 502 DO_2D( 0, 0, 0, 0 ) 503 503 zmaxice = MAXVAL( h_i(ji,jj,:) ) … … 551 551 ! 552 552 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 553 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 553 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : 554 554 zmxlm(ji,jj,jk) = & 555 555 & MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 556 556 END_3D 557 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 557 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : 558 558 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 559 559 zmxlm(ji,jj,jk) = zemxl … … 562 562 ! 563 563 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 564 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 564 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : lup 565 565 zmxld(ji,jj,jk) = & 566 566 & MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 567 567 END_3D 568 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 568 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown 569 569 zmxlm(ji,jj,jk) = & 570 570 & MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) … … 582 582 ! ! Vertical eddy viscosity and diffusivity (avm and avt) 583 583 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 584 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 584 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points 585 585 zsqen = SQRT( en(ji,jj,jk) ) 586 586 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen … … 591 591 ! 592 592 ! 593 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt593 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 594 594 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 595 595 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) -
NEMO/trunk/src/OFF/dtadyn.F90
r13377 r13497 412 412 ENDIF 413 413 END_2D 414 !!st pourquoi on n'utilise pas le gde3w ici plutôt que de faire une boucle ? 415 DO_2D( 1, 1, 1, 1 ) 414 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 416 415 h_rnf(ji,jj) = 0._wp 417 416 DO jk = 1, nk_rnf(ji,jj) … … 688 687 !!---------------------------------------------------------------------- 689 688 ! 690 !!st code dupliqué même remarque que plus haut pourquoi ne pas utiliser gdepw ? 691 DO_2D( 1, 1, 1, 1 ) 689 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 692 690 h_rnf(ji,jj) = 0._wp 693 691 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres -
NEMO/trunk/src/TOP/C14/trcatm_c14.F90
r13295 r13497 120 120 IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 121 121 ! 122 DO_2D( 1, 1, 1, 1 ) 122 DO_2D( 1, 1, 1, 1 ) ! from C14b package 123 123 IF( gphit(ji,jj) >= yn40 ) THEN 124 124 fareaz(ji,jj,1) = 0. -
NEMO/trunk/src/TOP/CFC/trcsms_cfc.F90
r13295 r13497 126 126 127 127 ! !------------! 128 DO_2D( 1, 1, 1, 1 ) 129 128 DO_2D( 1, 1, 1, 1 ) ! i-j loop ! 129 ! !------------! 130 130 ! space interpolation 131 131 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zopt.F90
r13295 r13497 95 95 ! ! Photosynthetically Available Radiation (PAR) 96 96 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 97 DO_3D( 1, 1, 1, 1, 2, jpk ) 97 DO_3D( 1, 1, 1, 1, 2, jpk ) ! local par at w-levels 98 98 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef ) 99 99 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 102 102 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 103 103 END_3D 104 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 104 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! mean par at t-levels 105 105 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 106 106 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 114 114 ! ! -------------- 115 115 neln(:,:) = 1 ! euphotic layer level 116 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 116 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! (i.e. 1rst T-level strictly below EL bottom) 117 117 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 118 118 END_3D -
NEMO/trunk/src/TOP/TRP/trdmxl_trc.F90
r13295 r13497 148 148 ! ... Weights for vertical averaging 149 149 wkx_trc(:,:,:) = 0.e0 150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) ! initialize wkx_trc with vertical scale factor in mixed-layer 151 151 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 152 152 END_3D -
NEMO/trunk/src/TOP/trcdta.F90
r13295 r13497 199 199 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 200 200 ENDIF 201 DO_2D( 1, 1, 1, 1 ) 201 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 202 202 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 203 203 zl = gdept(ji,jj,jk,Kmm)
Note: See TracChangeset
for help on using the changeset viewer.
