Changeset 13660


Ignore:
Timestamp:
2020-10-22T12:47:32+02:00 (5 weeks ago)
Author:
francesca
Message:

communications cleanup of the TRA modules - ticket #2367

Location:
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/eosbn2.F90

    r13497 r13660  
    563563      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    564564         ! 
    565          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     565         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    566566            ! 
    567567            zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
     
    616616      CASE( np_seos )                  !==  simplified EOS  ==! 
    617617         ! 
    618          DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     618         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    619619            zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    620620            zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
     
    670670      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    671671         ! 
    672          DO_2D( 1, 1, 1, 1 ) 
     672         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    673673            ! 
    674674            zh  = pdep(ji,jj) * r1_Z0                                  ! depth 
     
    723723      CASE( np_seos )                  !==  simplified EOS  ==! 
    724724         ! 
    725          DO_2D( 1, 1, 1, 1 ) 
     725         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    726726            ! 
    727727            zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
     
    873873      IF( ln_timing )   CALL timing_start('bn2') 
    874874      ! 
    875       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 
     875      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 
    876876         zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    877877            &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv.F90

    r13237 r13660  
    146146      ! 
    147147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
     148         IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
    148149         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    149150      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
     151         IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.)  
     152            CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) ; END IF 
    150153         CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    151154      CASE ( np_MUS )                                 ! MUSCL 
    152155         CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )  
    153156      CASE ( np_UBS )                                 ! UBS 
     157         IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    154158         CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    155159      CASE ( np_QCK )                                 ! QUICKEST 
     160         IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
     161            CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF 
    156162         CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    157163      ! 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_cen.F90

    r13619 r13660  
    9999      zwz(:,:,jpk) = 0._wp 
    100100      ! 
    101       IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_cen', pt(:,:,:,:,Kmm), 'T', 1. ) 
    102101      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
    103102         ! 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_fct.F90

    r13497 r13660  
    7979      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    8080      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    81       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(inout) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8282      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8383      ! 
     
    126126         zptry(:,:,:) = 0._wp 
    127127      ENDIF 
    128       !                          ! surface & bottom value : flux set to zero one for all 
    129       zwz(:,:, 1 ) = 0._wp             
    130       zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp 
    131       ! 
    132       zwi(:,:,:) = 0._wp         
    133128      ! 
    134129      ! If adaptive vertical advection, check if it is needed on this PE at this time 
     
    139134      IF( ll_zAimp ) THEN 
    140135         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 
    141          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     136         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    142137            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
    143138            &                               / e3t(ji,jj,jk,Krhs) 
     
    151146         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    152147         !                    !* upstream tracer flux in the i and j direction  
    153          DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     148         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    154149            ! upstream scheme 
    155150            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) 
     
    178173         ENDIF 
    179174         !                
    180          DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* trend and after field with monotonic scheme 
     175         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme 
    181176            !                               ! total intermediate advective trends 
    182177            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    194189            ! 
    195190            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 
    196             DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     191            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
    197192               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    198193               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     
    218213         ! 
    219214         CASE(  2  )                   !- 2nd order centered 
    220             DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     215            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    221216               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) 
    222217               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) 
     
    238233            CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    239234            ! 
    240             DO_3D( 1, 0, 1, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     235            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    241236               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 
    242237               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     
    253248               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    254249            END_3D 
    255             CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    256250            ! 
    257251            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     
    265259               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    266260            END_3D 
     261            CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    267262            ! 
    268263         END SELECT 
     
    271266         ! 
    272267         CASE(  2  )                   !- 2nd order centered 
    273             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     268            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    274269               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    275270                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
     
    278273         CASE(  4  )                   !- 4th order COMPACT 
    279274            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    280             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     275            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    281276               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    282277            END_3D 
     
    287282         ENDIF 
    288283         !          
     284         IF (nn_hls.EQ.1) THEN 
     285            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 ) 
     286         ELSE 
     287            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
     288         END IF 
     289         ! 
    289290         IF ( ll_zAimp ) THEN 
    290             DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !* trend and after field with monotonic scheme 
     291            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme 
    291292               !                                                ! total intermediate advective trends 
    292293               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    293294                  &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    294295                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
    295                ztw(ji,jj,jk)  = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     296               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
    296297            END_3D 
    297298            ! 
    298299            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 
    299300            ! 
    300             DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     301            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
    301302               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
    302303               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
    303                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) 
     304               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) 
    304305            END_3D 
    305306         END IF 
    306          ! 
    307          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 ) 
    308307         ! 
    309308         !        !==  monotonicity algorithm  ==! 
     
    335334            END_3D 
    336335         END IF          
    337          ! 
     336         ! NOT TESTED - NEED l_trd OR l_hst TRUE  
    338337         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
    339338            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes  
     
    350349            ! 
    351350         ENDIF 
     351         ! NOT TESTED - NEED l_ptr TRUE  
    352352         IF( l_ptr ) THEN              ! "Poleward" transports 
    353353            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes 
     
    409409      DO jk = 1, jpkm1 
    410410         ikm1 = MAX(jk-1,1) 
    411          DO_2D( 0, 0, 0, 0 ) 
     411         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    412412 
    413413            ! search maximum in neighbourhood 
     
    439439         END_2D 
    440440      END DO 
    441       CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     441      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) 
    442442 
    443443      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    444444      ! ---------------------------------------- 
    445       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     445      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    446446         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    447447         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
     
    461461         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    462462      END_3D 
    463       CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp )   ! lateral boundary condition (changed sign) 
    464463      ! 
    465464   END SUBROUTINE nonosc 
     
    546545      !                      !==  build the three diagonal matrix & the RHS  ==! 
    547546      ! 
    548       DO_3D( 0, 0, 0, 0, 3, jpkm1 )    ! interior (from jk=3 to jpk-1) 
     547      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )    ! interior (from jk=3 to jpk-1) 
    549548         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal 
    550549         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal 
     
    565564      END IF 
    566565      ! 
    567       DO_2D( 0, 0, 0, 0 )              ! 2nd order centered at top & bottom 
     566      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom 
    568567         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point 
    569568         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point 
     
    582581      !                       !==  tridiagonal solver  ==! 
    583582      ! 
    584       DO_2D( 0, 0, 0, 0 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     583      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
    585584         zwt(ji,jj,2) = zwd(ji,jj,2) 
    586585      END_2D 
    587       DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
     586      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 
    588587         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
    589588      END_3D 
    590589      ! 
    591       DO_2D( 0, 0, 0, 0 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     590      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    592591         pt_out(ji,jj,2) = zwrm(ji,jj,2) 
    593592      END_2D 
    594       DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
     593      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 
    595594         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
    596595      END_3D 
    597596 
    598       DO_2D( 0, 0, 0, 0 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     597      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
    599598         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
    600599      END_2D 
    601       DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 
     600      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 
    602601         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    603602      END_3D 
     
    638637      kstart =  1  + klev 
    639638      ! 
    640       DO_2D( 0, 0, 0, 0 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     639      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
    641640         zwt(ji,jj,kstart) = pD(ji,jj,kstart) 
    642641      END_2D 
    643       DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 ) 
     642      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 
    644643         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
    645644      END_3D 
    646645      ! 
    647       DO_2D( 0, 0, 0, 0 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     646      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    648647         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 
    649648      END_2D 
    650       DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 ) 
     649      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 
    651650         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
    652651      END_3D 
    653652 
    654       DO_2D( 0, 0, 0, 0 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     653      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
    655654         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
    656655      END_2D 
    657       DO_3DS( 0, 0, 0, 0, jpk-2, kstart, -1 ) 
     656      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 ) 
    658657         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
    659658      END_3D 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_qck.F90

    r13497 r13660  
    9191      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
    9292      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(inout) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9494      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9595      !!---------------------------------------------------------------------- 
     
    106106      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    107107      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.  
    108       ! 
    109108      ! 
    110109      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
     
    142141         ! 
    143142!!gm why not using a SHIFT instruction... 
    144          DO_3D( 0, 0, 0, 0, 1, jpkm1 )     !--- Computation of the ustream and downstream value of the tracer and the mask 
     143         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 
    145144            zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer 
    146145            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    147146         END_3D 
    148          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
     147         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    149148          
    150149         ! 
    151150         ! Horizontal advective fluxes 
    152151         ! --------------------------- 
    153          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     152         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    154153            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    155154            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    156155         END_3D 
    157156         ! 
    158          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     157         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    159158            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    160159            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     
    164163         END_3D 
    165164         !--- Lateral boundary conditions  
    166          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
     165         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    167166 
    168167         !--- QUICKEST scheme 
     
    170169         ! 
    171170         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    172          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     171         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    173172            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    174173         END_3D 
    175          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions  
     174         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions  
    176175 
    177176         ! 
     
    179178         DO jk = 1, jpkm1   
    180179            ! 
    181             DO_2D( 0, 0, 0, 0 ) 
     180            DO_2D( 0, 0, 1, 0 ) 
    182181               zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    183182               !--- If the second ustream point is a land point 
     
    188187            END_2D 
    189188         END DO 
    190          ! 
    191          CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    192189         ! 
    193190         ! Computation of the trend 
     
    233230            !                                              
    234231            !--- Computation of the ustream and downstream value of the tracer and the mask 
    235             DO_2D( 0, 0, 0, 0 ) 
     232            DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 
    236233               ! Upstream in the x-direction for the tracer 
    237234               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
     
    240237            END_2D 
    241238         END DO 
    242          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
     239         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    243240 
    244241          
     
    247244         ! --------------------------- 
    248245         ! 
    249          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     246         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    250247            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    251248            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    252249         END_3D 
    253250         ! 
    254          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     251         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    255252            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    256253            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     
    261258 
    262259         !--- Lateral boundary conditions  
    263          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
     260         IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    264261 
    265262         !--- QUICKEST scheme 
     
    267264         ! 
    268265         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    269          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     266         DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 
    270267            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    271268         END_3D 
    272          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions  
     269         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions  
    273270         ! 
    274271         ! Tracer flux on the x-direction 
    275272         DO jk = 1, jpkm1   
    276273            ! 
    277             DO_2D( 0, 0, 0, 0 ) 
     274            DO_2D( 1, 0, 0, 0 ) 
    278275               zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    279276               !--- If the second ustream point is a land point 
     
    285282         END DO 
    286283         ! 
    287          CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    288          ! 
    289284         ! Computation of the trend 
    290285         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     
    332327         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
    333328            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    334                DO_2D( 1, 1, 1, 1 ) 
     329               DO_2D( 0, 0, 0, 0 ) 
    335330                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface  
    336331               END_2D 
    337332            ELSE                                   ! no ocean cavities (only ocean surface) 
    338                zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 
     333               DO_2D( 0, 0, 0, 0 ) 
     334                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 
     335               END_2D 
    339336            ENDIF 
    340337         ENDIF 
     
    369366      !---------------------------------------------------------------------- 
    370367      ! 
    371       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     368      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    372369         zc     = puc(ji,jj,jk)                         ! Courant number 
    373370         zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_ubs.F90

    r13619 r13660  
    119119      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp 
    120120      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp 
    121       ! 
    122       IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_ubs', pt(:,:,:,:,Kbb), 'T', 1.) 
    123121      !                                                          ! =========== 
    124122      DO jn = 1, kjpt                                            ! tracer loop 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traatf.F90

    r13295 r13660  
    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_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traatf_qco.F90

    r13295 r13660  
    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_r13508_HPC-09_communications_cleanup/src/OCE/TRA/tranpc.F90

    r13497 r13660  
    103103         inpcc = 0 
    104104         ! 
    105          DO_2D( 0, 0, 0, 0 )                                ! interior column only 
     105         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                                ! interior column only 
    106106            ! 
    107107            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
     
    310310         ENDIF 
    311311         ! 
    312          CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    313          ! 
    314312         IF( lwp .AND. l_LB_debug ) THEN 
    315313            WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/trasbc.F90

    r13497 r13660  
    124124      ENDIF 
    125125      !                             !==  Now sbc tracer content fields  ==! 
    126       DO_2D( 0, 1, 0, 0 ) 
     126      DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 ) 
    127127         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    128128         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    129129      END_2D 
    130130      IF( ln_linssh ) THEN                !* linear free surface   
    131          DO_2D( 0, 1, 0, 0 )                    !==>> add concentration/dilution effect due to constant volume cell 
     131         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 )                    !==>> add concentration/dilution effect due to constant volume cell 
    132132            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    133133            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
     
    138138      ! 
    139139      DO jn = 1, jpts               !==  update tracer trend  ==! 
    140          DO_2D( 0, 1, 0, 0 ) 
     140         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 ) 
    141141            pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) )    & 
    142142               &                                                / e3t(ji,jj,1,Kmm) 
  • NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/TOP/TRP/trcadv.F90

    r13286 r13660  
    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.) ; 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      ! 
Note: See TracChangeset for help on using the changeset viewer.