Changeset 13660 for NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_qck.F90
- Timestamp:
- 2020-10-22T12:47:32+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_qck.F90
r13497 r13660 91 91 INTEGER , INTENT(in ) :: kjpt ! number of tracers 92 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: pU, pV, pW ! 3 ocean volume transport components 94 94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 95 95 !!---------------------------------------------------------------------- … … 106 106 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 107 107 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 108 !109 108 ! 110 109 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme … … 142 141 ! 143 142 !!gm why not using a SHIFT instruction... 144 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask143 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 145 144 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 145 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 147 146 END_3D 148 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions147 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 149 148 150 149 ! 151 150 ! Horizontal advective fluxes 152 151 ! --------------------------- 153 DO_3D( 0, 0, 0, 0, 1, jpkm1 )152 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 154 153 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 155 154 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 156 155 END_3D 157 156 ! 158 DO_3D( 0, 0, 0, 0, 1, jpkm1 )157 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 159 158 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 160 159 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 164 163 END_3D 165 164 !--- Lateral boundary conditions 166 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 )165 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 ) 167 166 168 167 !--- QUICKEST scheme … … 170 169 ! 171 170 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 172 DO_3D( 0, 0, 0, 0, 1, jpkm1 )171 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 173 172 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 174 173 END_3D 175 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions174 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 176 175 177 176 ! … … 179 178 DO jk = 1, jpkm1 180 179 ! 181 DO_2D( 0, 0, 0, 0 )180 DO_2D( 0, 0, 1, 0 ) 182 181 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 183 182 !--- If the second ustream point is a land point … … 188 187 END_2D 189 188 END DO 190 !191 CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions192 189 ! 193 190 ! Computation of the trend … … 233 230 ! 234 231 !--- Computation of the ustream and downstream value of the tracer and the mask 235 DO_2D( 0, 0, 0, 0 )232 DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 236 233 ! Upstream in the x-direction for the tracer 237 234 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) … … 240 237 END_2D 241 238 END DO 242 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions239 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 243 240 244 241 … … 247 244 ! --------------------------- 248 245 ! 249 DO_3D( 0, 0, 0, 0, 1, jpkm1 )246 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 250 247 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 251 248 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 252 249 END_3D 253 250 ! 254 DO_3D( 0, 0, 0, 0, 1, jpkm1 )251 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 255 252 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 256 253 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 261 258 262 259 !--- Lateral boundary conditions 263 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 )260 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 ) 264 261 265 262 !--- QUICKEST scheme … … 267 264 ! 268 265 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 269 DO_3D( 0, 0, 0, 0, 1, jpkm1 )266 DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 270 267 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 271 268 END_3D 272 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions269 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions 273 270 ! 274 271 ! Tracer flux on the x-direction 275 272 DO jk = 1, jpkm1 276 273 ! 277 DO_2D( 0, 0, 0, 0 )274 DO_2D( 1, 0, 0, 0 ) 278 275 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 279 276 !--- If the second ustream point is a land point … … 285 282 END DO 286 283 ! 287 CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions288 !289 284 ! Computation of the trend 290 285 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) … … 332 327 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 333 328 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 334 DO_2D( 1, 1, 1, 1)329 DO_2D( 0, 0, 0, 0 ) 335 330 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 336 331 END_2D 337 332 ELSE ! no ocean cavities (only ocean surface) 338 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 333 DO_2D( 0, 0, 0, 0 ) 334 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 335 END_2D 339 336 ENDIF 340 337 ENDIF … … 369 366 !---------------------------------------------------------------------- 370 367 ! 371 DO_3D( 1, 1, 1, 1, 1, jpkm1 )368 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 372 369 zc = puc(ji,jj,jk) ! Courant number 373 370 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.
