Changeset 13982 for NEMO/trunk/src/OCE/TRA/traadv_ubs.F90
- Timestamp:
- 2020-12-02T11:57:05+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/TRA/traadv_ubs.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/TRA/traadv_ubs.F90
r13497 r13982 92 92 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 93 93 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 94 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 94 95 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 95 96 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 99 100 REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - 100 101 REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace 102 !!---------------------------------------------------------------------- 103 ! 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 102 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: ztu, ztv, zltu, zltv, zti, ztw ! 3D workspace 103 !!---------------------------------------------------------------------- 104 ! 105 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 106 IF( kt == kit000 ) THEN 107 IF(lwp) WRITE(numout,*) 108 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype 109 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 110 ENDIF 111 ! 112 l_trd = .FALSE. 113 l_hst = .FALSE. 114 l_ptr = .FALSE. 115 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 116 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 117 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 118 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 108 119 ENDIF 109 !110 l_trd = .FALSE.111 l_hst = .FALSE.112 l_ptr = .FALSE.113 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.114 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.115 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &116 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.117 120 ! 118 121 ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers 119 122 zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp 120 123 ztw (:,:,jpk) = 0._wp ; zti (:,:,jpk) = 0._wp 121 !122 124 ! ! =========== 123 125 DO jn = 1, kjpt ! tracer loop … … 125 127 ! 126 128 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==! 127 DO_2D( 1, 0, 1, 0) ! First derivative (masked gradient)129 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! First derivative (masked gradient) 128 130 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 129 131 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) … … 131 133 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 132 134 END_2D 133 DO_2D( 0, 0, 0, 0) ! Second derivative (divergence)135 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Second derivative (divergence) 134 136 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 135 137 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef … … 138 140 ! 139 141 END DO 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)142 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 141 143 ! 142 144 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS) … … 153 155 END_3D 154 156 ! 155 zltu(:,:,:) = pt(:,:,:,jn,Krhs) ! store the initial trends before its update 157 DO_3D( 1, 1, 1, 1, 1, jpk ) 158 zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) ! store the initial trends before its update 159 END_3D 156 160 ! 157 161 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! … … 165 169 END DO 166 170 ! 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) 169 ! 171 DO_3D( 1, 1, 1, 1, 1, jpk ) 172 zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk) ! Horizontal advective trend used in vertical 2nd order FCT case 173 END_3D ! and/or in trend diagnostic (l_trd=T) 174 ! 170 175 IF( l_trd ) THEN ! trend diagnostics 171 176 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) ) … … 185 190 CASE( 2 ) ! 2nd order FCT 186 191 ! 187 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 192 IF( l_trd ) THEN 193 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 194 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 195 END_3D 196 ENDIF 188 197 ! 189 198 ! !* upstream advection with initial mass fluxes & intermediate update ==! … … 199 208 END_2D 200 209 ELSE ! no cavities: only at the ocean surface 201 ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 210 DO_2D( 1, 1, 1, 1 ) 211 ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 212 END_2D 202 213 ENDIF 203 214 ENDIF … … 209 220 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 210 221 END_3D 211 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp ) ! Lateral boundary conditions on zti, zsi (unchanged sign)212 222 ! 213 223 ! !* anti-diffusive flux : high order minus low order … … 226 236 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 227 237 END_3D 228 IF( ln_linssh ) ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 238 IF( ln_linssh ) THEN 239 DO_2D( 1, 1, 1, 1 ) 240 ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 241 END_2D 242 ENDIF 229 243 ! 230 244 END SELECT … … 262 276 !! in-space based differencing for fluid 263 277 !!---------------------------------------------------------------------- 264 INTEGER , INTENT(in ) 265 REAL(wp), INTENT(in ) 266 REAL(wp), DIMENSION 267 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field268 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: pcc ! monotonic flux in the k direction278 INTEGER , INTENT(in ) :: Kmm ! time level index 279 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 280 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pbef ! before field 281 REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: paft ! after field 282 REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: pcc ! monotonic flux in the k direction 269 283 ! 270 284 INTEGER :: ji, jj, jk ! dummy loop indices 271 285 INTEGER :: ikm1 ! local integer 272 286 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 273 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zbetup, zbetdo! 3D workspace287 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace 274 288 !!---------------------------------------------------------------------- 275 289 ! … … 281 295 ! -------------------- 282 296 ! ! large negative value (-zbig) inside land 283 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 284 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 297 DO_3D( 0, 0, 0, 0, 1, jpk ) 298 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 299 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) ) 300 END_3D 285 301 ! 286 302 DO jk = 1, jpkm1 ! search maximum in neighbourhood … … 293 309 END DO 294 310 ! ! large positive value (+zbig) inside land 295 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 296 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 311 DO_3D( 0, 0, 0, 0, 1, jpk ) 312 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 313 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) ) 314 END_3D 297 315 ! 298 316 DO jk = 1, jpkm1 ! search minimum in neighbourhood … … 305 323 END DO 306 324 ! ! restore masked values to zero 307 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) 308 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) 325 DO_3D( 0, 0, 0, 0, 1, jpk ) 326 pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) 327 paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) 328 END_3D 309 329 ! 310 330 ! Positive and negative part of fluxes and beta terms
Note: See TracChangeset
for help on using the changeset viewer.
