New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13898 for NEMO/branches – NEMO

Changeset 13898 for NEMO/branches


Ignore:
Timestamp:
2020-11-27T15:42:26+01:00 (3 years ago)
Author:
hadcv
Message:

#2365: Merge in changes from dev_r13508_HPC-09_communications_cleanup up to [13701]

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  
    197197         ENDIF 
    198198         ! 
    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 
    200201            DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    201202               zl = gdept_0(ji,jj,jk) 
    … …  
    232233         ! 
    233234         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 ) 
    235237               ik = mbkt(ji,jj)  
    236238               IF( ik > 1 ) THEN 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldfc1d_c2d.F90

    r13553 r13898  
    140140         END_2D 
    141141      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 ) 
    143144            pah1(ji,jj,1) = pUfac * MAX( e1u(ji,jj), e2u(ji,jj) )**knn 
    144145            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  
    427427         zaht_min = 0.2_wp * aht0                                       ! minimum value for aht 
    428428         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 ) 
    430431            !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg) 
    431432            !!     ==>>>   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  
    127127 
    128128         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) 
    130130         ELSE 
    131131            DO_2D( 0, 0, 0, 0 ) 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90

    r13819 r13898  
    250250      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    251251         ! 
    252          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     252         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    253253            ! 
    254254            zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    … …  
    286286      CASE( np_seos )                !==  simplified EOS  ==! 
    287287         ! 
    288          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     288         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    289289            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    290290            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    … …  
    363363            END DO 
    364364            ! 
    365             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     365            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    366366               ! 
    367367               ! compute density (2*nn_sto_eos) times: 
    … …  
    413413         ! Non-stochastic equation of state 
    414414         ELSE 
    415             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     415            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    416416               ! 
    417417               zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    … …  
    451451      CASE( np_seos )                !==  simplified EOS  ==! 
    452452         ! 
    453          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     453         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    454454            zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    455455            zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    … …  
    518518      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    519519         ! 
    520          DO_2D( 1, 1, 1, 1 ) 
     520         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    521521            ! 
    522522            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    … …  
    553553      CASE( np_seos )                !==  simplified EOS  ==! 
    554554         ! 
    555          DO_2D( 1, 1, 1, 1 ) 
     555         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    556556            ! 
    557557            zt    = pts  (ji,jj,jp_tem)  - 10._wp 
    … …  
    612612      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    613613         ! 
    614          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     614         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    615615            ! 
    616616            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    … …  
    665665      CASE( np_seos )                  !==  simplified EOS  ==! 
    666666         ! 
    667          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     667         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    668668            zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    669669            zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    … …  
    731731      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    732732         ! 
    733          DO_2D( 1, 1, 1, 1 ) 
     733         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    734734            ! 
    735735            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
    … …  
    784784      CASE( np_seos )                  !==  simplified EOS  ==! 
    785785         ! 
    786          DO_2D( 1, 1, 1, 1 ) 
     786         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    787787            ! 
    788788            zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    … …  
    946946      IF( ln_timing )   CALL timing_start('bn2') 
    947947      ! 
    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.F90 
     948      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 
    949949         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    950950            &  / ( 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  
    120120         !                                         !==  effective transport  ==! 
    121121         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 ) 
    123123               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 
    124124               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) 
    … …  
    126126            END_3D 
    127127         ELSE 
    128             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     128            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    129129               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only 
    130130               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
    … …  
    134134         ! 
    135135         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 ) 
    137137               zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 
    138138               zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) 
    … …  
    140140         ENDIF 
    141141         ! 
    142          DO_2D( 1, 1, 1, 1 ) 
     142         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    143143            zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom 
    144144            zvv(ji,jj,jpk) = 0._wp 
    … …  
    173173         ENDIF 
    174174         ! 
     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) 
    175176         SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    176177         ! 
    … …  
    178179            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    179180         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 
    180183            CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    181184         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.) 
    182187            CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    183188         CASE ( np_UBS )                                 ! UBS 
     189            IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    184190            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    185191         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 
    186194            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    187195         ! 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90

    r13819 r13898  
    115115            ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero 
    116116            ztv(:,:,jpk) = 0._wp 
    117             DO_3D( 0, 0, 0, 0, 1, jpkm1 )          ! masked gradient 
     117            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )          ! masked gradient 
    118118               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    119119               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120120            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. 
    122122            ! 
    123             DO_3D( 0, 0, 0, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
     123            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
    124124               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2) 
    125125               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    … …  
    131131               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    132132            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. ) 
    134134            ! 
    135135         CASE DEFAULT 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90

    r13819 r13898  
    8080      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    8181      ! 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 
    8283      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8384      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    99100            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    100101         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 
    111103         ! 
    112104         l_trd = .FALSE.            ! set local switches 
    … …  
    120112         ! 
    121113      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 
    122124      ! 
    123125      IF( l_trd .OR. l_hst )  THEN 
    … …  
    130132         zptry(:,:,:) = 0._wp 
    131133      ENDIF 
    132       !                          ! surface & bottom value : flux set to zero one for all 
    133       zwz(:,:, 1 ) = 0._wp             
    134       zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp 
    135       ! 
    136       zwi(:,:,:) = 0._wp         
    137134      ! 
    138135      ! If adaptive vertical advection, check if it is needed on this PE at this time 
    … …  
    143140      IF( ll_zAimp ) THEN 
    144141         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 ) 
    146143            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
    147144            &                               / e3t(ji,jj,jk,Krhs) 
    … …  
    155152         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    156153         !                    !* 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 ) 
    158155            ! upstream scheme 
    159156            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) 
    … …  
    182179         ENDIF 
    183180         !                
    184          DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* trend and after field with monotonic scheme 
     181         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme 
    185182            !                               ! total intermediate advective trends 
    186183            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    … …  
    198195            ! 
    199196            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) 
    201198               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    202199               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
    … …  
    222219         ! 
    223220         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 ) 
    225222               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) 
    226223               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) 
    … …  
    242239            CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    243240            ! 
    244             DO_3D( 1, 0, 1, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     241            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    245242               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 
    246243               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    … …  
    257254               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    258255            END_3D 
    259             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    260256            ! 
    261257            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    269265               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    270266            END_3D 
     267            CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    271268            ! 
    272269         END SELECT 
    … …  
    275272         ! 
    276273         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 ) 
    278275               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    279276                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
    … …  
    282279         CASE(  4  )                   !- 4th order COMPACT 
    283280            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 ) 
    285282               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    286283            END_3D 
    … …  
    290287            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
    291288         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         ! 
    293296         IF ( ll_zAimp ) THEN 
    294             DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !* trend and after field with monotonic scheme 
     297            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme 
    295298               !                                                ! total intermediate advective trends 
    296299               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    297300                  &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    298301                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
    299                ztw(ji,jj,jk)  = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     302               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
    300303            END_3D 
    301304            ! 
    302305            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 
    303306            ! 
    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) 
    305308               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    306309               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
    307                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) 
     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) 
    308311            END_3D 
    309312         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 ) 
    312313         ! 
    313314         !        !==  monotonicity algorithm  ==! 
    … …  
    338339                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    339340            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 
    342344         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
    343345            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes 
    … …  
    354356            ! 
    355357         ENDIF 
     358         ! NOTE: [tiling-comms-merge] I tested this 
     359         ! NOT TESTED - NEED l_ptr TRUE 
    356360         IF( l_ptr ) THEN              ! "Poleward" transports 
    357361            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes 
    … …  
    407411      ! -------------------- 
    408412      ! 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 ) 
    410414         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   & 
    411415            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  ) 
    … …  
    416420      DO jk = 1, jpkm1 
    417421         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 ) 
    419423 
    420424            ! search maximum in neighbourhood 
    … …  
    446450         END_2D 
    447451      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) 
    449453 
    450454      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    451455      ! ---------------------------------------- 
    452       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     456      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    453457         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    454458         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
    … …  
    468472         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    469473      END_3D 
    470       CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp )   ! lateral boundary condition (changed sign) 
    471474      ! 
    472475   END SUBROUTINE nonosc 
    … …  
    553556      !                      !==  build the three diagonal matrix & the RHS  ==! 
    554557      ! 
    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) 
    556559         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal 
    557560         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal 
    … …  
    572575      END IF 
    573576      ! 
    574       DO_2D( 0, 0, 0, 0 )              ! 2nd order centered at top & bottom 
     577      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom 
    575578         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point 
    576579         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point 
    … …  
    589592      !                       !==  tridiagonal solver  ==! 
    590593      ! 
    591       DO_2D( 0, 0, 0, 0 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     594      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
    592595         zwt(ji,jj,2) = zwd(ji,jj,2) 
    593596      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 ) 
    595598         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
    596599      END_3D 
    597600      ! 
    598       DO_2D( 0, 0, 0, 0 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     601      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    599602         pt_out(ji,jj,2) = zwrm(ji,jj,2) 
    600603      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 ) 
    602605         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
    603606      END_3D 
    604607 
    605       DO_2D( 0, 0, 0, 0 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     608      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
    606609         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
    607610      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 ) 
    609612         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    610613      END_3D 
    … …  
    645648      kstart =  1  + klev 
    646649      ! 
    647       DO_2D( 0, 0, 0, 0 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     650      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
    648651         zwt(ji,jj,kstart) = pD(ji,jj,kstart) 
    649652      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 ) 
    651654         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
    652655      END_3D 
    653656      ! 
    654       DO_2D( 0, 0, 0, 0 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     657      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    655658         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 
    656659      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 ) 
    658661         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
    659662      END_3D 
    660663 
    661       DO_2D( 0, 0, 0, 0 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     664      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
    662665         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
    663666      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 ) 
    665668         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    666669      END_3D 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90

    r13819 r13898  
    135135         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    136136         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 ) 
    138138            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    139139            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    140140         END_3D 
    141141         ! 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 ) 
    143143         !                                !-- Slopes of tracer 
    144144         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    145145         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 ) 
    147147            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    148148               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    … …  
    151151         END_3D 
    152152         ! 
    153          DO_3D( 0, 1, 0, 1, 1, jpkm1 )    !-- Slopes limitation 
     153         DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation 
    154154            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    155155               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    … …  
    160160         END_3D 
    161161         ! 
    162          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
     162         DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
    163163            ! MUSCL fluxes 
    164164            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    … …  
    176176            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    177177         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) 
    179179         ! 
    180180         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  
    9292      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    9393      ! 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 
    9495      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9596      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    109110         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 
    110111      ENDIF 
    111       ! 
    112112      ! 
    113113      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    … …  
    146146         ! 
    147147!!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 mask 
     148         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 
    149149            zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer 
    150150            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    151151         END_3D 
    152          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
     152         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    153153          
    154154         ! 
    155155         ! Horizontal advective fluxes 
    156156         ! --------------------------- 
    157          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     157         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    158158            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    159159            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    160160         END_3D 
    161161         ! 
    162          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     162         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    163163            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    164164            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    … …  
    168168         END_3D 
    169169         !--- 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 ) 
    171171 
    172172         !--- QUICKEST scheme 
    … …  
    174174         ! 
    175175         ! 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 ) 
    177177            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    178178         END_3D 
    179          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions  
     179         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
    180180 
    181181         ! 
    182182         ! 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 
    196191         ! 
    197192         ! Computation of the trend 
    … …  
    238233            !                                              
    239234            !--- 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 ) 
    241236               ! Upstream in the x-direction for the tracer 
    242237               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
    … …  
    245240            END_2D 
    246241         END DO 
    247          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
     242         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    248243 
    249244          
    … …  
    252247         ! --------------------------- 
    253248         ! 
    254          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     249         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    255250            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    256251            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    257252         END_3D 
    258253         ! 
    259          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     254         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    260255            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    261256            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    … …  
    266261 
    267262         !--- 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 ) 
    269264 
    270265         !--- QUICKEST scheme 
    … …  
    272267         ! 
    273268         ! 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 ) 
    275270            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    276271         END_3D 
    277          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions  
     272         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
    278273         ! 
    279274         ! 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 
    293283         ! 
    294284         ! Computation of the trend 
    … …  
    338328         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
    339329            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 ) 
    341331                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface  
    342332               END_2D 
    343333            ELSE                                   ! no ocean cavities (only ocean surface) 
    344                DO_2D( 1, 1, 1, 1 ) 
     334               DO_2D( 0, 0, 0, 0 ) 
    345335                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 
    346336               END_2D 
    … …  
    377367      !---------------------------------------------------------------------- 
    378368      ! 
    379       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     369      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    380370         zc     = puc(ji,jj,jk)                         ! Courant number 
    381371         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  
    122122      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp 
    123123      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp 
    124       ! 
    125124      !                                                          ! =========== 
    126125      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    128127         !                                               
    129128         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) 
    131130               zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    132131               zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
    … …  
    134133               ztv(ji,jj,jk) = zeev * ( pt(ji  ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    135134            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) 
    137136               zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 
    138137               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
    … …  
    141140            !                                     
    142141         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) 
    144143         !     
    145144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 
    … …  
    221220               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    222221            END_3D 
    223             CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp )      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
    224222            ! 
    225223            !                          !*  anti-diffusive flux : high order minus low order 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traatf.F90

    r13295 r13898  
    156156         ENDIF 
    157157         ! 
    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          ! 
    162158      ENDIF      
    163159      ! 
    … …  
    210206      DO jn = 1, kjpt 
    211207         ! 
    212          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     208         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    213209            ztn = pt(ji,jj,jk,jn,Kmm)                                     
    214210            ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers 
    … …  
    275271      zfact2 = zfact1 * r1_rho0 
    276272      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 ) 
    278274            ze3t_b = e3t(ji,jj,jk,Kbb) 
    279275            ze3t_n = e3t(ji,jj,jk,Kmm) 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traatf_qco.F90

    r13295 r13898  
    149149         ENDIF 
    150150         ! 
    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          ! 
    155151      ENDIF 
    156152      ! 
    … …  
    203199      DO jn = 1, kjpt 
    204200         ! 
    205          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     201         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    206202            ztn = pt(ji,jj,jk,jn,Kmm) 
    207203            ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers 
    … …  
    268264      zfact2 = zfact1 * r1_rho0 
    269265      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 ) 
    271267            ze3t_b = e3t(ji,jj,jk,Kbb) 
    272268            ze3t_n = e3t(ji,jj,jk,Kmm) 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90

    r13819 r13898  
    127127            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    128128         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    129             ! lateral boundary conditions ; just need for outputs 
    130129            CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    131130            CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
    … …  
    142141         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    143142            ! lateral boundary conditions ; just need for outputs 
    144             ! NOTE: The results change along the north fold if this is removed 
     143            ! NOTE: [tiling-comms-merge] The diagnostic results change along the north fold if this is removed 
    145144            CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    146145            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    … …  
    250249      DO jn = 1, kjpt                                            ! tracer loop 
    251250         !                                                       ! =========== 
    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 
    253253            IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    254254               ! 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  
    9292            CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    9393         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.) 
    9496            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    9597         END SELECT 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90

    r13819 r13898  
    102102      REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
    103103      ! 
    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 
    106107      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   ztu, ztv, zaheeu, zaheev 
    107108      !!---------------------------------------------------------------------- 
    … …  
    125126      ELSE                    ;   zsign = -1._wp 
    126127      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)  ==! 
    128135         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! 
    129136         zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   !!gm   * vmask(ji,jj,jk) 
    … …  
    134141         !                          ! =========== !     
    135142         !                                
    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)  ==! 
    137144            ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) 
    138145            ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
    139146         END_3D 
    140147         IF( ln_zps ) THEN                             ! set gradient at bottom/top ocean level 
    141             DO_2D( 1, 0, 1, 0 )                              ! bottom 
     148            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                              ! bottom 
    142149               ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 
    143150               ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 
    144151            END_2D 
    145152            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 ) 
    147154                  IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)  
    148155                  IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)  
    … …  
    151158         ENDIF 
    152159         ! 
    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  ==! 
    154162            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    155163               &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
    … …  
    228236      END SELECT 
    229237      ! 
     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 
    230239      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    231240      !                                               ! Partial top/bottom cell: GRADh( zlap )   

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90

    r13819 r13898  
    301301            IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 
    302302            z1_t2 = 1._wp / ( rn_time * rn_time ) 
    303             DO_2D( 0, 1, 0, 1 )                      ! "coriolis+ time^-1" at u- & v-points 
     303            DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )                      ! "coriolis+ time^-1" at u- & v-points 
    304304               zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
    305305               zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
    … …  
    307307               rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    308308            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 ) 
    310310            ! 
    311311         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  
    8181      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    8282      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1" 
     83      INTEGER :: isi, isj, iei, iej 
    8384      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu" 
    8485      !!---------------------------------------------------------------------- 
    … …  
    106107         IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile 
    107108         ! 
    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 
    109116            ! 
    110117            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
    … …  
    313320         ENDIF 
    314321         ! 
    315          ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed) 
    316322         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             ! 
    319323            IF( lwp .AND. l_LB_debug ) THEN 
    320324               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  
    108108      ! 
    109109      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    110       INTEGER  ::   irgb                    ! local integers 
     110      INTEGER  ::   irgb, isi, iei, isj, iej ! local integers 
    111111      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars 
    112112      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    … …  
    137137      !                         !  before qsr induced heat content  ! 
    138138      !                         !-----------------------------------! 
     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 
    139145      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    140146         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    … …  
    146152         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    147153            z1_2 = 1._wp 
    148             DO_3D( 0, 0, 0, 0, 1, jpk ) 
     154            DO_3D( isj, iej, isi, iei, 1, jpk ) 
    149155               qsr_hc_b(ji,jj,jk) = 0._wp 
    150156            END_3D 
    … …  
    152158      ELSE                             !==  Swap of qsr heat content  ==! 
    153159         z1_2 = 0.5_wp 
    154          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     160         DO_3D( isj, iej, isi, iei, 1, jpk ) 
    155161            qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
    156162         END_3D 
    … …  
    163169      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    164170         ! 
    165          DO_3D( 0, 0, 0, 0, 1, nksr ) 
     171         DO_3D( isj, iej, isi, iei, 1, nksr ) 
    166172            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
    167173         END_3D 
    … …  
    185191            ! most expensive calculations) 
    186192            ! 
    187             DO_2D( 0, 0, 0, 0 ) 
     193            DO_2D( isj, iej, isi, iei ) 
    188194                       ! zlogc = log(zchl) 
    189195               zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )      
    … …  
    204210             
    205211! 
    206             DO_3D( 0, 0, 0, 0, 1, nksr + 1 ) 
     212            DO_3D( isj, iej, isi, iei, 1, nksr + 1 ) 
    207213               ! zchl    = ALOG( ze0(ji,jj) ) 
    208214               zlogc = ze0(ji,jj) 
    … …  
    234240         ! 
    235241         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 ) 
    237243            ze0(ji,jj) = rn_abs * qsr(ji,jj) 
    238244            ze1(ji,jj) = zcoef  * qsr(ji,jj) 
    … …  
    245251         ! 
    246252         !                                    !* 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 ) 
    248254            ze3t = e3t(ji,jj,jk-1,Kmm) 
    249255            irgb = NINT( ztmp3d(ji,jj,jk) ) 
    … …  
    259265         END_3D 
    260266         ! 
    261          DO_3D( 0, 0, 0, 0, 1, nksr )          !* now qsr induced heat content 
     267         DO_3D( isj, iej, isi, iei, 1, nksr )          !* now qsr induced heat content 
    262268            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
    263269         END_3D 
    … …  
    269275         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands 
    270276         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 400m  
     277         DO_3D( isj, iej, isi, iei, 1, nksr )          !* now qsr induced heat content 
    272278            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
    273279            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
    … …  
    287293      ! 
    288294      ! sea-ice: store the 1st ocean level attenuation coefficient 
    289       DO_2D( 0, 0, 0, 0 ) 
     295      DO_2D( isj, iej, isi, iei ) 
    290296         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 
    291297         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
    292298         ENDIF 
    293299      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 tile 
    296          CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 
    297       ENDIF 
    298300      ! 
    299301      ! 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  
    7676      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts        ! active tracers and RHS of tracer equation 
    7777      ! 
    78       INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices   
    79       INTEGER  ::   ikt, ikb                    ! local integers 
    80       REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar 
     78      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 
    8181      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    8282      !!---------------------------------------------------------------------- 
    … …  
    9898      ENDIF 
    9999      ! 
     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 
    100106!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    101107      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    102          DO_2D( 0, 0, 0, 0 ) 
     108         DO_2D( isj, iej, isi, iei ) 
    103109            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
    104110            qsr(ji,jj) = 0._wp                        ! qsr set to zero 
    … …  
    122128         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    123129            zfact = 1._wp 
    124             DO_2D( 0, 0, 0, 0 ) 
     130            DO_2D( isj, iej, isi, iei ) 
    125131               sbc_tsc(ji,jj,:) = 0._wp 
    126132               sbc_tsc_b(ji,jj,:) = 0._wp 
    … …  
    129135      ELSE                                !* other time-steps: swap of forcing fields 
    130136         zfact = 0.5_wp 
    131          DO_2D( 0, 0, 0, 0 ) 
     137         DO_2D( isj, iej, isi, iei ) 
    132138            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 
    133139         END_2D 
    134140      ENDIF 
    135141      !                             !==  Now sbc tracer content fields  ==! 
    136       DO_2D( 0, 0, 0, 0 ) 
     142      DO_2D( isj, iej, isi, iei ) 
    137143         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    138144         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    139145      END_2D 
    140146      IF( ln_linssh ) THEN                !* linear free surface   
    141          DO_2D( 0, 0, 0, 0 )                    !==>> add concentration/dilution effect due to constant volume cell 
     147         DO_2D( isj, iej, isi, iei )                    !==>> add concentration/dilution effect due to constant volume cell 
    142148            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    143149            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
    … …  
    150156      ! 
    151157      DO jn = 1, jpts               !==  update tracer trend  ==! 
     158         ! NOTE: [tiling-comms-merge] This looped over nn_hls, which changes the results when using tiling 
    152159         DO_2D( 0, 0, 0, 0 ) 
    153160            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  
    9696               &          - ztrds(:,:,jk) 
    9797         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 
    98102         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
    99103         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  
    4747      INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index 
    4848      INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers 
    49       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta         ! 4D tracers fields 
     49      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields 
    5050      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
    51       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     51      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
    5252      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    5353      ! 
    … …  
    111111      INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers 
    112112      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr 
    113       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta         ! 4D tracers fields 
     113      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields 
    114114      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   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     115      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
    116116      REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    117117      ! 
    … …  
    124124      ! 
    125125      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 
    126129      ! 
    127130      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp 
    … …  
    130133      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    131134         ! 
    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 
    133136            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    134137            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    … …  
    169172      END DO 
    170173      ! 
    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. 
    172175      !                 
    173176      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    174177         pgru(:,:) = 0._wp 
    175178         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 ) 
    177180            iku = mbku(ji,jj) 
    178181            ikv = mbkv(ji,jj) 
    … …  
    190193         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    191194         ! 
    192          DO_2D( 1, 0, 1, 0 )              ! Gradient of density at the last level 
     195         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level 
    193196            iku = mbku(ji,jj) 
    194197            ikv = mbkv(ji,jj) 
    … …  
    202205            ENDIF 
    203206         END_2D 
    204          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     207         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    205208         ! 
    206209      END IF 
    … …  
    217220      INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index 
    218221      INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers 
    219       REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta          ! 4D tracers fields 
     222      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields 
    220223      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    221224      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
    222       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
     225      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields 
    223226      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
    224227      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    … …  
    287290      INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers 
    288291      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri 
    289       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta          ! 4D tracers fields 
     292      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields 
    290293      REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    291294      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   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
     295      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields 
    293296      REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
    294297      REAL(wp), DIMENSION(A2D_T(ktgri)        ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    … …  
    303306      IF( ln_timing )   CALL timing_start( 'zps_hde_isf') 
    304307      ! 
     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 
    305311      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
    306312      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp 
    … …  
    310316      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    311317         ! 
    312          DO_2D( 1, 0, 1, 0 ) 
     318         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    313319 
    314320            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    350356      END DO 
    351357      ! 
    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. 
    353359 
    354360      ! horizontal derivative of density anomalies (rd) 
    … …  
    356362         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
    357363         ! 
    358          DO_2D( 1, 0, 1, 0 ) 
     364         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    359365 
    360366            iku = mbku(ji,jj) 
    … …  
    377383         CALL eos( ztj, zhj, zrj ) 
    378384 
    379          DO_2D( 1, 0, 1, 0 )            ! Gradient of density at the last level 
     385         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    380386            iku = mbku(ji,jj) 
    381387            ikv = mbkv(ji,jj) 
    … …  
    392398         END_2D 
    393399 
    394          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     400         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    395401         ! 
    396402      END IF 
    … …  
    399405      ! 
    400406      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 ) 
    402408            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    403409            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
    … …  
    443449         ! 
    444450      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. 
    446452 
    447453      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    448454         ! 
    449455         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 ) 
    451457 
    452458            iku = miku(ji,jj) 
    … …  
    468474         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    469475         ! 
    470          DO_2D( 1, 0, 1, 0 )              ! Gradient of density at the last level 
     476         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    471477            iku = miku(ji,jj)  
    472478            ikv = mikv(ji,jj)  
    … …  
    482488 
    483489         END_2D 
    484          CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
     490         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    485491         ! 
    486492      END IF   

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OFF/dtadyn.F90

    r13553 r13898  
    795795      !!--------------------------------------------------------------------- 
    796796      INTEGER ,                              INTENT(in ) :: kt       ! time step 
    797       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts      ! temperature/salinity 
     797      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts      ! temperature/salinity 
    798798      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: puslp    ! zonal isopycnal slopes 
    799799      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  
    124124      ! 
    125125      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
     126         IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 
    126127         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    127128      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 
    128131         CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    129132      CASE ( np_MUS )                                 ! MUSCL 
    130133         CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups         )  
    131134      CASE ( np_UBS )                                 ! UBS 
     135         IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    132136         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
    133137      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 
    134140         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    135141      ! 

  • NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/TOP/TRP/trcldf.F90

    r13295 r13898  
    101101           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    102102      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.) 
    103104         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    104105           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
Note: See TracChangeset for help on using the changeset viewer.