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 14682 – NEMO

Changeset 14682


Ignore:
Timestamp:
2021-04-08T11:46:35+02:00 (3 years ago)
Author:
francesca
Message:

[comm_cleanup: DYN files] - ticket #2607

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

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynadv.F90

    r14667 r14682  
    7676         CALL dyn_zad     ( kt,                 Kmm, puu, pvv, Krhs )    ! vector form : vertical advection 
    7777      CASE( np_FLX_c2  )  
    78          ! [comm_cleanup: dyn_adv_cen2 NOT TESTED]  
    7978         CALL dyn_adv_cen2( kt,                 Kmm, puu, pvv, Krhs )    ! 2nd order centered scheme 
    8079      CASE( np_FLX_ubs )    
    81          ! [comm_cleanup: dyn_adv_ubs NOT TESTED]  
    8280         CALL dyn_adv_ubs ( kt,            Kbb, Kmm, puu, pvv, Krhs )    ! 3rd order UBS      scheme (UP3) 
    8381      END SELECT 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynadv_cen2.F90

    r14667 r14682  
    7272         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    7373         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    74          ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes (at T- and F-point) 
    75          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! horizontal momentum fluxes (at T- and F-point) 
     74         DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes (at T- and F-point) 
    7675            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
    7776            zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
    … …  
    7978            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
    8079         END_2D 
    81          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )              ! divergence of horizontal momentum fluxes 
    82          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! divergence of horizontal momentum fluxes 
     80         DO_2D( 0, 0, 0, 0 )              ! divergence of horizontal momentum fluxes 
    8381            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    8482               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   & 
    … …  
    10098      !                             !==  Vertical advection  ==! 
    10199      ! 
    102       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                          ! surface/bottom advective fluxes set to zero 
    103       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! surface/bottom advective fluxes set to zero 
     100      DO_2D( 0, 0, 0, 0 )                 ! surface/bottom advective fluxes set to zero 
    104101         zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp 
    105102         zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp 
    106103      END_2D 
    107104      IF( ln_linssh ) THEN                ! linear free surface: advection through the surface 
    108          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    109          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     105         DO_2D( 0, 0, 0, 0 ) 
    110106            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 
    111107            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) 
    … …  
    113109      ENDIF 
    114110      DO jk = 2, jpkm1                    ! interior advective fluxes 
    115          ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )                  ! 1/4 * Vertical transport 
    116          DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )                  ! 1/4 * Vertical transport  
     111         DO_2D( 0, 1, 0, 1 )                  ! 1/4 * Vertical transport 
    117112            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
    118113         END_2D 
    119          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    120          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     114         DO_2D( 0, 0, 0, 0 ) 
    121115            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 
    122116            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 
    123117         END_2D 
    124118      END DO 
    125       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
    126       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
     119      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
    127120         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    128121            &                                      / e3u(ji,jj,jk,Kmm) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynadv_ubs.F90

    r14667 r14682  
    108108         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    109109         !             
    110          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                       ! laplacian 
    111          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacian 
     110         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                       ! laplacian  
     111         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacia 
     112 
    112113            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk) 
    113114            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) 
    … …  
    137138         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    138139         ! 
    139          ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes at T- and F-point 
    140          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! horizontal momentum fluxes at T- and F-point 
     140         DO_2D( 1, 0, 1, 0 )                       ! horizontal momentum fluxes at T- and F-point 
    141141            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
    142142            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
    … …  
    170170               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v ) 
    171171         END_2D 
    172          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )              ! divergence of horizontal momentum fluxes 
    173          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! divergence of horizontal momentum fluxes 
     172         DO_2D( 0, 0, 0, 0 )                       ! divergence of horizontal momentum fluxes 
    174173            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    175174               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   & 
    … …  
    190189      !                                      !  Vertical advection  ! 
    191190      !                                      ! ==================== ! 
    192       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                          ! surface/bottom advective fluxes set to zero 
    193       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! surface/bottom advective fluxes set to zero 
     191      DO_2D( 0, 0, 0, 0 )                          ! surface/bottom advective fluxes set to zero 
    194192         zfu_uw(ji,jj,jpk) = 0._wp 
    195193         zfv_vw(ji,jj,jpk) = 0._wp 
    … …  
    198196      END_2D 
    199197      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface 
    200          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    201          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     198         DO_2D( 0, 0, 0, 0 ) 
    202199            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 
    203200            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) 
    … …  
    205202      ENDIF 
    206203      DO jk = 2, jpkm1                          ! interior fluxes 
    207          ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 ) 
    208          DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )  
     204         DO_2D( 0, 1, 0, 1 ) 
    209205            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
    210206         END_2D 
    211          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    212          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     207         DO_2D( 0, 0, 0, 0 ) 
    213208            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 
    214209            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 
    215210         END_2D 
    216211      END DO 
    217       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
    218       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )       ! divergence of vertical momentum flux divergence 
     212      DO_3D( 0, 0, 0, 0, 1, jpkm1 )             ! divergence of vertical momentum flux divergence 
    219213         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    220214            &                                       / e3u(ji,jj,jk,Kmm) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynatf.F90

    r14511 r14682  
    169169# endif 
    170170      ! 
    171       CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
     171      IF (nn_hls.eq.1) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
    172172      ! 
    173173      !                                !* BDY open boundaries 
    … …  
    201201         IF( ln_linssh ) THEN             ! Fixed volume ! 
    202202            !                             ! =============! 
    203             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     203            ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     204            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    204205               puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    205206               pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    237238               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 
    238239               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 
    239                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     240               ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     241               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    240242                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    241243                  pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    248250               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 
    249251               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 
    250                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     252               ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     253               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    251254                  zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 
    252255                  zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynhpg.F90

    r14511 r14682  
    462462          END IF 
    463463        END_2D 
    464         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     464        ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 
     465        ! zcpx and zcpy are written and used only in the inner domain - can't test it  
     466        ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    465467      END IF 
    466468      ! 
    … …  
    689691          END IF 
    690692        END_2D 
    691         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     693        ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 
     694        ! zcpx and zcpy are written and used only in the inner domain - can't test it  
     695        ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    692696      END IF 
    693697 
    … …  
    786790      !---------------------------------------------------------------------------------------- 
    787791 
    788       DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     792      ! [ comm_cleanup ] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )  
     793      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    789794         zdrhox(ji,jj,jk) =   rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
    790795         zdzx  (ji,jj,jk) = - gde3w(ji+1,jj  ,jk) + gde3w(ji,jj,jk  ) 
    … …  
    10431048            ENDIF 
    10441049         END_2D 
    1045          CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
     1050         ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 
     1051         ! zcpx and zcpy are written and used only in the inner domain - can't test it  
     1052         ! CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    10461053      ENDIF 
    10471054 
    … …  
    11131120      END_2D 
    11141121 
    1115       CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
     1122      ! [ comm_cleanup ] ! I think lbc_lnk can be deleted for halo 1 case, too: 
     1123      ! zcpx and zcpy are written and used only in the inner domain  
     1124      ! CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
    11161125 
    11171126      DO_2D( 0, 0, 0, 0 ) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynkeg.F90

    r14667 r14682  
    101101      ! 
    102102      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
    103          ! [comm_cleanup] ! DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
    104          DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 ) 
     103         DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
    105104            zu =    puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)   & 
    106105               &  + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) 
    … …  
    110109         END_3D 
    111110      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    112          ! [comm_cleanup: Hollingsworth scheme NOT TESTED] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     111         ! [comm_cleanup ] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    113112         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     113            ! round brackets added to fix the order of floating point operations 
     114            ! needed to ensure halo 1 - halo 2 compatibility 
    114115            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    & 
    115116               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  & 
    116                &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
    117                &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     117               &   +     ( ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
     118               &   +       ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )   & 
     119               &         )                                                               ! bracket for halo 1 - halo 2 compatibility 
    118120               ! 
    119121            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    & 
    120122               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  & 
    121                &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   & 
    122                &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) 
     123               &  +      ( ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )  & 
     124               &  +        ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )  &  
     125               &         )                                                               ! bracket for halo 1 - halo 2 compatibility 
    123126            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    124127         END_3D 
    … …  
    127130      END SELECT  
    128131      ! 
    129       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )       !==  grad( KE ) added to the general momentum trends  ==! 
    130       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )       !==  grad( KE ) added to the general momentum trends  ==! 
     132      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       !==  grad( KE ) added to the general momentum trends  ==! 
    131133         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    132134         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_iso.F90

    r14511 r14682  
    128128      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    129129         ! 
    130          DO_3D( 0, 0, 0, 0, 1, jpk )      ! set the slopes of iso-level 
     130         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
     131         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level  
    131132            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    132133            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    … …  
    135136         END_3D 
    136137         ! Lateral boundary conditions on the slopes 
    137          CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
     138         IF (nn_hls.eq.1) CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    138139         ! 
    139140       ENDIF 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynldf_lap_blp.F90

    r14511 r14682  
    8383         DO jk = 1, jpkm1                                 ! Horizontal slab 
    8484            ! 
    85             DO_2D( 0, 1, 0, 1 ) 
     85            ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )  
     86            DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    8687               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    8788               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    … …  
    9495            END_2D 
    9596            ! 
    96             DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
     97            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div )  
     98            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! - curl( curl) + grad( div ) 
    9799               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    98100                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    … …  
    114116         DO jk = 1, jpkm1                                 ! Horizontal slab 
    115117            ! 
    116             DO_2D( 0, 1, 0, 1 ) 
     118            ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )  
     119            DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    117120               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
    118121               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
    … …  
    129132            END_2D 
    130133            ! 
    131             DO_2D( 0, 0, 0, 0 ) 
     134            ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )  
     135            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    132136               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
    133137                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
    … …  
    185189      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    186190      ! 
    187       CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
     191      IF (nn_hls.eq.1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    188192      ! 
    189193      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynvor.F90

    r14511 r14682  
    256256         ALLOCATE( zwz(jpi,jpj,jpk) ) 
    257257         DO jk = 1, jpkm1                                ! Horizontal slab 
    258             DO_2D( 1, 0, 1, 0 ) 
     258            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     259            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    259260               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    260261                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    261262            END_2D 
    262263            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity 
    263                DO_2D( 1, 0, 1, 0 ) 
     264               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     265               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    264266                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    265267               END_2D 
    266268            ENDIF 
    267269         END DO 
    268          CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     270         IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    269271         ! 
    270272      END SELECT 
    … …  
    625627         ! 
    626628#if defined key_qco   ||   defined key_linssh 
    627          DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco) 
     629         ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco)  
     630         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                 ! == reciprocal of e3 at F-point (key_qco) 
    628631            z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 
    629632         END_2D 
    … …  
    631634         SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point 
    632635         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    633             DO_2D( 1, 0, 1, 0 ) 
     636            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     637            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    634638               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    635639                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
    … …  
    641645            END_2D 
    642646         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    643             DO_2D( 1, 0, 1, 0 ) 
     647            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     648            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    644649               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    645650                  &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
    … …  
    658663         ! 
    659664         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    660             DO_2D( 1, 0, 1, 0 ) 
     665            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     666            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    661667               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 
    662668            END_2D 
    663669         CASE ( np_RVO )                           !* relative vorticity 
    664             DO_2D( 1, 0, 1, 0 ) 
     670            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     671            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    665672               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    666673                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
    667674            END_2D 
    668675            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    669                DO_2D( 1, 0, 1, 0 ) 
     676               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     677               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    670678                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    671679               END_2D 
    672680            ENDIF 
    673681         CASE ( np_MET )                           !* metric term 
    674             DO_2D( 1, 0, 1, 0 ) 
     682            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     683            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    675684               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    676685                  &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    677686            END_2D 
    678687         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    679             DO_2D( 1, 0, 1, 0 ) 
    680                zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
    681                   &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   & 
    682                   &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
     688            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     689            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     690            ! round brackets added to fix the order of floating point operations 
     691            ! needed to ensure halo 1 - halo 2 compatibility 
     692               zwz(ji,jj,jk) = (  ff_f(ji,jj) + ( ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
     693                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility 
     694                  &                             - ( e1u(ji  ,jj+1) * pu(ji,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk)      & 
     695                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility 
     696                  &                             ) * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    683697            END_2D 
    684698            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    685                DO_2D( 1, 0, 1, 0 ) 
     699               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     700               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    686701                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    687702               END_2D 
    688703            ENDIF 
    689704         CASE ( np_CME )                           !* Coriolis + metric 
    690             DO_2D( 1, 0, 1, 0 ) 
     705            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     706            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    691707               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    692708                  &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    … …  
    699715      !                                                ! =============== 
    700716      ! 
    701       CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     717      IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    702718      ! 
    703719      !                                                ! =============== 
    … …  
    776792         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    777793         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    778             DO_2D( 1, 0, 1, 0 ) 
     794            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     795            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    779796               zwz(ji,jj,jk) = ff_f(ji,jj) 
    780797            END_2D 
    781798         CASE ( np_RVO )                           !* relative vorticity 
    782             DO_2D( 1, 0, 1, 0 ) 
     799            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     800            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    783801               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    784802                  &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
    … …  
    786804            END_2D 
    787805            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    788                DO_2D( 1, 0, 1, 0 ) 
     806               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     807               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    789808                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    790809               END_2D 
    791810            ENDIF 
    792811         CASE ( np_MET )                           !* metric term 
    793             DO_2D( 1, 0, 1, 0 ) 
     812            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     813            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    794814               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    795815                  &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    796816            END_2D 
    797817         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    798             DO_2D( 1, 0, 1, 0 ) 
     818            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     819            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    799820               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    800821                  &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
    … …  
    802823            END_2D 
    803824            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    804                DO_2D( 1, 0, 1, 0 ) 
     825               ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     826               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    805827                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    806828               END_2D 
    807829            ENDIF 
    808830         CASE ( np_CME )                           !* Coriolis + metric 
    809             DO_2D( 1, 0, 1, 0 ) 
     831            ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
     832            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    810833               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    811834                  &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    … …  
    819842      !                                                ! =============== 
    820843      ! 
    821       CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     844      IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    822845      ! 
    823846      !                                                ! =============== 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traatf.F90

    r14538 r14682  
    111111      !                                              ! local domain boundaries  (T-point, unchanged sign) 
    112112      ! [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 ) 
     113      IF (nn_hls.eq.1) CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    114114      ! 
    115115      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
    … …  
    158158         ! 
    159159         ! [comm_cleanup]  
    160          ! CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
     160         IF (nn_hls.eq.1) CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
    161161 
    162162      ENDIF 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfosm.F90

    r14601 r14682  
    400400     zz0 =       rn_abs       ! surface equi-partition in 2-bands 
    401401     zz1 =  1. - rn_abs 
    402      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    403      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     402     DO_2D( 0, 0, 0, 0 ) 
    404403        ! Surface downward irradiance (so always +ve) 
    405404        zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp 
    … …  
    411410     END_2D 
    412411     ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 
    413      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    414      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     412     DO_2D( 0, 0, 0, 0 ) 
    415413        zthermal = rab_n(ji,jj,1,jp_tem) 
    416414        zbeta    = rab_n(ji,jj,1,jp_sal) 
    … …  
    439437     ! Assume constant La#=0.3 
    440438     CASE(0) 
    441         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    442         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     439        DO_2D( 0, 0, 0, 0 ) 
    443440           zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    444441           zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    … …  
    449446     ! Assume Pierson-Moskovitz wind-wave spectrum 
    450447     CASE(1) 
    451         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    452         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     448        DO_2D( 0, 0, 0, 0 ) 
    453449           ! Use wind speed wndm included in sbc_oce module 
    454450           zustke(ji,jj) =  MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
    … …  
    459455        zfac =  2.0_wp * rpi / 16.0_wp 
    460456 
    461         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    462         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     457        DO_2D( 0, 0, 0, 0 ) 
    463458           IF (hsw(ji,jj) > 1.e-4) THEN 
    464459              ! Use  wave fields 
    … …  
    477472     IF (ln_zdfosm_ice_shelter) THEN 
    478473        ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 
    479         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    480         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     474        DO_2D( 0, 0, 0, 0 ) 
    481475           zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 
    482476           dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 
    … …  
    500494        z_two_thirds = 2.0_wp / 3.0_wp 
    501495 
    502         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    503         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     496        DO_2D( 0, 0, 0, 0 ) 
    504497           zthickness = rn_osm_hblfrac*hbl(ji,jj) 
    505498           z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 
    … …  
    516509        zsqrtpi = SQRT(rpi) 
    517510 
    518         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    519         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     511        DO_2D( 0, 0, 0, 0 ) 
    520512           zthickness = rn_osm_hblfrac*hbl(ji,jj) 
    521513           z2k_times_thickness =  zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 
    … …  
    538530     ! Langmuir velocity scale (zwstrl), La # (zla) 
    539531     ! mixed scale (zvstr), convective velocity scale (zwstrc) 
    540      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    541      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     532     DO_2D( 0, 0, 0, 0 ) 
    542533        ! Langmuir velocity scale (zwstrl), at T-point 
    543534        zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 
    … …  
    572563      hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 
    573564      ibld(:,:) = 4 
    574       ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 
    575       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 5, jpkm1 ) 
     565      DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 
    576566         IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    577567            ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 
    … …  
    580570     ! ########################################################################## 
    581571 
    582       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    583       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     572      DO_2D( 0, 0, 0, 0 ) 
    584573         zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
    585574         imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 )) 
    … …  
    601590! Fox-Kemper Scheme 
    602591         mld_prof = 4 
    603          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    604          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 
     592         DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    605593         IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 
    606594         END_3D 
    … …  
    608596        CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 
    609597 
    610          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    611          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     598         DO_2D( 0, 0, 0, 0 ) 
    612599           zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
    613600         END_2D 
    … …  
    624611         lflux(:,:) = .FALSE. 
    625612         lmle(:,:) = .FALSE. 
    626          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    627          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     613         DO_2D( 0, 0, 0, 0 ) 
    628614          IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 
    629615         END_2D 
    … …  
    631617 
    632618! Test if pycnocline well resolved 
    633       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    634       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     619      DO_2D( 0, 0, 0, 0 ) 
    635620       IF (lconv(ji,jj) ) THEN 
    636621          ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) 
    … …  
    653638! Rate of change of hbl 
    654639      CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 
    655       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    656       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     640      DO_2D( 0, 0, 0, 0 ) 
    657641       zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 
    658642            ! adjustment to represent limiting by ocean bottom 
    … …  
    666650      ibld(:,:) = 4 
    667651 
    668       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 
    669       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 4, jpkm1 ) 
     652      DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 
    670653         IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
    671654            ibld(ji,jj) = jk 
    … …  
    686669      CALL zdf_osm_pycnocline_thickness( dh, zdh ) 
    687670 
    688       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    689       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     671      DO_2D( 0, 0, 0, 0 ) 
    690672       IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 
    691673      END_2D 
    … …  
    727709 
    728710 
    729        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    730        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     711       DO_2D( 0, 0, 0, 0 ) 
    731712         IF ( lconv(ji,jj) ) THEN 
    732713           DO jk = 2, imld(ji,jj) 
    … …  
    763744          IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 
    764745       END IF 
    765        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    766        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     746       DO_2D( 0, 0, 0, 0 ) 
    767747          IF ( lconv(ji,jj) ) THEN 
    768748             DO jk = 2, imld(ji,jj) 
    … …  
    796776       ENDWHERE 
    797777 
    798        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    799        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     778       DO_2D( 0, 0, 0, 0 ) 
    800779          IF (lconv(ji,jj) ) THEN 
    801780             DO jk = 2, imld(ji,jj) 
    … …  
    859838       ENDWHERE 
    860839 
    861        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    862        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     840       DO_2D( 0, 0, 0, 0 ) 
    863841          IF ( lconv(ji,jj) ) THEN 
    864842             DO jk = 2 , imld(ji,jj) 
    … …  
    878856       END_2D 
    879857 
    880        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    881        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     858       DO_2D( 0, 0, 0, 0 ) 
    882859        IF ( lpyc(ji,jj) ) THEN 
    883860          IF ( j_ddh(ji,jj) == 0 ) THEN 
    … …  
    914891! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 
    915892 
    916        ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    917        DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     893       DO_2D( 1, 0, 1, 0 ) 
    918894 
    919895         IF ( lconv(ji,jj) ) THEN 
    … …  
    931907       END_2D 
    932908 
    933        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    934        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     909       DO_2D( 0, 0, 0, 0 ) 
    935910         IF ( lconv(ji,jj) ) THEN 
    936911            DO jk = 2, imld(ji,jj) 
    … …  
    979954       ENDWHERE 
    980955 
    981        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    982        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     956       DO_2D( 0, 0, 0, 0 ) 
    983957          IF ( lconv(ji,jj) ) THEN 
    984958            DO jk = 2, imld(ji,jj) 
    … …  
    10271001 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 
    10281002 
    1029       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1030       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1003      DO_2D( 0, 0, 0, 0 ) 
    10311004         IF ( .not. lconv(ji,jj) ) THEN 
    10321005            DO jk = 2, ibld(ji,jj) 
    … …  
    10441017 
    10451018      ! pynocline contributions 
    1046        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1047        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1019       DO_2D( 0, 0, 0, 0 ) 
    10481020         IF ( .not. lconv(ji,jj) ) THEN 
    10491021          IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    … …  
    10631035       END IF 
    10641036 
    1065        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1066        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1037       DO_2D( 0, 0, 0, 0 ) 
    10671038          ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    10681039          ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 
    … …  
    10891060       ! rotate non-gradient velocity terms back to model reference frame 
    10901061 
    1091        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1092        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1062       DO_2D( 0, 0, 0, 0 ) 
    10931063          DO jk = 2, ibld(ji,jj) 
    10941064             ztemp = ghamu(ji,jj,jk) 
    … …  
    11061076! KPP-style Ri# mixing 
    11071077       IF( ln_kpprimix) THEN 
    1108            
    1109           ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 )      !* Shear production at uw- and vw-points (energy conserving form) 
    1110           DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 
     1078          DO_3D( 1, 0, 1, 0, 2, jpkm1 )      !* Shear production at uw- and vw-points (energy conserving form) 
    11111079             z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   & 
    11121080                  &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & 
    … …  
    11171085          END_3D 
    11181086      ! 
    1119          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1120          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     1087         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    11211088            !                                          ! shear prod. at w-point weightened by mask 
    11221089            zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    … …  
    11291096         END_3D 
    11301097 
    1131           ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1132           DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1098          DO_2D( 0, 0, 0, 0 ) 
    11331099             DO jk = ibld(ji,jj) + 1, jpkm1 
    11341100                zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    … …  
    11411107! KPP-style set diffusivity large if unstable below BL 
    11421108       IF( ln_convmix) THEN 
    1143           ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1144           DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1109          DO_2D( 0, 0, 0, 0 ) 
    11451110             DO jk = ibld(ji,jj) + 1, jpkm1 
    11461111               IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 
    … …  
    11521117 
    11531118       IF ( ln_osm_mle ) THEN  ! set up diffusivity and non-gradient mixing 
    1154           ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1155           DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1119          DO_2D( 0, 0, 0, 0 ) 
    11561120              IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 
    11571121             ! Calculate MLE flux contribution from surface fluxes 
    … …  
    11941158       ! GN 25/8: need to change tmask --> wmask 
    11951159 
    1196      ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1197      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     1160     DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    11981161          p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 
    11991162          p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 
    12001163     END_3D 
    12011164      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    1202      IF (nn_hls.eq.1) CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
    1203                          &                    ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 
     1165     CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   & 
     1166        &                    ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 
    12041167       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    12051168            ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
    … …  
    12131176       END_3D 
    12141177        ! Lateral boundary conditions on final outputs for hbl,  on T-grid (sign unchanged) 
    1215         ! [comm_cleanup] ! no need lbc_lnk for output 
    1216         ! CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
     1178        CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 
    12171179        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    12181180        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign changed) 
    1219         ! [comm_cleanup] ! no need lbc_lnk for output 
    1220         ! CALL lbc_lnk( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
    1221         !   &                    ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 
     1181        CALL lbc_lnk( 'zdfosm', ghamt, 'W',  1.0_wp , ghams, 'W',  1.0_wp,   & 
     1182           &                    ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 
    12221183 
    12231184      IF(ln_dia_osm) THEN 
    … …  
    13191280      REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 
    13201281 
    1321       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1322       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1282      DO_2D( 0, 0, 0, 0 ) 
    13231283          IF ( lconv(ji,jj) ) THEN 
    13241284 
    … …  
    13631323      END_2D 
    13641324! 
    1365        ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1366        DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1325       DO_2D( 0, 0, 0, 0 ) 
    13671326          IF ( lconv(ji,jj) ) THEN 
    13681327             DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity 
    … …  
    14631422 
    14641423! Determins stability and set flag lconv 
    1465      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1466      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1424     DO_2D( 0, 0, 0, 0 ) 
    14671425      IF ( zhol(ji,jj) < 0._wp ) THEN 
    14681426         lconv(ji,jj) = .TRUE. 
    … …  
    14811439     j_ddh(:,:) = 1 
    14821440 
    1483      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1484      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1441     DO_2D( 0, 0, 0, 0 ) 
    14851442      IF ( lconv(ji,jj) ) THEN 
    14861443         IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    … …  
    15191476! Calculate entrainment buoyancy flux due to surface fluxes. 
    15201477 
    1521      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1522      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1478     DO_2D( 0, 0, 0, 0 ) 
    15231479      IF ( lconv(ji,jj) ) THEN 
    15241480        zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 
    … …  
    15451501     zwb_min(:,:) = 0._wp 
    15461502 
    1547      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1548      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1503     DO_2D( 0, 0, 0, 0 ) 
    15491504      IF ( lshear(ji,jj) ) THEN 
    15501505        IF ( lconv(ji,jj) ) THEN 
    … …  
    16071562        zu   = 0._wp 
    16081563        zv   = 0._wp 
    1609         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1610         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1564        DO_2D( 0, 0, 0, 0 ) 
    16111565         zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    16121566         zbeta    = rab_n(ji,jj,1,jp_sal) 
    … …  
    16651619        REAL(wp) :: ztemp 
    16661620 
    1667         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1668         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1621        DO_2D( 0, 0, 0, 0 ) 
    16691622           ztemp = zu(ji,jj) 
    16701623           zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) 
    … …  
    17001653      znd_param(:,:) = 0._wp 
    17011654 
    1702         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1703         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1655        DO_2D( 0, 0, 0, 0 ) 
    17041656          ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    17051657          zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 
    17061658        END_2D 
    1707         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1708         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1659        DO_2D( 0, 0, 0, 0 ) 
    17091660                 ! 
    17101661         IF ( lconv(ji,jj) ) THEN 
    … …  
    17301681 
    17311682! Diagnosis 
    1732         ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1733         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1683        DO_2D( 0, 0, 0, 0 ) 
    17341684          IF ( lconv(ji,jj) ) THEN 
    17351685            zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) & 
    … …  
    18011751 
    18021752 
    1803      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1804      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1753     DO_2D( 0, 0, 0, 0 ) 
    18051754        IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 
    18061755           zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    … …  
    18321781     REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 
    18331782 
    1834      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1835      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1783     DO_2D( 0, 0, 0, 0 ) 
    18361784        IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    18371785           IF ( lconv(ji,jj) ) THEN  ! convective conditions 
    … …  
    19181866      REAL(wp) :: zzeta_v = 0.45 
    19191867      ! 
    1920       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1921       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1868      DO_2D( 0, 0, 0, 0 ) 
    19221869         ! 
    19231870         IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 
    … …  
    19821929    REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 
    19831930 
    1984   ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    1985   DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1931  DO_2D( 0, 0, 0, 0 ) 
    19861932 
    19871933    IF ( lshear(ji,jj) ) THEN 
    … …  
    21262072    REAL(wp) :: zthermal, zbeta 
    21272073 
    2128      ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2129      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2074     DO_2D( 0, 0, 0, 0 ) 
    21302075        IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 
    21312076! 
    … …  
    22312176      REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth 
    22322177 
    2233     ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2234     DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2178    DO_2D( 0, 0, 0, 0 ) 
    22352179 
    22362180      IF ( lshear(ji,jj) ) THEN 
    … …  
    23782322      zmld(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    23792323      zN2_c = grav * rn_osm_mle_rho_c * r1_rho0   ! convert density criteria into N^2 criteria 
    2380       ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 
    2381       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) 
     2324      DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 
    23822325         ikt = mbkt(ji,jj) 
    23832326         zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
    23842327         IF( zmld(ji,jj) < zN2_c )   mld_prof(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    23852328      END_3D 
    2386       ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    2387       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2329      DO_2D( 1, 1, 1, 1 ) 
    23882330         mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 
    23892331         zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 
    … …  
    23952337      ztm(:,:) = 0._wp 
    23962338      zsm(:,:) = 0._wp 
    2397       ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax ) 
    2398       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) 
     2339      DO_3D( 1, 1, 1, 1, 1, ikmax ) 
    23992340         zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    24002341         ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 
    … …  
    24062347      ! calculate horizontal gradients at u & v points 
    24072348 
    2408       ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 
    2409       DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2349      DO_2D( 1, 0, 0, 0 ) 
    24102350         zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
    24112351         zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) )  * umask(ji,jj,1) / e1u(ji,jj) 
    … …  
    24152355      END_2D 
    24162356 
    2417       ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 
    2418       DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
     2357      DO_2D( 0, 0, 1, 0 ) 
    24192358         zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
    24202359         zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 
    … …  
    24272366      CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 
    24282367 
    2429       ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 
    2430       DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2368      DO_2D( 1, 0, 0, 0 ) 
    24312369         dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 
    24322370      END_2D 
    2433       ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 
    2434       DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
     2371      DO_2D( 0, 0, 1, 0 ) 
    24352372         dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 
    24362373      END_2D 
    24372374 
    2438       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2439       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2375      DO_2D( 0, 0, 0, 0 ) 
    24402376        ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    24412377        zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 
    … …  
    24642400   ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 
    24652401 
    2466       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2467       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2402      DO_2D( 0, 0, 0, 0 ) 
    24682403       IF ( lconv(ji,jj) ) THEN 
    24692404          ztmp =  r1_ft(ji,jj) *  MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 
    … …  
    24742409      END_2D 
    24752410   ! Timestep mixed layer eddy depth. 
    2476       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2477       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2411      DO_2D( 0, 0, 0, 0 ) 
    24782412        IF ( lmle(ji,jj) ) THEN  ! MLE layer growing. 
    24792413! Buoyancy gradient at base of MLE layer. 
    … …  
    24992433 
    25002434      mld_prof = 4 
    2501  
    2502       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    2503       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 
     2435      DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 
    25042436      IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 
    25052437      END_3D 
    2506       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    2507       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     2438      DO_2D( 0, 0, 0, 0 ) 
    25082439         zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 
    25092440      END_2D 
    … …  
    26542585         !                                ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 
    26552586         z1_t2 = 2.e-5 
    2656          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    2657          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2587         DO_2D( 1, 1, 1, 1 ) 
    26582588            r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 
    26592589         END_2D 
    … …  
    27002630        etmean(:,:,:) = 0.e0 
    27012631 
    2702         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2703         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     2632        DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    27042633           etmean(ji,jj,jk) = tmask(ji,jj,jk)                     & 
    27052634                &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
    … …  
    27152644        etmean(:,:,:) = 0.e0 
    27162645 
    2717         ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2718         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     2646        DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    27192647           etmean(ji,jj,jk) = tmask(ji, jj,jk)                           & 
    27202648                & / MAX( 1., 2.* tmask(ji,jj,jk)                           & 
    … …  
    28312759     ! 
    28322760     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    2833      ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    2834      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     2761     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    28352762        ikt = mbkt(ji,jj) 
    28362763        hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
    … …  
    28382765     END_3D 
    28392766     ! 
    2840      ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    2841      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     2767     DO_2D( 1, 1, 1, 1 ) 
    28422768        iiki = MAX(4,imld_rst(ji,jj)) 
    28432769        hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm  )    ! Turbocline depth 
    … …  
    28862812      ENDIF 
    28872813 
    2888       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    2889       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     2814      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    28902815         pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      & 
    28912816            &                 - (  ghamt(ji,jj,jk  )  & 
    … …  
    29542879      !code saving tracer trends removed, replace with trdmxl_oce 
    29552880 
    2956       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! add non-local u and v fluxes 
    2957       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )       ! add non-local u and v fluxes 
     2881      DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! add non-local u and v fluxes 
    29582882         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      & 
    29592883            &                 - (  ghamu(ji,jj,jk  )  & 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/step.F90

    r14601 r14682  
    224224               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    225225#endif 
     226      IF (nn_hls.eq.2) THEN 
     227         ! [comm_cleanup] ! needed from DYN  
     228         CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 
     229         IF(.NOT.ln_linssh) CALL lbc_lnk( 'stp', e3f, 'F', 1. ) 
     230         ! [comm_cleanup] ! needed from DYN dyn_ldf_blp  
     231         CALL lbc_lnk( 'stp', uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.) 
     232      ENDIF 
    226233                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    227234                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    … …  
    349356!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    350357                         ! [comm_cleanup]  
    351                          CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp ) 
     358                         IF (nn_hls.eq.2) CALL lbc_lnk( 'stp', ts(:,:,:,jp_tem,Naa), 'T', 1.0_wp, ts(:,:,:,jp_sal,Naa), 'T', 1.0_wp, & 
     359                                                  &            uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1.) 
     360 
    352361                         CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    353362                         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

    r14667 r14682  
    6262#  include "do_loop_substitute.h90" 
    6363#  include "domzgr_substitute.h90" 
    64 #  include "do_loop_substitute.h90" 
    6564   !!---------------------------------------------------------------------- 
    6665   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    241240               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    242241#endif 
     242      ! [comm_cleanup] ! lbc_lnk from DYN 
     243      IF (nn_hls.eq.2) THEN 
     244         CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.,       &  
     245                 &                uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.) 
     246         IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp,    & 
     247                 &                                   r3u(:,:,Nbb), 'U', 1.0_wp, r3v(:,:,Nbb), 'V', 1.0_wp,    & 
     248                 &                                   r3t(:,:,Nbb), 'T', 1.0_wp ) 
     249      ENDIF 
    243250                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    244251                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    245252                         CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
    246253      IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
     254 
    247255                         CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
    248256                         CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
Note: See TracChangeset for help on using the changeset viewer.