Changeset 13898 for NEMO/branches
- Timestamp:
- 2020-11-27T15:42:26+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src
- Files:
-
- 25 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/dtatsd.F90
r13819 r13898 197 197 ENDIF 198 198 ! 199 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 199 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case, but did not work in the zco case 200 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 200 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 201 202 zl = gdept_0(ji,jj,jk) … … 232 233 ! 233 234 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 234 DO_2D( 1, 1, 1, 1 ) 235 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 236 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 235 237 ik = mbkt(ji,jj) 236 238 IF( ik > 1 ) THEN -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldfc1d_c2d.F90
r13553 r13898 140 140 END_2D 141 141 CASE( 'TRA' ) ! U- and V-points 142 DO_2D( 1, 1, 1, 1 ) 142 ! NOTE: [tiling-comms-merge] Change needed to preserve results with respect to the trunk 143 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 143 144 pah1(ji,jj,1) = pUfac * MAX( e1u(ji,jj), e2u(ji,jj) )**knn 144 145 pah2(ji,jj,1) = pUfac * MAX( e1v(ji,jj), e2v(ji,jj) )**knn -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r13819 r13898 427 427 zaht_min = 0.2_wp * aht0 ! minimum value for aht 428 428 zDaht = aht0 - zaht_min 429 DO_2D( 1, 1, 1, 1 ) 429 ! NOTE: [tiling-comms-merge] Change needed to preserve results with respect to the trunk 430 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 430 431 !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg) 431 432 !! ==>>> The Coriolis value is identical for t- & u_points, and for v- and f-points -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/SBC/sbcflx.F90
r13553 r13898 127 127 128 128 IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle 129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask( ji,jj,1)129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 130 130 ELSE 131 131 DO_2D( 0, 0, 0, 0 ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90
r13819 r13898 250 250 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 251 251 ! 252 DO_3D( 1, 1, 1, 1, 1, jpkm1 )252 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 253 253 ! 254 254 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 286 286 CASE( np_seos ) !== simplified EOS ==! 287 287 ! 288 DO_3D( 1, 1, 1, 1, 1, jpkm1 )288 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 289 289 zt = pts (ji,jj,jk,jp_tem) - 10._wp 290 290 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 363 363 END DO 364 364 ! 365 DO_3D( 1, 1, 1, 1, 1, jpkm1 )365 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 366 366 ! 367 367 ! compute density (2*nn_sto_eos) times: … … 413 413 ! Non-stochastic equation of state 414 414 ELSE 415 DO_3D( 1, 1, 1, 1, 1, jpkm1 )415 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 416 416 ! 417 417 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 451 451 CASE( np_seos ) !== simplified EOS ==! 452 452 ! 453 DO_3D( 1, 1, 1, 1, 1, jpkm1 )453 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 454 454 zt = pts (ji,jj,jk,jp_tem) - 10._wp 455 455 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 518 518 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 519 519 ! 520 DO_2D( 1, 1, 1, 1)520 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 521 521 ! 522 522 zh = pdep(ji,jj) * r1_Z0 ! depth … … 553 553 CASE( np_seos ) !== simplified EOS ==! 554 554 ! 555 DO_2D( 1, 1, 1, 1)555 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 556 556 ! 557 557 zt = pts (ji,jj,jp_tem) - 10._wp … … 612 612 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 613 613 ! 614 DO_3D( 1, 1, 1, 1, 1, jpkm1 )614 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 615 615 ! 616 616 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth … … 665 665 CASE( np_seos ) !== simplified EOS ==! 666 666 ! 667 DO_3D( 1, 1, 1, 1, 1, jpkm1 )667 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 668 668 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 669 669 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) … … 731 731 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 732 732 ! 733 DO_2D( 1, 1, 1, 1)733 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 734 734 ! 735 735 zh = pdep(ji,jj) * r1_Z0 ! depth … … 784 784 CASE( np_seos ) !== simplified EOS ==! 785 785 ! 786 DO_2D( 1, 1, 1, 1)786 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 787 787 ! 788 788 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) … … 946 946 IF( ln_timing ) CALL timing_start('bn2') 947 947 ! 948 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90948 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 949 949 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 950 950 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90
r13819 r13898 120 120 ! !== effective transport ==! 121 121 IF( ln_wave .AND. ln_sdw ) THEN 122 DO_3D( 1, 1, 1, 1, 1, jpkm1 )122 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 123 123 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 124 124 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) … … 126 126 END_3D 127 127 ELSE 128 DO_3D( 1, 1, 1, 1, 1, jpkm1 )128 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 129 129 zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) ! eulerian transport only 130 130 zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) … … 134 134 ! 135 135 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 136 DO_3D( 1, 1, 1, 1, 1, jpkm1 )136 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 137 137 zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 138 138 zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) … … 140 140 ENDIF 141 141 ! 142 DO_2D( 1, 1, 1, 1)142 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 143 143 zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom 144 144 zvv(ji,jj,jpk) = 0._wp … … 173 173 ENDIF 174 174 ! 175 ! NOTE: [tiling-comms-merge] These lbc_lnk calls are still needed (pts in the zco case because zps_hde is not called in step, zuu/zvv/zww in all cases, I think because DO loop bounds need to be updated in DYN as done in TRA) 175 176 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 176 177 ! … … 178 179 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 179 180 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 181 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 182 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 180 183 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 181 184 CASE ( np_MUS ) ! MUSCL 185 ! NOTE: [tiling-comms-merge] I added this lbc_lnk as it did not validate against the trunk when using ln_zco 186 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 182 187 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 183 188 CASE ( np_UBS ) ! UBS 189 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 184 190 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 185 191 CASE ( np_QCK ) ! QUICKEST 192 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 193 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF 186 194 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 187 195 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90
r13819 r13898 115 115 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 116 116 ztv(:,:,jpk) = 0._wp 117 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! masked gradient117 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! masked gradient 118 118 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 119 119 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 120 120 END_3D 121 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond.121 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 122 122 ! 123 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes123 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) ! Horizontal advective fluxes 124 124 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2) 125 125 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 131 131 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v 132 132 END_3D 133 CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )133 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 134 134 ! 135 135 CASE DEFAULT -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90
r13819 r13898 80 80 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 81 81 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 82 ! NOTE: [tiling-comms-merge] These were changed to INTENT(inout) but they are not modified, so it is reverted 82 83 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 83 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 99 100 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 100 101 ENDIF 101 !! -- init to 0 102 zwi(:,:,:) = 0._wp 103 zwx(:,:,:) = 0._wp 104 zwy(:,:,:) = 0._wp 105 zwz(:,:,:) = 0._wp 106 ztu(:,:,:) = 0._wp 107 ztv(:,:,:) = 0._wp 108 zltu(:,:,:) = 0._wp 109 zltv(:,:,:) = 0._wp 110 ztw(:,:,:) = 0._wp 102 ! NOTE: [tiling-comms-merge] Bug fix- move array zeroing out of this IF block 111 103 ! 112 104 l_trd = .FALSE. ! set local switches … … 120 112 ! 121 113 ENDIF 114 !! -- init to 0 115 zwi(:,:,:) = 0._wp 116 zwx(:,:,:) = 0._wp 117 zwy(:,:,:) = 0._wp 118 zwz(:,:,:) = 0._wp 119 ztu(:,:,:) = 0._wp 120 ztv(:,:,:) = 0._wp 121 zltu(:,:,:) = 0._wp 122 zltv(:,:,:) = 0._wp 123 ztw(:,:,:) = 0._wp 122 124 ! 123 125 IF( l_trd .OR. l_hst ) THEN … … 130 132 zptry(:,:,:) = 0._wp 131 133 ENDIF 132 ! ! surface & bottom value : flux set to zero one for all133 zwz(:,:, 1 ) = 0._wp134 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp135 !136 zwi(:,:,:) = 0._wp137 134 ! 138 135 ! If adaptive vertical advection, check if it is needed on this PE at this time … … 143 140 IF( ll_zAimp ) THEN 144 141 ALLOCATE(zwdia(A2D(nn_hls),jpk), zwinf(A2D(nn_hls),jpk), zwsup(A2D(nn_hls),jpk)) 145 DO_3D( 0, 0, 0, 0, 1, jpkm1 )142 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 146 143 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & 147 144 & / e3t(ji,jj,jk,Krhs) … … 155 152 ! !== upstream advection with initial mass fluxes & intermediate update ==! 156 153 ! !* upstream tracer flux in the i and j direction 157 DO_3D( 1, 0, 1, 0, 1, jpkm1 )154 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 158 155 ! upstream scheme 159 156 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) … … 182 179 ENDIF 183 180 ! 184 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme181 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme 185 182 ! ! total intermediate advective trends 186 183 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 198 195 ! 199 196 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 200 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask)197 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 201 198 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 202 199 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 222 219 ! 223 220 CASE( 2 ) !- 2nd order centered 224 DO_3D( 1, 0, 1, 0, 1, jpkm1 )221 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 225 222 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 226 223 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) … … 242 239 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 243 240 ! 244 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! Horizontal advective fluxes241 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 245 242 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 246 243 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 257 254 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 258 255 END_3D 259 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)260 256 ! 261 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 269 265 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 270 266 END_3D 267 CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 271 268 ! 272 269 END SELECT … … 275 272 ! 276 273 CASE( 2 ) !- 2nd order centered 277 DO_3D( 0, 0, 0, 0, 2, jpkm1 )274 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 278 275 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 279 276 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) … … 282 279 CASE( 4 ) !- 4th order COMPACT 283 280 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 284 DO_3D( 0, 0, 0, 0, 2, jpkm1 )281 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 285 282 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 286 283 END_3D … … 290 287 zwz(:,:,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 291 288 ENDIF 292 ! 289 ! 290 IF (nn_hls.EQ.1) THEN 291 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 292 ELSE 293 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 294 END IF 295 ! 293 296 IF ( ll_zAimp ) THEN 294 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme297 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme 295 298 ! ! total intermediate advective trends 296 299 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 297 300 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 298 301 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 299 ztw(ji,jj,jk) 302 ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 300 303 END_3D 301 304 ! 302 305 CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 303 306 ! 304 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask)307 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 305 308 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 306 309 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 307 zwz(ji,jj,jk) = 310 zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk) 308 311 END_3D 309 312 END IF 310 !311 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'W', 1.0_wp )312 313 ! 313 314 ! !== monotonicity algorithm ==! … … 338 339 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 339 340 END_3D 340 END IF 341 ! 341 END IF 342 ! NOTE: [tiling-comms-merge] I tested this 343 ! NOT TESTED - NEED l_trd OR l_hst TRUE 342 344 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics // heat/salt transport 343 345 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< add anti-diffusive fluxes … … 354 356 ! 355 357 ENDIF 358 ! NOTE: [tiling-comms-merge] I tested this 359 ! NOT TESTED - NEED l_ptr TRUE 356 360 IF( l_ptr ) THEN ! "Poleward" transports 357 361 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< add anti-diffusive fluxes … … 407 411 ! -------------------- 408 412 ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 409 DO_3D( 1, 1, 1, 1, 1, jpk )413 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 410 414 zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ), & 411 415 & paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ) ) … … 416 420 DO jk = 1, jpkm1 417 421 ikm1 = MAX(jk-1,1) 418 DO_2D( 0, 0, 0, 0)422 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 419 423 420 424 ! search maximum in neighbourhood … … 446 450 END_2D 447 451 END DO 448 CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)452 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 449 453 450 454 ! 3. monotonic flux in the i & j direction (paa & pbb) 451 455 ! ---------------------------------------- 452 DO_3D( 0, 0, 0, 0, 1, jpkm1 )456 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 453 457 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 454 458 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) … … 468 472 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 469 473 END_3D 470 CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign)471 474 ! 472 475 END SUBROUTINE nonosc … … 553 556 ! !== build the three diagonal matrix & the RHS ==! 554 557 ! 555 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) ! interior (from jk=3 to jpk-1)558 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) ! interior (from jk=3 to jpk-1) 556 559 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 557 560 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal … … 572 575 END IF 573 576 ! 574 DO_2D( 0, 0, 0, 0) ! 2nd order centered at top & bottom577 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2nd order centered at top & bottom 575 578 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 576 579 ikb = MAX(mbkt(ji,jj), 2) ! - above the last wet point … … 589 592 ! !== tridiagonal solver ==! 590 593 ! 591 DO_2D( 0, 0, 0, 0) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1594 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 592 595 zwt(ji,jj,2) = zwd(ji,jj,2) 593 596 END_2D 594 DO_3D( 0, 0, 0, 0, 3, jpkm1 )597 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 595 598 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 596 599 END_3D 597 600 ! 598 DO_2D( 0, 0, 0, 0) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1601 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 599 602 pt_out(ji,jj,2) = zwrm(ji,jj,2) 600 603 END_2D 601 DO_3D( 0, 0, 0, 0, 3, jpkm1 )604 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 602 605 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 603 606 END_3D 604 607 605 DO_2D( 0, 0, 0, 0) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk608 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 606 609 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 607 610 END_2D 608 DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 )611 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 609 612 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 610 613 END_3D … … 645 648 kstart = 1 + klev 646 649 ! 647 DO_2D( 0, 0, 0, 0) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1650 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 648 651 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 649 652 END_2D 650 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 )653 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 651 654 zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 652 655 END_3D 653 656 ! 654 DO_2D( 0, 0, 0, 0) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1657 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 655 658 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 656 659 END_2D 657 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 )660 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 658 661 pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 659 662 END_3D 660 663 661 DO_2D( 0, 0, 0, 0) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk664 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 662 665 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 663 666 END_2D 664 DO_3DS( 0, 0, 0, 0, jpk-2, kstart, -1 )667 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 ) 665 668 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 666 669 END_3D -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90
r13819 r13898 135 135 zwx(:,:,jpk) = 0._wp ! bottom values 136 136 zwy(:,:,jpk) = 0._wp 137 DO_3D( 1, 0, 1, 0, 1, jpkm1 )137 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 138 138 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 139 139 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 140 140 END_3D 141 141 ! lateral boundary conditions (changed sign) 142 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )142 IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 143 143 ! !-- Slopes of tracer 144 144 zslpx(:,:,jpk) = 0._wp ! bottom values 145 145 zslpy(:,:,jpk) = 0._wp 146 DO_3D( 0, 1, 0, 1, 1, jpkm1 )146 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) 147 147 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 148 148 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 151 151 END_3D 152 152 ! 153 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) !-- Slopes limitation153 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) !-- Slopes limitation 154 154 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 155 155 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 160 160 END_3D 161 161 ! 162 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes162 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 163 163 ! MUSCL fluxes 164 164 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 176 176 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 177 177 END_3D 178 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign)178 IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 179 179 ! 180 180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend -
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) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90
r13819 r13898 122 122 zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp 123 123 ztw (:,:,jpk) = 0._wp ; zti (:,:,jpk) = 0._wp 124 !125 124 ! ! =========== 126 125 DO jn = 1, kjpt ! tracer loop … … 128 127 ! 129 128 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==! 130 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) 131 130 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 132 131 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) … … 134 133 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 135 134 END_2D 136 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) 137 136 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 138 137 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef … … 141 140 ! 142 141 END DO 143 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) 144 143 ! 145 144 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS) … … 221 220 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 222 221 END_3D 223 CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp ) ! Lateral boundary conditions on zti, zsi (unchanged sign)224 222 ! 225 223 ! !* anti-diffusive flux : high order minus low order -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traatf.F90
r13295 r13898 156 156 ENDIF 157 157 ! 158 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kbb) , 'T', 1.0_wp, &159 & pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp, &160 & pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )161 !162 158 ENDIF 163 159 ! … … 210 206 DO jn = 1, kjpt 211 207 ! 212 DO_3D( 0, 0, 0, 0, 1, jpkm1 )208 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 213 209 ztn = pt(ji,jj,jk,jn,Kmm) 214 210 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 275 271 zfact2 = zfact1 * r1_rho0 276 272 DO jn = 1, kjpt 277 DO_3D( 0, 0, 0, 0, 1, jpkm1 )273 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 278 274 ze3t_b = e3t(ji,jj,jk,Kbb) 279 275 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traatf_qco.F90
r13295 r13898 149 149 ENDIF 150 150 ! 151 CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &152 & pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., &153 & pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )154 !155 151 ENDIF 156 152 ! … … 203 199 DO jn = 1, kjpt 204 200 ! 205 DO_3D( 0, 0, 0, 0, 1, jpkm1 )201 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 206 202 ztn = pt(ji,jj,jk,jn,Kmm) 207 203 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 268 264 zfact2 = zfact1 * r1_rho0 269 265 DO jn = 1, kjpt 270 DO_3D( 0, 0, 0, 0, 1, jpkm1 )266 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 271 267 ze3t_b = e3t(ji,jj,jk,Kbb) 272 268 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90
r13819 r13898 127 127 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 128 128 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 129 ! lateral boundary conditions ; just need for outputs130 129 CALL iom_put( "ahu_bbl", ahu_bbl ) ! bbl diffusive flux i-coef 131 130 CALL iom_put( "ahv_bbl", ahv_bbl ) ! bbl diffusive flux j-coef … … 142 141 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 143 142 ! lateral boundary conditions ; just need for outputs 144 ! NOTE: Theresults change along the north fold if this is removed143 ! NOTE: [tiling-comms-merge] The diagnostic results change along the north fold if this is removed 145 144 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 146 145 CALL iom_put( "uoce_bbl", utr_bbl ) ! bbl i-transport … … 250 249 DO jn = 1, kjpt ! tracer loop 251 250 ! ! =========== 252 DO_2D( isi, 0, isj, 0 ) ! CAUTION start from i=1 to update i=2 when cyclic east-west 251 ! NOTE: [tiling-comms-merge] Bug fix- correct order of indices 252 DO_2D( isj, 0, isi, 0 ) ! CAUTION start from i=1 to update i=2 when cyclic east-west 253 253 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 254 254 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r13819 r13898 92 92 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 93 93 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 94 ! NOTE: [tiling-comms-merge] This lbc_lnk is still needed in the zco case, because zps_hde is not called in step 95 IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 94 96 CALL tra_ldf_blp ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, nldf_tra ) 95 97 END SELECT -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r13819 r13898 102 102 REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend 103 103 ! 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 105 REAL(wp) :: zsign ! local scalars 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 105 INTEGER :: isi, iei, isj, iej ! local integers 106 REAL(wp) :: zsign ! local scalars 106 107 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: ztu, ztv, zaheeu, zaheev 107 108 !!---------------------------------------------------------------------- … … 125 126 ELSE ; zsign = -1._wp 126 127 ENDIF 127 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 128 129 IF( ntsi == Nis0 ) THEN ; isi = nn_hls - 1 ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 130 IF( ntsj == Njs0 ) THEN ; isj = nn_hls - 1 ; ELSE ; isj = 0 ; ENDIF 131 IF( ntei == Nie0 ) THEN ; iei = nn_hls - 1 ; ELSE ; iei = 0 ; ENDIF 132 IF( ntej == Nje0 ) THEN ; iej = nn_hls - 1 ; ELSE ; iej = 0 ; ENDIF 133 134 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) !== First derivative (gradient) ==! 128 135 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked! 129 136 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk) … … 134 141 ! ! =========== ! 135 142 ! 136 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== First derivative (gradient) ==!143 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) !== First derivative (gradient) ==! 137 144 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) 138 145 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 139 146 END_3D 140 147 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 141 DO_2D( 1, 0, 1, 0) ! bottom148 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! bottom 142 149 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 143 150 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 144 151 END_2D 145 152 IF( ln_isfcav ) THEN ! top in ocean cavities only 146 DO_2D( 1, 0, 1, 0)153 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 147 154 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 148 155 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) … … 151 158 ENDIF 152 159 ! 153 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 160 ! NOTE: [tiling-comms-merge] Bounds changed to avoid repeating this calculation for overlapping rows when using tiling 161 DO_3D( isj, iej, isi, iei, 1, jpkm1 ) !== Second derivative (divergence) added to the general tracer trends ==! 154 162 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 155 163 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & … … 228 236 END SELECT 229 237 ! 238 ! NOTE: [tiling-comms-merge] Needed for both nn_hls as tra_ldf_iso and tra_ldf_triad have not yet been adjusted to work with nn_hls = 2. In the zps case the lbc_lnk in zps_hde handles this, but in the zco case zlap always needs this lbc_lnk. I did try adjusting the bounds in tra_ldf_iso and tra_ldf_triad so this lbc_lnk was only needed for nn_hls = 1, but this was not correct and I did not have time to figure out why 230 239 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 231 240 ! ! Partial top/bottom cell: GRADh( zlap ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90
r13819 r13898 301 301 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 302 302 z1_t2 = 1._wp / ( rn_time * rn_time ) 303 DO_2D( 0, 1, 0, 1) ! "coriolis+ time^-1" at u- & v-points303 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! "coriolis+ time^-1" at u- & v-points 304 304 zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 305 305 zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp … … 307 307 rfv(ji,jj) = SQRT( zfv * zfv + z1_t2 ) 308 308 END_2D 309 CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp )309 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 310 310 ! 311 311 ELSEIF( nn_mle == 1 ) THEN ! MLE array allocation & initialisation -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tranpc.F90
r13819 r13898 81 81 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 82 82 INTEGER :: ilc1, jlc1, klc1, nncpu ! actually happening in a water column at point "ilc1, jlc1" 83 INTEGER :: isi, isj, iei, iej 83 84 LOGICAL :: lp_monitor_point = .FALSE. ! in CPU domain "nncpu" 84 85 !!---------------------------------------------------------------------- … … 106 107 IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0 ! Do only on the first tile 107 108 ! 108 DO_2D( 0, 0, 0, 0 ) ! interior column only 109 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 110 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 111 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 112 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 113 ! 114 ! NOTE: [tiling-comms-merge] Bounds changed to avoid repeating this calculation for overlapping rows when using tiling 115 DO_2D( isj, iej, isi, iei ) ! interior column only 109 116 ! 110 117 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points … … 313 320 ENDIF 314 321 ! 315 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed)316 322 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 317 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )318 !319 323 IF( lwp .AND. l_LB_debug ) THEN 320 324 WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', nnpcc -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90
r13819 r13898 108 108 ! 109 109 INTEGER :: ji, jj, jk ! dummy loop indices 110 INTEGER :: irgb 110 INTEGER :: irgb, isi, iei, isj, iej ! local integers 111 111 REAL(wp) :: zchl, zcoef, z1_2 ! local scalars 112 112 REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - - … … 137 137 ! ! before qsr induced heat content ! 138 138 ! !-----------------------------------! 139 ! NOTE: [tiling-comms-merge] Many DO loop bounds changed (probably more than necessary) to avoid changing results when using tiling. Some bounds were also adjusted to account for those changed in tra_atf 140 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 141 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 142 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 143 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 144 139 145 IF( kt == nit000 ) THEN !== 1st time step ==! 140 146 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN ! read in restart … … 146 152 ELSE ! No restart or restart not found: Euler forward time stepping 147 153 z1_2 = 1._wp 148 DO_3D( 0, 0, 0, 0, 1, jpk )154 DO_3D( isj, iej, isi, iei, 1, jpk ) 149 155 qsr_hc_b(ji,jj,jk) = 0._wp 150 156 END_3D … … 152 158 ELSE !== Swap of qsr heat content ==! 153 159 z1_2 = 0.5_wp 154 DO_3D( 0, 0, 0, 0, 1, jpk )160 DO_3D( isj, iej, isi, iei, 1, jpk ) 155 161 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 156 162 END_3D … … 163 169 CASE( np_BIO ) !== bio-model fluxes ==! 164 170 ! 165 DO_3D( 0, 0, 0, 0, 1, nksr )171 DO_3D( isj, iej, isi, iei, 1, nksr ) 166 172 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 167 173 END_3D … … 185 191 ! most expensive calculations) 186 192 ! 187 DO_2D( 0, 0, 0, 0)193 DO_2D( isj, iej, isi, iei ) 188 194 ! zlogc = log(zchl) 189 195 zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) … … 204 210 205 211 ! 206 DO_3D( 0, 0, 0, 0, 1, nksr + 1 )212 DO_3D( isj, iej, isi, iei, 1, nksr + 1 ) 207 213 ! zchl = ALOG( ze0(ji,jj) ) 208 214 zlogc = ze0(ji,jj) … … 234 240 ! 235 241 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 236 DO_2D( 0, 0, 0, 0)242 DO_2D( isj, iej, isi, iei ) 237 243 ze0(ji,jj) = rn_abs * qsr(ji,jj) 238 244 ze1(ji,jj) = zcoef * qsr(ji,jj) … … 245 251 ! 246 252 ! !* interior equi-partition in R-G-B depending on vertical profile of Chl 247 DO_3D( 0, 0, 0, 0, 2, nksr + 1 )253 DO_3D( isj, iej, isi, iei, 2, nksr + 1 ) 248 254 ze3t = e3t(ji,jj,jk-1,Kmm) 249 255 irgb = NINT( ztmp3d(ji,jj,jk) ) … … 259 265 END_3D 260 266 ! 261 DO_3D( 0, 0, 0, 0, 1, nksr ) !* now qsr induced heat content267 DO_3D( isj, iej, isi, iei, 1, nksr ) !* now qsr induced heat content 262 268 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 263 269 END_3D … … 269 275 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 270 276 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 271 DO_3D( 0, 0, 0, 0, 1, nksr ) ! solar heat absorbed at T-point in the top 400m277 DO_3D( isj, iej, isi, iei, 1, nksr ) !* now qsr induced heat content 272 278 zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r ) 273 279 zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) … … 287 293 ! 288 294 ! sea-ice: store the 1st ocean level attenuation coefficient 289 DO_2D( 0, 0, 0, 0)295 DO_2D( isj, iej, isi, iei ) 290 296 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 291 297 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 292 298 ENDIF 293 299 END_2D 294 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed)295 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile296 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp )297 ENDIF298 300 ! 299 301 ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trasbc.F90
r13553 r13898 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 77 77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices79 INTEGER :: ikt, ikb 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 INTEGER :: ikt, ikb, isi, iei, isj, iej ! local integers 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 81 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 82 82 !!---------------------------------------------------------------------- … … 98 98 ENDIF 99 99 ! 100 ! NOTE: [tiling-comms-merge] Many DO loop bounds changed to avoid changing results when using tiling. Some bounds were also adjusted to account for those changed in tra_atf 101 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 102 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 103 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 104 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 105 100 106 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 101 107 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 102 DO_2D( 0, 0, 0, 0)108 DO_2D( isj, iej, isi, iei ) 103 109 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 104 110 qsr(ji,jj) = 0._wp ! qsr set to zero … … 122 128 ELSE ! No restart or restart not found: Euler forward time stepping 123 129 zfact = 1._wp 124 DO_2D( 0, 0, 0, 0)130 DO_2D( isj, iej, isi, iei ) 125 131 sbc_tsc(ji,jj,:) = 0._wp 126 132 sbc_tsc_b(ji,jj,:) = 0._wp … … 129 135 ELSE !* other time-steps: swap of forcing fields 130 136 zfact = 0.5_wp 131 DO_2D( 0, 0, 0, 0)137 DO_2D( isj, iej, isi, iei ) 132 138 sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 133 139 END_2D 134 140 ENDIF 135 141 ! !== Now sbc tracer content fields ==! 136 DO_2D( 0, 0, 0, 0)142 DO_2D( isj, iej, isi, iei ) 137 143 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 138 144 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 139 145 END_2D 140 146 IF( ln_linssh ) THEN !* linear free surface 141 DO_2D( 0, 0, 0, 0) !==>> add concentration/dilution effect due to constant volume cell147 DO_2D( isj, iej, isi, iei ) !==>> add concentration/dilution effect due to constant volume cell 142 148 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 143 149 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) … … 150 156 ! 151 157 DO jn = 1, jpts !== update tracer trend ==! 158 ! NOTE: [tiling-comms-merge] This looped over nn_hls, which changes the results when using tiling 152 159 DO_2D( 0, 0, 0, 0 ) 153 160 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trazdf.F90
r13819 r13898 96 96 & - ztrds(:,:,jk) 97 97 END DO 98 ! NOTE: [tiling-comms-merge] The diagnostic results change along the north fold if this is removed 99 !!gm this should be moved in trdtra.F90 and done on all trends 100 CALL lbc_lnk_multi( 'trazdf', ztrdt, 'T', 1.0_wp , ztrds, 'T', 1.0_wp ) 101 !!gm 98 102 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 99 103 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_zdf, ztrds ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90
r13819 r13898 47 47 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 48 48 INTEGER , INTENT(in ) :: kjpt ! number of tracers 49 REAL(wp), DIMENSION(:,:,:,:), INTENT(in 49 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pta ! 4D tracers fields 50 50 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 51 REAL(wp), DIMENSION(:,:,:) , INTENT(in 51 REAL(wp), DIMENSION(:,:,:) , INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 52 52 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 53 53 ! … … 111 111 INTEGER , INTENT(in ) :: kjpt ! number of tracers 112 112 INTEGER , INTENT(in ) :: ktta, ktgt, ktrd, ktgr 113 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in 113 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout) :: pta ! 4D tracers fields 114 114 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 115 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in 115 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 116 116 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 117 117 ! … … 124 124 ! 125 125 IF( ln_timing ) CALL timing_start( 'zps_hde') 126 ! NOTE: [tiling-comms-merge] Some lbc_lnks in tra_adv and tra_ldf can be taken out in the zps case, because this lbc_lnk is called when zps_hde is called in the stp routine. In the zco case they are still needed. 127 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 128 IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) ; END IF 126 129 ! 127 130 pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp … … 130 133 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 131 134 ! 132 DO_2D( 1, 0, 1, 0 )135 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 133 136 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 134 137 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 169 172 END DO 170 173 ! 171 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.174 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 172 175 ! 173 176 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 174 177 pgru(:,:) = 0._wp 175 178 pgrv(:,:) = 0._wp ! depth of the partial step level 176 DO_2D( 1, 0, 1, 0)179 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 177 180 iku = mbku(ji,jj) 178 181 ikv = mbkv(ji,jj) … … 190 193 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 191 194 ! 192 DO_2D( 1, 0, 1, 0) ! Gradient of density at the last level195 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! Gradient of density at the last level 193 196 iku = mbku(ji,jj) 194 197 ikv = mbkv(ji,jj) … … 202 205 ENDIF 203 206 END_2D 204 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions207 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 205 208 ! 206 209 END IF … … 217 220 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 218 221 INTEGER , INTENT(in ) :: kjpt ! number of tracers 219 REAL(wp), DIMENSION(:,:,:,:), INTENT(in 222 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pta ! 4D tracers fields 220 223 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 221 224 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 222 REAL(wp), DIMENSION(:,:,:) , INTENT(in 225 REAL(wp), DIMENSION(:,:,:) , INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 223 226 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 224 227 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) … … 287 290 INTEGER , INTENT(in ) :: kjpt ! number of tracers 288 291 INTEGER , INTENT(in ) :: ktta, ktgt, ktgti, ktrd, ktgr, ktgri 289 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in 292 REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout) :: pta ! 4D tracers fields 290 293 REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 291 294 REAL(wp), DIMENSION(A2D_T(ktgti) ,KJPT), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 292 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in 295 REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(inout), OPTIONAL :: prd ! 3D density anomaly fields 293 296 REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 294 297 REAL(wp), DIMENSION(A2D_T(ktgri) ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) … … 303 306 IF( ln_timing ) CALL timing_start( 'zps_hde_isf') 304 307 ! 308 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 309 IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) ; END IF 310 305 311 pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp 306 312 pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp … … 310 316 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 311 317 ! 312 DO_2D( 1, 0, 1, 0)318 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 313 319 314 320 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 350 356 END DO 351 357 ! 352 CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.358 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 353 359 354 360 ! horizontal derivative of density anomalies (rd) … … 356 362 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 357 363 ! 358 DO_2D( 1, 0, 1, 0)364 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 359 365 360 366 iku = mbku(ji,jj) … … 377 383 CALL eos( ztj, zhj, zrj ) 378 384 379 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level385 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 380 386 iku = mbku(ji,jj) 381 387 ikv = mbkv(ji,jj) … … 392 398 END_2D 393 399 394 CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions400 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions 395 401 ! 396 402 END IF … … 399 405 ! 400 406 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 401 DO_2D( 1, 0, 1, 0)407 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 402 408 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 403 409 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 … … 443 449 ! 444 450 END DO 445 CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.451 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. 446 452 447 453 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 448 454 ! 449 455 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 450 DO_2D( 1, 0, 1, 0)456 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 451 457 452 458 iku = miku(ji,jj) … … 468 474 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 469 475 ! 470 DO_2D( 1, 0, 1, 0 ) ! Gradient of density at the last level476 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 471 477 iku = miku(ji,jj) 472 478 ikv = mikv(ji,jj) … … 482 488 483 489 END_2D 484 CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions490 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions 485 491 ! 486 492 END IF -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OFF/dtadyn.F90
r13553 r13898 795 795 !!--------------------------------------------------------------------- 796 796 INTEGER , INTENT(in ) :: kt ! time step 797 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in 797 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts ! temperature/salinity 798 798 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: puslp ! zonal isopycnal slopes 799 799 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pvslp ! meridional isopycnal slopes -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/TOP/TRP/trcadv.F90
r13286 r13898 124 124 ! 125 125 CASE ( np_CEN ) ! Centered : 2nd / 4th order 126 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 126 127 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 127 128 CASE ( np_FCT ) ! FCT : 2nd / 4th order 129 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 130 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) ; END IF 128 131 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 129 132 CASE ( np_MUS ) ! MUSCL 130 133 CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 131 134 CASE ( np_UBS ) ! UBS 135 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 132 136 CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 133 137 CASE ( np_QCK ) ! QUICKEST 138 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 139 CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) ; END IF 134 140 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 135 141 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/TOP/TRP/trcldf.F90
r13295 r13898 101 101 & ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 102 102 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 103 IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.) 103 104 CALL tra_ldf_blp ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, & 104 105 & ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs), jptra, nldf_trc )
Note: See TracChangeset
for help on using the changeset viewer.