- Timestamp:
- 2020-11-27T15:42:26+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90
r13819 r13898 92 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 93 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 94 ! NOTE: [tiling-comms-merge] These were changed to INTENT(inout) but they are not modified, so it is reverted 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 … … 109 110 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 110 111 ENDIF 111 !112 112 ! 113 113 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme … … 146 146 ! 147 147 !!gm why not using a SHIFT instruction... 148 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask148 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask 149 149 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 150 150 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 151 151 END_3D 152 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions152 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 153 153 154 154 ! 155 155 ! Horizontal advective fluxes 156 156 ! --------------------------- 157 DO_3D( 0, 0, 0, 0, 1, jpkm1 )157 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 158 158 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 159 159 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 160 160 END_3D 161 161 ! 162 DO_3D( 0, 0, 0, 0, 1, jpkm1 )162 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 163 163 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 164 164 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 168 168 END_3D 169 169 !--- Lateral boundary conditions 170 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp )170 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp ) 171 171 172 172 !--- QUICKEST scheme … … 174 174 ! 175 175 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 176 DO_3D( 0, 0, 0, 0, 1, jpkm1 )176 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 177 177 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 178 178 END_3D 179 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions179 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 180 180 181 181 ! 182 182 ! Tracer flux on the x-direction 183 DO jk = 1, jpkm1 184 ! 185 DO_2D( 0, 0, 0, 0 ) 186 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 187 !--- If the second ustream point is a land point 188 !--- the flux is computed by the 1st order UPWIND scheme 189 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 190 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 191 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk) 192 END_2D 193 END DO 194 ! 195 CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 183 DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 184 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 185 !--- If the second ustream point is a land point 186 !--- the flux is computed by the 1st order UPWIND scheme 187 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 188 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 189 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk) 190 END_3D 196 191 ! 197 192 ! Computation of the trend … … 238 233 ! 239 234 !--- Computation of the ustream and downstream value of the tracer and the mask 240 DO_2D( 0, 0, 0, 0 )235 DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 241 236 ! Upstream in the x-direction for the tracer 242 237 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) … … 245 240 END_2D 246 241 END DO 247 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions242 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 248 243 249 244 … … 252 247 ! --------------------------- 253 248 ! 254 DO_3D( 0, 0, 0, 0, 1, jpkm1 )249 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 255 250 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 256 251 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 257 252 END_3D 258 253 ! 259 DO_3D( 0, 0, 0, 0, 1, jpkm1 )254 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 260 255 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 261 256 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 266 261 267 262 !--- Lateral boundary conditions 268 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )263 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 269 264 270 265 !--- QUICKEST scheme … … 272 267 ! 273 268 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 274 DO_3D( 0, 0, 0, 0, 1, jpkm1 )269 DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 275 270 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 276 271 END_3D 277 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions272 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions 278 273 ! 279 274 ! Tracer flux on the x-direction 280 DO jk = 1, jpkm1 281 ! 282 DO_2D( 0, 0, 0, 0 ) 283 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 284 !--- If the second ustream point is a land point 285 !--- the flux is computed by the 1st order UPWIND scheme 286 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 287 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 288 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk) 289 END_2D 290 END DO 291 ! 292 CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 275 DO_3D( 1, 0, 0, 0, 1, jpkm1 ) 276 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 277 !--- If the second ustream point is a land point 278 !--- the flux is computed by the 1st order UPWIND scheme 279 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 280 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 281 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk) 282 END_3D 293 283 ! 294 284 ! Computation of the trend … … 338 328 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 339 329 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 340 DO_2D( 1, 1, 1, 1)330 DO_2D( 0, 0, 0, 0 ) 341 331 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 342 332 END_2D 343 333 ELSE ! no ocean cavities (only ocean surface) 344 DO_2D( 1, 1, 1, 1)334 DO_2D( 0, 0, 0, 0 ) 345 335 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 346 336 END_2D … … 377 367 !---------------------------------------------------------------------- 378 368 ! 379 DO_3D( 1, 1, 1, 1, 1, jpkm1 )369 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 380 370 zc = puc(ji,jj,jk) ! Courant number 381 371 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.
