Changeset 14538


Ignore:
Timestamp:
2021-02-23T16:59:57+01:00 (3 months ago)
Author:
francesca
Message:

[comm_cleanup] - ticket #2607

Location:
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LDF/ldfslp.F90

    r14511 r14538  
    371371         ! 
    372372         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
    373          DO_3D( 1, 0, 1, 0, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     373         ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     374         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    374375            zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point 
    375376            zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) 
     
    383384         ! 
    384385         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    385             DO_2D( 1, 0, 1, 0 ) 
     386            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     387            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    386388               iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    387389               zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
     
    397399 
    398400      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    399          DO_3D( 1, 1, 1, 1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     401         ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     402         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )      ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    400403            IF( jk+kp > 1 ) THEN              ! k-gradient of T & S a jk+kp 
    401404               zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) 
     
    412415      END DO 
    413416      ! 
    414       DO_2D( 1, 1, 1, 1 )                     !==  Reciprocal depth of the w-point below ML base  ==! 
     417      ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )                     !==  Reciprocal depth of the w-point below ML base  ==! 
     418      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                   !== Reciprocal depth of the w-point below ML base  ==! 
    415419         jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    416420         z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) 
     
    432436      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
    433437         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED 
    434             DO_2D( 1, 0, 1, 0 ) 
     438            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     439            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    435440               ip = jl   ;   jp = jl 
    436441               ! 
     
    469474               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 
    470475               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0 
    471                DO_2D( 1, 0, 1, 0 ) 
     476               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     477               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    472478                  ! 
    473479                  ! Calculate slope relative to geopotentials used for GM skew fluxes 
     
    552558      CALL lbc_lnk( 'ldfslp', wslp2, 'W', 1.0_wp )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    553559      ! 
     560      ! [comm_cleanup] - this comm have to be deleted !!!!! 
     561      IF (nn_hls.eq.2) THEN 
     562         CALL lbc_lnk( 'ldfslp', triadi(:,:,:,:,0), 'U', 1.0_wp, triadi(:,:,:,:,1), 'U', 1.0_wp ) 
     563         CALL lbc_lnk( 'ldfslp', triadj(:,:,:,:,0), 'V', 1.0_wp, triadj(:,:,:,:,1), 'V', 1.0_wp ) 
     564         CALL lbc_lnk( 'ldfslp', triadi_g(:,:,:,:,0), 'U', 1.0_wp, triadi_g(:,:,:,:,1), 'U', 1.0_wp ) 
     565         CALL lbc_lnk( 'ldfslp', triadj_g(:,:,:,:,0), 'V', 1.0_wp, triadj_g(:,:,:,:,1), 'V', 1.0_wp ) 
     566      END IF 
     567 
    554568      IF( ln_timing )   CALL timing_stop('ldf_slp_triad') 
    555569      ! 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LDF/ldftra.F90

    r14511 r14538  
    647647      !                       ! Compute lateral diffusive coefficient at T-point 
    648648      IF( ln_traldf_triad ) THEN 
    649          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     649         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     650         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    650651            ! Take the max of N^2 and zero then take the vertical sum 
    651652            ! of the square root of the resulting N^2 ( required to compute 
     
    661662         END_3D 
    662663      ELSE 
    663          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     664         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     665         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    664666            ! Take the max of N^2 and zero then take the vertical sum 
    665667            ! of the square root of the resulting N^2 ( required to compute 
     
    677679      ENDIF 
    678680 
    679       DO_2D( 0, 0, 0, 0 ) 
     681      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     682      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    680683         zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
    681684         ! Rossby radius at w-point taken betwenn 2 km and  40km 
     
    687690      !                                         !==  Bound on eiv coeff.  ==! 
    688691      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    689       DO_2D( 0, 0, 0, 0 ) 
     692      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     693      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    690694         zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease 
    691695         zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
     
    693697      CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    694698      ! 
    695       DO_2D( 0, 0, 0, 0 )                       !== aei at u- and v-points  ==! 
     699      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     700      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    696701         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
    697702         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
     
    751756      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
    752757      ! 
    753       DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
     758      ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
     759      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 
    754760         zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & 
    755761            &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * wumask(ji,jj,jk) 
     
    758764      END_3D 
    759765      ! 
    760       DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     766      ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     767      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    761768         pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    762769         pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    763770      END_3D 
    764       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     771      ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     772      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    765773         pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
    766774            &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv.F90

    r14511 r14538  
    6161   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag 
    6262 
    63    INTEGER ::   nadv             ! choice of the type of advection scheme 
     63   INTEGER, PUBLIC ::   nadv             ! choice of the type of advection scheme 
    6464   !                             ! associated indices: 
    65    INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    66    INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    67    INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    68    INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
    69    INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
    70    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
     65   INTEGER, PARAMETER, PUBLIC ::   np_NO_adv  = 0   ! no T-S advection 
     66   INTEGER, PARAMETER, PUBLIC ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
     67   INTEGER, PARAMETER, PUBLIC ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
     68   INTEGER, PARAMETER, PUBLIC ::   np_MUS     = 3   ! MUSCL scheme 
     69   INTEGER, PARAMETER, PUBLIC ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     70   INTEGER, PARAMETER, PUBLIC ::   np_QCK     = 5   ! QUICK scheme 
    7171 
    7272   !! * Substitutions 
     
    178178         ! 
    179179         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    180             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
     180            ! [comm_cleanup] 
     181            ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
    181182            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    182183         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    183184            IF (nn_hls.EQ.2) THEN 
    184                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
    185                CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     185               ! [comm_cleanup] - lbc_lnk shifted into step 
     186               ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
     187               ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    186188#if defined key_loop_fusion 
    187189               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
     
    194196         CASE ( np_MUS )                                 ! MUSCL 
    195197            IF (nn_hls.EQ.2) THEN 
    196                 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     198               ! [comm_cleanup] - lbc_lnk shifted into step 
     199               ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    197200#if defined key_loop_fusion 
    198201                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
     
    204207            END IF 
    205208         CASE ( np_UBS )                                 ! UBS 
    206             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     209            ! [comm_cleanup] - lbc_lnk shifted into step 
     210            ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    207211            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    208212         CASE ( np_QCK )                                 ! QUICKEST 
    209             IF (nn_hls.EQ.2) THEN 
    210                CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    211                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    212             END IF 
     213            ! [comm_cleanup] - lbc_lnk shifted into step 
     214            ! IF (nn_hls.EQ.2) THEN 
     215            !   CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
     216            !   CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
     217            ! END IF 
    213218            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    214219         ! 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traatf.F90

    r14511 r14538  
    110110#endif 
    111111      !                                              ! local domain boundaries  (T-point, unchanged sign) 
    112       CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
     112      ! [comm_cleanup] ! lbc_lnk moved into stp 
     113      ! CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    113114      ! 
    114115      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
     
    156157         ENDIF 
    157158         ! 
    158          CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
     159         ! [comm_cleanup]  
     160         ! CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
    159161 
    160162      ENDIF 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf.F90

    r14189 r14538  
    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             IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 
     94            ! [comm_cleanup] 
     95            ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 
    9596            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    9697         END SELECT 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_iso.F90

    r14072 r14538  
    147147         ENDIF 
    148148         ! 
    149          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     149         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     150         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    150151            akz     (ji,jj,jk) = 0._wp 
    151152            ah_wslp2(ji,jj,jk) = 0._wp 
     
    172173      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    173174         ! 
    174          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     175         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     176         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    175177            ! 
    176178            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     
    189191         ! 
    190192         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
    191             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     193            ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     194            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    192195               akz(ji,jj,jk) = 0.25_wp * (                                                                     & 
    193196                  &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   & 
     
    198201            ! 
    199202            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    200                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     203               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     204               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    201205                  akz(ji,jj,jk) = 16._wp   & 
    202206                     &   * ah_wslp2   (ji,jj,jk)   & 
     
    206210               END_3D 
    207211            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    208                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     212               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     213               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    209214                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    210215                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     
    214219           ! 
    215220         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    216             DO_3D( 0, 0, 0, 0, 1, jpk ) 
     221            ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     222            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    217223               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    218224            END_3D 
     
    233239 
    234240         ! Horizontal tracer gradient 
    235          DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     241         ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     242         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )  
    236243            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    237244            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    238245         END_3D 
    239246         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    240             DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell) 
     247            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell) 
     248               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )            ! bottom correction (partial bottom cell) 
    241249               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    242250               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    243251            END_2D 
    244252            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    245                DO_2D( 1, 0, 1, 0 ) 
     253               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     254               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    246255                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 
    247256                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 
     
    256265         DO jk = 1, jpkm1                                 ! Horizontal slab 
    257266            ! 
    258             DO_2D( 1, 1, 1, 1 ) 
     267            ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
     268            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    259269               !                             !== Vertical tracer gradient 
    260270               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
     
    265275            END_2D 
    266276            ! 
    267             DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes 
     277            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes 
     278            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )           !==  Horizontal fluxes 
    268279               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    269280               zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     
    286297            END_2D 
    287298            ! 
    288             DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta 
     299            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta 
     300            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !== horizontal divergence and add to pta 
    289301               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    290302                  &       + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
     
    302314         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    303315 
    304          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
     316         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
     317         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    305318            ! 
    306319            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
     
    324337         !                                !==  add the vertical 33 flux  ==! 
    325338         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    326             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     339            ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     340            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    327341               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   & 
    328342                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               & 
     
    333347            SELECT CASE( kpass ) 
    334348            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    335                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     349               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     350               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    336351                  ztfw(ji,jj,jk) =   & 
    337352                     &  ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
     
    339354               END_3D 
    340355            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    341                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     356               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     357               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    342358                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  & 
    343359                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
     
    347363         ENDIF 
    348364         ! 
    349          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
     365         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
     366         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!  
    350367            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * r1_e1e2t(ji,jj)   & 
    351368               &                                             / e3t(ji,jj,jk,Kmm) 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_lap_blp.F90

    r14215 r14538  
    235235      END SELECT 
    236236      ! 
    237       CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
     237      ! [comm_cleanup]  
     238      IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    238239      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    239240      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traldf_triad.F90

    r14215 r14538  
    152152      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
    153153         ! 
    154          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     154         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     155         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    155156            akz     (ji,jj,jk) = 0._wp 
    156157            ah_wslp2(ji,jj,jk) = 0._wp 
     
    159160         DO ip = 0, 1                            ! i-k triads 
    160161            DO kp = 0, 1 
    161                DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     162               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     163               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )  
    162164                  ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
    163165                  zbu   = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) 
     
    177179         DO jp = 0, 1                            ! j-k triads 
    178180            DO kp = 0, 1 
    179                DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     181               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     182               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )  
    180183                  ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
    181184                  zbv   = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) 
     
    197200            ! 
    198201            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    199                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     202               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     203               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    200204                  akz(ji,jj,jk) = 16._wp           & 
    201205                     &   * ah_wslp2   (ji,jj,jk)   & 
     
    205209               END_3D 
    206210            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    207                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     211               ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     212               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    208213                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    209214                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     
    213218           ! 
    214219         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    215             DO_3D( 0, 0, 0, 0, 1, jpk ) 
     220            ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     221            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    216222               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    217223            END_3D 
     
    228234               DO jp = 0, 1 
    229235                  DO kp = 0, 1 
    230                      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     236                     ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     237                     DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )  
    231238                        zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 
    232239                           & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 
     
    253260         zftv(:,:,:) = 0._wp 
    254261         ! 
    255          DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
     262         ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
     263         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )  
    256264            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    257265            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    258266         END_3D 
    259267         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
    260             DO_2D( 1, 0, 1, 0 )                    ! bottom level 
     268            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                    ! bottom level 
     269            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    261270               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    262271               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    263272            END_2D 
    264273            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    265                DO_2D( 1, 0, 1, 0 ) 
     274               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     275               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    266276                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
    267277                  IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
     
    276286         DO jk = 1, jpkm1 
    277287            !                    !==  Vertical tracer gradient at level jk and jk+1 
    278             DO_2D( 1, 1, 1, 1 ) 
     288            ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
     289            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    279290               zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    280291            END_2D 
     
    283294            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    284295            ELSE 
    285                DO_2D( 1, 1, 1, 1 ) 
     296               ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
     297               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    286298                  zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    287299               END_2D 
     
    293305               DO ip = 0, 1              !==  Horizontal & vertical fluxes 
    294306                  DO kp = 0, 1 
    295                      DO_2D( 1, 0, 1, 0 ) 
     307                     ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     308                     DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    296309                        ze1ur = r1_e1u(ji,jj) 
    297310                        zdxt  = zdit(ji,jj,jk) * ze1ur 
     
    314327               DO jp = 0, 1 
    315328                  DO kp = 0, 1 
    316                      DO_2D( 1, 0, 1, 0 ) 
     329                     ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     330                     DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    317331                        ze2vr = r1_e2v(ji,jj) 
    318332                        zdyt  = zdjt(ji,jj,jk) * ze2vr 
     
    336350               DO ip = 0, 1               !==  Horizontal & vertical fluxes 
    337351                  DO kp = 0, 1 
    338                      DO_2D( 1, 0, 1, 0 ) 
     352                     ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     353                     DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    339354                        ze1ur = r1_e1u(ji,jj) 
    340355                        zdxt  = zdit(ji,jj,jk) * ze1ur 
     
    357372               DO jp = 0, 1 
    358373                  DO kp = 0, 1 
    359                      DO_2D( 1, 0, 1, 0 ) 
     374                     ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     375                     DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    360376                        ze2vr = r1_e2v(ji,jj) 
    361377                        zdyt  = zdjt(ji,jj,jk) * ze2vr 
     
    376392            ENDIF 
    377393            !                             !==  horizontal divergence and add to the general trend  ==! 
    378             DO_2D( 0, 0, 0, 0 ) 
     394            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     395            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )  
    379396               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    380397                  &                       + zsign * (  zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)       & 
     
    387404         !                                !==  add the vertical 33 flux  ==! 
    388405         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    389             DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     406            ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     407            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    390408               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    391409                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
     
    395413            SELECT CASE( kpass ) 
    396414            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    397                DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     415               ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     416               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    398417                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    399418                     &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    400419               END_3D 
    401420            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    402                DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     421               ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     422               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    403423                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    404424                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
     
    408428         ENDIF 
    409429         ! 
    410          DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
     430         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
     431         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )  
    411432            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    412433            &                                  + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/tramle.F90

    r14511 r14538  
    110110         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    111111         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    112             DO_2D( 1, 0, 1, 0 ) 
     112            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     113            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    113114               zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 
    114115               zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) 
    115116            END_2D 
    116117         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    117             DO_2D( 1, 0, 1, 0 ) 
     118            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     119            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    118120               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    119121               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
    120122            END_2D 
    121123         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    122             DO_2D( 1, 0, 1, 0 ) 
     124            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     125            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    123126               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    124127               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
     
    126129         END SELECT 
    127130         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    128             DO_2D( 1, 0, 1, 0 ) 
     131            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     132            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    129133               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & 
    130134                    &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     
    137141            ! 
    138142         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    139             DO_2D( 1, 0, 1, 0 ) 
     143            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     144            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    140145               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               & 
    141146                    &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) 
     
    149154         !                                      !==  MLD used for MLE  ==! 
    150155         !                                                ! compute from the 10m density to deal with the diurnal cycle 
    151          DO_2D( 1, 1, 1, 1 ) 
     156         ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
     157         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    152158            inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
    153159         END_2D 
    154160         IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    155            DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
     161           ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
     162           DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
    156163              IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
    157164           END_3D 
     
    163170         zbm (:,:) = 0._wp 
    164171         zn2 (:,:) = 0._wp 
    165          DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
     172         ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
     173         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
    166174            zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    167175            zmld(ji,jj) = zmld(ji,jj) + zc 
     
    172180         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    173181         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    174             DO_2D( 1, 0, 1, 0 ) 
     182            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     183            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    175184               zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
    176185               zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
    177186            END_2D 
    178187         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    179             DO_2D( 1, 0, 1, 0 ) 
     188            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     189            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    180190               zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
    181191               zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
    182192            END_2D 
    183193         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    184             DO_2D( 1, 0, 1, 0 ) 
     194            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     195            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    185196               zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
    186197               zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
     
    188199         END SELECT 
    189200         !                                                ! convert density into buoyancy 
    190          DO_2D( 1, 1, 1, 1 ) 
     201         ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
     202         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    191203            zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
    192204         END_2D 
     
    201213         ! 
    202214         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    203             DO_2D( 1, 0, 1, 0 ) 
     215            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     216            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    204217               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
    205218                    &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
     
    212225            ! 
    213226         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    214             DO_2D( 1, 0, 1, 0 ) 
     227            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     228            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    215229               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    216230                    &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
     
    222236         ! 
    223237         IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
    224             DO_2D( 1, 0, 1, 0 ) 
     238            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     239            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    225240               IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
    226241               IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
     
    230245      ENDIF  ! end of ln_osm_mle conditional 
    231246    !                                      !==  structure function value at uw- and vw-points  ==! 
    232     DO_2D( 1, 0, 1, 0 ) 
     247    ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
     248    DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    233249       zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu 
    234250       zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall)  
     
    238254    zpsi_vw(:,:,:) = 0._wp 
    239255    ! 
    240       DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 
     256      ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 
     257      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0 
     258       
    241259         zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 
    242260         zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) 
     
    252270      !                                      !==  transport increased by the MLE induced transport ==! 
    253271      DO jk = 1, ikmax 
    254          DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 
     272         ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 
     273         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    255274            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    256275            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    257276         END_2D 
    258          DO_2D( 0, 0, 0, 0 ) 
     277         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     278         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    259279            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
    260280               &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) 
     
    270290         ! 
    271291         IF (ln_osm_mle.and.ln_zdfosm) THEN 
    272             DO_2D( 0, 0, 0, 0 ) 
     292            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     293            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    273294               zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    274295            END_2D 
    275296         ELSE 
    276             DO_2D( 0, 0, 0, 0 ) 
     297            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
     298            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    277299               zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    278300            END_2D 
     
    280302         ! 
    281303         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    282          DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 
     304         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 
     305         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) 
    283306            zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 
    284307            zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/step.F90

    r14239 r14538  
    289289#endif 
    290290 
     291     ! [comm_cleanup] 
     292     IF (nn_hls.EQ.2) THEN 
     293         SELECT CASE ( nadv ) 
     294         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
     295               CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) 
     296               CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 
     297         CASE ( np_MUS )                                 ! MUSCL 
     298                CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
     299         CASE ( np_UBS )                                 ! UBS 
     300                CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
     301         CASE ( np_QCK )                                 ! QUICKEST 
     302               CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) 
     303               CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
     304         END SELECT 
     305      ENDIF 
     306 
    291307      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    292308      DO jtile = 1, nijtile 
     
    323339!! 
    324340!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
     341                         ! [comm_cleanup]  
     342                         CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp ) 
    325343                         CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    326344                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors 
  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90

    r14511 r14538  
    309309#endif 
    310310 
     311     ! [comm_cleanup] 
     312     IF (nn_hls.EQ.2) THEN 
     313         SELECT CASE ( nadv ) 
     314         CASE ( np_FCT )                                 ! FCT scheme : 2nd / 4th order 
     315               CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) 
     316               CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 
     317         CASE ( np_MUS )                                 ! MUSCL 
     318                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
     319         CASE ( np_UBS )                                 ! UBS 
     320                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
     321         CASE ( np_QCK )                                 ! QUICKEST 
     322               CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) 
     323               CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
     324         END SELECT 
     325      ENDIF 
     326 
    311327      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    312328      DO jtile = 1, nijtile 
Note: See TracChangeset for help on using the changeset viewer.