- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/traadv_ubs.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/TRA/traadv_ubs.F90
r13237 r13899 124 124 ! ! =========== 125 125 ! 126 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==!127 DO_2D _10_10126 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 _00_00133 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 _10_10( 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) ) … … 156 156 ! 157 157 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! 158 DO_2D _00_00158 DO_2D( 0, 0, 0, 0 ) 159 159 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 160 160 & - ( ztu(ji,jj,jk) - ztu(ji-1,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 ==!190 DO_3D _11_11(2, jpkm1 )189 ! !* upstream advection with initial mass fluxes & intermediate update ==! 190 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 191 191 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 192 192 zfm_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 surface197 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 ) 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 _00_00( 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) … … 212 212 ! 213 213 ! !* anti-diffusive flux : high order minus low order 214 DO_3D _11_11(2, jpkm1 )214 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 215 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) ) & 216 216 & - ztw(ji,jj,jk) ) * wmask(ji,jj,jk) … … 223 223 CASE( 4 ) ! 4th order COMPACT 224 224 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point 225 DO_3D _00_00(2, jpkm1 )225 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 226 226 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 227 227 END_3D … … 230 230 END SELECT 231 231 ! 232 DO_3D _00_00( 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 _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]) 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) ) & … … 286 286 DO jk = 1, jpkm1 ! search maximum in neighbourhood 287 287 ikm1 = MAX(jk-1,1) 288 DO_2D _00_00288 DO_2D( 0, 0, 0, 0 ) 289 289 zbetup(ji,jj,jk) = MAX( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 290 290 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 298 298 DO jk = 1, jpkm1 ! search minimum in neighbourhood 299 299 ikm1 = MAX(jk-1,1) 300 DO_2D _00_00300 DO_2D( 0, 0, 0, 0 ) 301 301 zbetdo(ji,jj,jk) = MIN( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 302 302 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 310 310 ! Positive and negative part of fluxes and beta terms 311 311 ! --------------------------------------------------- 312 DO_3D _00_00(1, jpkm1 )312 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 313 313 ! positive & negative part of the flux 314 314 zpos = MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) ) … … 322 322 ! monotonic flux in the k direction, i.e. pcc 323 323 ! ------------------------------------------- 324 DO_3D _00_00(2, jpkm1 )324 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 325 325 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 326 326 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
Note: See TracChangeset
for help on using the changeset viewer.
