- Timestamp:
- 2020-09-29T12:41:06+02:00 (3 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
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/TRA/traadv_ubs.F90
r12377 r13540 39 39 !! * Substitutions 40 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 82 83 !! 83 84 !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 84 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731 Ð1741.85 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731�1741. 85 86 !!---------------------------------------------------------------------- 86 87 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 123 124 ! ! =========== 124 125 ! 125 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==!126 DO_2D _10_10126 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==! 127 DO_2D( 1, 0, 1, 0 ) ! First derivative (masked gradient) 127 128 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 128 129 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) … … 130 131 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 131 132 END_2D 132 DO_2D _00_00133 DO_2D( 0, 0, 0, 0 ) ! Second derivative (divergence) 133 134 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 134 135 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef … … 137 138 ! 138 139 END DO 139 CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1. ) ; CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.) ! Lateral boundary cond. (unchanged sgn)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) 140 141 ! 141 DO_3D _10_10( 1, jpkm1)142 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) 143 144 zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 144 145 zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) … … 155 156 ! 156 157 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! 157 DO_2D _00_00158 DO_2D( 0, 0, 0, 0 ) 158 159 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 159 160 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 160 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 161 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) & 162 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 161 163 END_2D 162 164 ! … … 164 166 ! 165 167 zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case 166 ! ! and/or in trend diagnostic (l_trd=T)168 ! ! and/or in trend diagnostic (l_trd=T) 167 169 ! 168 170 IF( l_trd ) THEN ! trend diagnostics … … 185 187 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 186 188 ! 187 ! !* upstream advection with initial mass fluxes & intermediate update ==!188 DO_3D _11_11(2, jpkm1 )189 ! !* upstream advection with initial mass fluxes & intermediate update ==! 190 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 189 191 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 190 192 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 191 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) 192 194 END_3D 193 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked)194 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface195 DO_2D _11_11195 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 DO_2D( 1, 1, 1, 1 ) 196 198 ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 197 199 END_2D 198 ELSE ! no cavities: only at the ocean surface200 ELSE ! no cavities: only at the ocean surface 199 201 ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 200 202 ENDIF 201 203 ENDIF 202 204 ! 203 DO_3D_00_00( 1, jpkm1 ) 204 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme 206 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 205 208 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztak 206 209 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 207 210 END_3D 208 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1. ) ! Lateral boundary conditions on zti, zsi (unchanged sign)211 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp ) ! Lateral boundary conditions on zti, zsi (unchanged sign) 209 212 ! 210 213 ! !* anti-diffusive flux : high order minus low order 211 DO_3D _11_11(2, jpkm1 )214 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 212 215 ztw(ji,jj,jk) = ( 0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 213 216 & - ztw(ji,jj,jk) ) * wmask(ji,jj,jk) … … 220 223 CASE( 4 ) ! 4th order COMPACT 221 224 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point 222 DO_3D _00_00(2, jpkm1 )225 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 223 226 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 224 227 END_3D … … 227 230 END SELECT 228 231 ! 229 DO_3D_00_00( 1, jpkm1 ) 230 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 232 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! final trend with corrected fluxes 233 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 234 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 231 235 END_3D 232 236 ! 233 IF( l_trd ) THEN ! vertical advective trend diagnostics234 DO_3D _00_00( 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]) 235 239 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 236 240 & + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) & … … 270 274 !!---------------------------------------------------------------------- 271 275 ! 272 zbig = 1.e+ 40_wp276 zbig = 1.e+38_wp 273 277 zrtrn = 1.e-15_wp 274 278 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp … … 282 286 DO jk = 1, jpkm1 ! search maximum in neighbourhood 283 287 ikm1 = MAX(jk-1,1) 284 DO_2D _00_00288 DO_2D( 0, 0, 0, 0 ) 285 289 zbetup(ji,jj,jk) = MAX( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 286 290 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 294 298 DO jk = 1, jpkm1 ! search minimum in neighbourhood 295 299 ikm1 = MAX(jk-1,1) 296 DO_2D _00_00300 DO_2D( 0, 0, 0, 0 ) 297 301 zbetdo(ji,jj,jk) = MIN( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 298 302 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 306 310 ! Positive and negative part of fluxes and beta terms 307 311 ! --------------------------------------------------- 308 DO_3D _00_00(1, jpkm1 )312 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 309 313 ! positive & negative part of the flux 310 314 zpos = MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) ) … … 318 322 ! monotonic flux in the k direction, i.e. pcc 319 323 ! ------------------------------------------- 320 DO_3D _00_00(2, jpkm1 )324 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 321 325 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 322 326 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 323 zc = 0.5 * ( 1.e0 + SIGN( 1. e0, pcc(ji,jj,jk) ) )327 zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) ) 324 328 pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 325 329 END_3D
Note: See TracChangeset
for help on using the changeset viewer.