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

Changeset 14757


Ignore:
Timestamp:
2021-04-27T17:33:44+02:00 (3 years ago)
Author:
francesca
Message:

Fortran 77 '.EQ.' operator replacement in conditional statements; [comm_cleanup] tags removal - ticket #2607

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

Legend:

Unmodified
Added
Removed

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

    r14730 r14757  
    9696#endif 
    9797      ! 
    98       IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 
     98      IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 
    9999                                                 &                r3u(:,:,Kmm), 'U', 1.0_wp, r3v(:,:,Kmm), 'V', 1.0_wp, r3t(:,:,Kmm), 'T', 1.0_wp, r3f(:,:), 'F', 1.0_wp ) 
    100100   END SUBROUTINE dom_qco_init 
    … …  
    156156#if ! defined key_qcoTest_FluxForm 
    157157      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    158          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    159158         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    160159            pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    … …  
    165164!!st      ELSE                                         !- Flux Form   (simple averaging) 
    166165#else 
    167          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    168166         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    169167            pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
    … …  
    174172      ! 
    175173      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    176          IF (nn_hls.eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     174         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
    177175         ! 
    178176         ! 
    … …  
    183181         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    184182 
    185             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    186183            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    187184               ! round brackets added to fix the order of floating point operations 
    … …  
    197194!!st         ELSE                                      !- Flux Form   (simple averaging) 
    198195#else 
    199             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    200196            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    201197               ! round brackets added to fix the order of floating point operations 
    … …  
    209205#endif 
    210206         !                                                 ! lbc on ratio at u-,v-,f-points 
    211          IF (nn_hls.eq.1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     207         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    212208         ! 
    213209      ENDIF 

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

    r14667 r14757  
    7575      ENDIF 
    7676      ! 
    77       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
    7877      DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
    7978         ! round brackets added to fix the order of floating point operations 
    … …  
    9796      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field) 
    9897      ! 
    99       IF (nn_hls.eq.1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change) 
     98      IF (nn_hls==1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change) 
    10099      ! 
    101100      IF( ln_timing )   CALL timing_stop('div_hor') 

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

    r14682 r14757  
    108108         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    109109         !             
    110          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                       ! laplacian  
    111110         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacia 
    112  
    113             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) 
    114             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) 
    115             zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
    116                &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk) 
    117             zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
    118                &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk) 
    119             ! 
    120             zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
    121             zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
    122             zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    123                &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
    124             zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    125                &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     111            ! round brackets added to fix the order of floating point operations 
     112            ! needed to ensure halo 1 - halo 2 compatibility 
     113            zlu_uu(ji,jj,jk,1) = ( ( puu (ji+1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) & 
     114               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     115               &                 + ( puu (ji-1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) & 
     116               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     117               &                 ) * umask(ji  ,jj  ,jk) 
     118            zlv_vv(ji,jj,jk,1) = ( ( pvv (ji  ,jj+1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) &  
     119               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     120               &                 + ( pvv (ji  ,jj-1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) & 
     121               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     122               &                 ) * vmask(ji  ,jj  ,jk) 
     123            zlu_uv(ji,jj,jk,1) = (  puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   & 
     124               &               - (  puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb)  ) * fmask(ji  ,jj-1,jk) 
     125            zlv_vu(ji,jj,jk,1) = (  pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   & 
     126               &               - (  pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb)  ) * fmask(ji-1,jj  ,jk) 
     127            ! 
     128            ! round brackets added to fix the order of floating point operations 
     129            ! needed to ensure halo 1 - halo 2 compatibility 
     130            zlu_uu(ji,jj,jk,2) = ( ( zfu(ji+1,jj  ,jk) - zfu(ji  ,jj  ,jk)           & 
     131               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     132               &                 + ( zfu(ji-1,jj  ,jk) - zfu(ji  ,jj  ,jk)           & 
     133               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     134               &                 ) * umask(ji  ,jj  ,jk) 
     135            zlv_vv(ji,jj,jk,2) = ( ( zfv(ji  ,jj+1,jk) - zfv(ji  ,jj  ,jk)           & 
     136               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     137               &                 + ( zfv(ji  ,jj-1,jk) - zfv(ji  ,jj  ,jk)           &  
     138               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     139               &                 ) * vmask(ji  ,jj  ,jk) 
     140            zlu_uv(ji,jj,jk,2) = (  zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             & 
     141               &               - (  zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk)  ) * fmask(ji  ,jj-1,jk) 
     142            zlv_vu(ji,jj,jk,2) = (  zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             & 
     143               &               - (  zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk)  ) * fmask(ji-1,jj  ,jk) 
    126144         END_2D 
    127145      END DO 
    128       IF (nn_hls.eq.1) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
    129                           &                        zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &  
    130                           &                        zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  & 
    131                           &                        zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   ) 
     146      ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 
     147      IF( nn_hls==1 ) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', -1.0_wp , zlu_uv(:,:,:,1), 'U', -1.0_wp,  & 
     148                                              &   zlu_uu(:,:,:,2), 'U', -1.0_wp , zlu_uv(:,:,:,2), 'U', -1.0_wp,  & 
     149                                              &   zlv_vv(:,:,:,1), 'V', -1.0_wp , zlv_vu(:,:,:,1), 'V', -1.0_wp,  & 
     150                                              &   zlv_vv(:,:,:,2), 'V', -1.0_wp , zlv_vu(:,:,:,2), 'V', -1.0_wp   ) 
    132151      ! 
    133152      !                                      ! ====================== ! 

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

    r14682 r14757  
    169169# endif 
    170170      ! 
    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 
     171      IF (nn_hls==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             ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    204203            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    205204               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) ) 
    … …  
    238237               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 
    239238               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 
    240                ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    241239               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    242240                  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) ) 
    … …  
    250248               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 
    251249               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 
    252                ! [comm_cleanup ] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    253250               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    254251                  zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 

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

    r14682 r14757  
    118118      CASE ( np_zps )   ;   CALL hpg_zps    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate plus partial steps (interpolation) 
    119119      CASE ( np_sco )   ;   CALL hpg_sco    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (standard jacobian formulation) 
    120       CASE ( np_djc )   ;   CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial) 
     120      CASE ( np_djc )    
     121             ! [ comm_cleanup ] : it should not be needed but the removal/shift of this lbc_lnk results in a seg_fault error 
     122             IF (nn_hls==2) CALL lbc_lnk( 'dynhpg', r3t(:,:,Kmm), 'T', 1.) 
     123                            CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial) 
    121124      CASE ( np_prj )   ;   CALL hpg_prj    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Pressure Jacobian scheme) 
    122125      CASE ( np_isf )   ;   CALL hpg_isf    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate similar to sco modify for ice shelf 
    … …  
    462465          END IF 
    463466        END_2D 
    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 ) 
    467467      END IF 
    468468      ! 
    … …  
    691691          END IF 
    692692        END_2D 
    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 ) 
     693        ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 
     694        IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp ) 
    696695      END IF 
    697696 
    … …  
    789788      !  5. compute and store elementary horizontal differences in provisional arrays  
    790789      !---------------------------------------------------------------------------------------- 
    791  
    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 ) 
     790      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    794791         zdrhox(ji,jj,jk) =   rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
    795792         zdzx  (ji,jj,jk) = - gde3w(ji+1,jj  ,jk) + gde3w(ji,jj,jk  ) 
    … …  
    798795      END_3D 
    799796 
    800       CALL lbc_lnk( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
     797      IF (nn_hls==1) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1., zdzx, 'U', -1., zdrhoy, 'V', -1., zdzy, 'V', -1. )  
    801798 
    802799      !------------------------------------------------------------------------- 
    … …  
    10481045            ENDIF 
    10491046         END_2D 
    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 ) 
    10531047      ENDIF 
    10541048 
    … …  
    11191113                      & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    11201114      END_2D 
    1121  
    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 ) 
    11251115 
    11261116      DO_2D( 0, 0, 0, 0 ) 

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

    r14682 r14757  
    109109         END_3D 
    110110      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    111          ! [comm_cleanup ] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    112111         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    113112            ! round brackets added to fix the order of floating point operations 
    … …  
    126125            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    127126         END_3D 
    128          IF (nn_hls.eq.1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 
     127         IF (nn_hls==1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 
    129128         ! 
    130129      END SELECT  

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

    r14682 r14757  
    128128      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    129129         ! 
    130          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    131130         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level  
    132131            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    … …  
    136135         END_3D 
    137136         ! Lateral boundary conditions on the slopes 
    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 ) 
     137         IF (nn_hls==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 ) 
    139138         ! 
    140139       ENDIF 

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

    r14682 r14757  
    8383         DO jk = 1, jpkm1                                 ! Horizontal slab 
    8484            ! 
    85             ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )  
    8685            DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    8786               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    … …  
    9594            END_2D 
    9695            ! 
    97             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div )  
    9896            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! - curl( curl) + grad( div ) 
    9997               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    … …  
    116114         DO jk = 1, jpkm1                                 ! Horizontal slab 
    117115            ! 
    118             ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )  
    119116            DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    120117               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
    … …  
    132129            END_2D 
    133130            ! 
    134             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )  
    135131            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    136132               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
    … …  
    189185      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    190186      ! 
    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 
     187      IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    192188      ! 
    193189      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

    r14682 r14757  
    256256         ALLOCATE( zwz(jpi,jpj,jpk) ) 
    257257         DO jk = 1, jpkm1                                ! Horizontal slab 
    258             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    259258            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    260259               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    … …  
    262261            END_2D 
    263262            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity 
    264                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    265263               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    266264                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    268266            ENDIF 
    269267         END DO 
    270          IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     268         IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    271269         ! 
    272270      END SELECT 
    … …  
    627625         ! 
    628626#if defined key_qco   ||   defined key_linssh 
    629          ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco)  
    630627         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                 ! == reciprocal of e3 at F-point (key_qco) 
    631628            z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 
    … …  
    634631         SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point 
    635632         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    636             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    637633            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    638634               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    … …  
    645641            END_2D 
    646642         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    647             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    648643            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    649644               ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    … …  
    663658         ! 
    664659         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    665             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    666660            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    667661               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 
    668662            END_2D 
    669663         CASE ( np_RVO )                           !* relative vorticity 
    670             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    671664            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    672665               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    … …  
    674667            END_2D 
    675668            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    676                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    677669               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    678670                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    680672            ENDIF 
    681673         CASE ( np_MET )                           !* metric term 
    682             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    683674            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    684675               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    … …  
    686677            END_2D 
    687678         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    688             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    689679            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    690680            ! round brackets added to fix the order of floating point operations 
    … …  
    697687            END_2D 
    698688            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    699                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    700689               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    701690                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    … …  
    703692            ENDIF 
    704693         CASE ( np_CME )                           !* Coriolis + metric 
    705             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    706694            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    707695               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    … …  
    715703      !                                                ! =============== 
    716704      ! 
    717       IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     705      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    718706      ! 
    719707      !                                                ! =============== 
    … …  
    792780         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    793781         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    794             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    795782            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    796783               zwz(ji,jj,jk) = ff_f(ji,jj) 
    797784            END_2D 
    798785         CASE ( np_RVO )                           !* relative vorticity 
    799             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    800786            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    801787               zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    … …  
    804790            END_2D 
    805791            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    806                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    807792               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    808793                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    810795            ENDIF 
    811796         CASE ( np_MET )                           !* metric term 
    812             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    813797            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    814798               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    … …  
    816800            END_2D 
    817801         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    818             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    819802            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    820803               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    … …  
    823806            END_2D 
    824807            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    825                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    826808               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    827809                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    … …  
    829811            ENDIF 
    830812         CASE ( np_CME )                           !* Coriolis + metric 
    831             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )  
    832813            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    833814               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    … …  
    842823      !                                                ! =============== 
    843824      ! 
    844       IF (nn_hls.eq.1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     825      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    845826      ! 
    846827      !                                                ! =============== 

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

    r14667 r14757  
    7979 
    8080      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
    81          ! [comm_cleanup] ! DO_2D( 0, 1, 0, 1 )              ! vertical fluxes  
    8281         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )              ! vertical fluxes 
    8382          IF( ln_vortex_force ) THEN 
    … …  
    8786          ENDIF 
    8887         END_2D 
    89          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point 
    9088         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! vertical momentum advection at w-point 
    9189            zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 
    … …  
    9593      ! 
    9694      ! Surface and bottom advective fluxes set to zero 
    97       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )  
    9895      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    9996         zwuw(ji,jj, 1 ) = 0._wp 
    … …  
    103100      END_2D 
    104101      ! 
    105       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Vertical momentum advection at u- and v-points 
    106102      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Vertical momentum advection at u- and v-points 
    107103         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 

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

    r14667 r14757  
    103103      ! 
    104104      zhdiv(:,:) = 0._wp 
    105       ! [comm_cleanup] ! DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports  
    106105      DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                 ! Horizontal divergence of barotropic transports  
    107106        zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) 
    … …  
    111110      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    112111      !  
    113       ! [comm_cleanup]  
    114112      DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    115113         pssh(ji,jj,Kaa) = (  pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
    … …  
    123121      IF ( .NOT.ln_dynspg_ts ) THEN 
    124122         IF( ln_bdy ) THEN 
    125             ! [comm_cleanup]  
    126             IF (nn_hls.eq.1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary 
     123            IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary 
    127124            CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries 
    128125         ENDIF 
    … …  
    183180            ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 
    184181            ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 
    185             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    186182            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    187183               zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
    188184            END_2D 
    189185         END DO 
    190          IF (nn_hls.eq.1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
     186         IF (nn_hls==1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
    191187         !                             ! Is it problematic to have a wrong vertical velocity in boundary cells? 
    192188         !                             ! Same question holds for hdiv. Perhaps just for security 
    … …  
    363359      zdt = 2._wp * rn_Dt                            ! 2*rn_Dt and not rDt (for restartability) 
    364360      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    365          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    366361         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    367362            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    … …  
    381376         END_3D 
    382377      ELSE 
    383          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    384378         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    385379            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    … …  
    395389         END_3D 
    396390      ENDIF 
    397       IF (nn_hls.eq.1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 
     391      IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 
    398392      ! 
    399393      CALL iom_put("Courant",Cu_adv) 
    400394      ! 
    401395      IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere 
    402          ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary 
    403396         DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary 
    404397            ! 

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

    r14667 r14757  
    100100      ! 
    101101      ! update divergence at each level affected by ice shelf top boundary layer 
    102       ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    103102      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    104103         ikt = ktop(ji,jj) 

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

    r14609 r14757  
    371371         ! 
    372372         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
    373          ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    374373         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 
    375374            zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point 
    … …  
    384383         ! 
    385384         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    386             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    387385            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    388386               iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    … …  
    399397 
    400398      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    401          ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    402399         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 
    403400            IF( jk+kp > 1 ) THEN              ! k-gradient of T & S a jk+kp 
    … …  
    415412      END DO 
    416413      ! 
    417       ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )                     !==  Reciprocal depth of the w-point below ML base  ==! 
    418414      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                   !== Reciprocal depth of the w-point below ML base  ==! 
    419415         jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    … …  
    436432      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
    437433         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED 
    438             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    439434            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    440435               ip = jl   ;   jp = jl 
    … …  
    474469               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 
    475470               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0 
    476                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    477471               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    478472                  ! 

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

    r14667 r14757  
    647647      !                       ! Compute lateral diffusive coefficient at T-point 
    648648      IF( ln_traldf_triad ) THEN 
    649          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    650649         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    651650            ! Take the max of N^2 and zero then take the vertical sum 
    … …  
    662661         END_3D 
    663662      ELSE 
    664          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    665663         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    666664            ! Take the max of N^2 and zero then take the vertical sum 
    … …  
    679677      ENDIF 
    680678 
    681       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    682679      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    683680         zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
    … …  
    690687      !                                         !==  Bound on eiv coeff.  ==! 
    691688      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    692       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    693689      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    694690         zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease 
    … …  
    697693      CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    698694      ! 
    699       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    700695      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    701696         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
    … …  
    756751      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
    757752      ! 
    758       ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
    759753      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 
    760754         zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & 
    … …  
    764758      END_3D 
    765759      ! 
    766       ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    767760      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    768761         pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    769762         pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    770763      END_3D 
    771       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    772764      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    773765         pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 

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

    r14511 r14757  
    12931293         IF( llnewtau ) THEN 
    12941294            zcoef = 1. / ( zrhoa * zcdrag ) 
    1295             DO_2D( 1, 1, 1, 1 ) 
     1295            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    12961296               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    12971297            END_2D 

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

    r14667 r14757  
    206206      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    207207         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
    208             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    209208            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    210209               DO jk = 1, nk_rnf(ji,jj) 
    … …  
    213212            END_2D 
    214213         ELSE                    !* variable volume case 
    215             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )              ! update the depth over which runoffs are distributed 
    216214            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! update the depth over which runoffs are distributed 
    217215               h_rnf(ji,jj) = 0._wp 
    … …  
    360358         ! 
    361359         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    362          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    363360         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    364361            IF( h_rnf(ji,jj) > 0._wp ) THEN 
    … …  
    374371            ENDIF 
    375372         END_2D 
    376          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )                           ! set the associated depth 
    377373         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                           ! set the associated depth 
    378374            h_rnf(ji,jj) = 0._wp 
    … …  
    405401         WHERE( zrnfcl(:,:,1) > 0._wp )  h_rnf(:,:) = zacoef * zrnfcl(:,:,1)   ! compute depth for all runoffs 
    406402         ! 
    407          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )                ! take in account min depth of ocean rn_hmin 
    408403         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                ! take in account min depth of ocean rn_hmin 
    409404            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 
    … …  
    414409         ! 
    415410         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
    416          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    417411         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    418412            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 
    … …  
    426420         END_2D 
    427421         ! 
    428          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )                          ! set the associated depth 
    429422         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                          ! set the associated depth 
    430423            h_rnf(ji,jj) = 0._wp 

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

    r14730 r14757  
    180180            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    181181         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    182             IF (nn_hls.EQ.2) THEN 
     182            IF (nn_hls==2) THEN 
    183183#if defined key_loop_fusion 
    184184               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    190190            END IF 
    191191         CASE ( np_MUS )                                 ! MUSCL 
    192             IF (nn_hls.EQ.2) THEN 
     192            IF (nn_hls==2) THEN 
    193193#if defined key_loop_fusion 
    194194                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 

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

    r14511 r14757  
    119119               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120120            END_3D 
    121             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
     121            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    122122            ! 
    123123            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
    … …  
    131131               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    132132            END_3D 
    133             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
     133            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
    134134            ! 
    135135         CASE DEFAULT 

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

    r14511 r14757  
    238238               END_2D 
    239239            END DO 
    240             CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    241             ! 
    242             DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     240            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     241            CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     242            ! 
     243            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    243244               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points 
    244245               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    245246               !                                                        ! C4 minus upstream advective fluxes 
    246                zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
    247                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    248             END_3D 
    249             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     247               ! round brackets added to fix the order of floating point operations 
     248               ! needed to ensure halo 1 - halo 2 compatibility 
     249               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu(ji,jj,jk) - zltu(ji+1,jj,jk)   & 
     250                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility 
     251                             &                          ) - zwx(ji,jj,jk) 
     252               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv(ji,jj,jk) - zltv(ji,jj+1,jk)   & 
     253                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility 
     254                             &                          ) - zwy(ji,jj,jk) 
     255            END_3D 
    250256            ! 
    251257         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    252258            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
    253259            ztv(:,:,jpk) = 0._wp 
    254             DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient) 
     260            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient) 
    255261               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    256262               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    257263            END_3D 
    258             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     264            IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    259265            ! 
    260266            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    268274               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    269275            END_3D 
    270             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     276            IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    271277            ! 
    272278         END SELECT 
    … …  
    291297         ENDIF 
    292298         ! 
    293          IF (nn_hls.EQ.1) THEN 
     299         IF (nn_hls==1) THEN 
    294300            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    295301         ELSE 
    … …  
    449455         END_2D 
    450456      END DO 
    451       IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     457      IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    452458 
    453459      ! 3. monotonic flux in the i & j direction (paa & pbb) 

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

    r14511 r14757  
    139139            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    140140         END_3D 
    141          ! lateral boundary conditions   (changed sign) 
    142          IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    143141         !                                !-- Slopes of tracer 
    144142         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    145143         zslpy(:,:,jpk) = 0._wp 
    146          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) 
     144         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    147145            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    148146               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    … …  
    151149         END_3D 
    152150         ! 
    153          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation 
     151         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !-- Slopes limitation 
    154152            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    155153               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    … …  
    159157               &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) ) 
    160158         END_3D 
    161          ! 
    162          DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
     159         ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     160         IF ( nn_hls==1 ) CALL lbc_lnk( 'traadv_mus', zslpx, 'T', -1.0_wp , zslpy, 'T', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
     161         ! 
     162         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
    163163            ! MUSCL fluxes 
    164164            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    … …  
    176176            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    177177         END_3D 
    178          IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
    179178         ! 
    180179         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend 

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

    r14511 r14757  
    149149            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    150150         END_3D 
    151          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     151         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    152152 
    153153         ! 
    … …  
    167167         END_3D 
    168168         !--- Lateral boundary conditions 
    169          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
     169         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    170170 
    171171         !--- QUICKEST scheme 
    … …  
    176176            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    177177         END_3D 
    178          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
     178         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
    179179 
    180180         ! 
    … …  
    239239            END_2D 
    240240         END DO 
    241          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     241         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    242242 
    243243         ! 
    … …  
    259259 
    260260         !--- Lateral boundary conditions 
    261          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
     261         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    262262 
    263263         !--- QUICKEST scheme 
    … …  
    268268            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    269269         END_3D 
    270          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
     270         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
    271271         ! 
    272272         ! Tracer flux on the x-direction 

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

    r14511 r14757  
    140140            ! 
    141141         END DO 
    142          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     142         IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    143143         ! 
    144144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 

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

    r14682 r14757  
    110110#endif 
    111111      !                                              ! local domain boundaries  (T-point, unchanged sign) 
    112       ! [comm_cleanup] ! lbc_lnk moved into stp 
    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 ) 
     112      CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp ) 
    114113      ! 
    115114      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries 
    … …  
    157156         ENDIF 
    158157         ! 
    159          ! [comm_cleanup]  
    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 ) 
     158         CALL lbc_lnk( 'traatf',  pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp ) 
    161159 
    162160      ENDIF 

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

    r14609 r14757  
    146146         ENDIF 
    147147         ! 
    148          ! [ comm_cleanup ]   
    149          IF (nn_hls.eq.1) CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
     148         IF (nn_hls==1) CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
    150149         ! 
    151150      ENDIF 

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

    r14609 r14757  
    141141         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    142142            ! lateral boundary conditions ; just need for outputs 
    143             ! [ comm_cleanup ] ! no need lbc_lnk for outputs 
    144             ! CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    145143            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    146144            CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 

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

    r14667 r14757  
    147147         ENDIF 
    148148         ! 
    149          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    150149         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    151150            akz     (ji,jj,jk) = 0._wp 
    … …  
    173172      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    174173         ! 
    175          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    176174         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    177175            ! 
    … …  
    196194         ! 
    197195         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
    198             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    199196            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    200197               ! round brackets added to fix the order of floating point operations 
    … …  
    210207            ! 
    211208            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    212                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    213209               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    214210                  akz(ji,jj,jk) = 16._wp   & 
    … …  
    219215               END_3D 
    220216            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    221                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    222217               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    223218                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    … …  
    228223           ! 
    229224         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    230             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    231225            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
    232226               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    … …  
    248242 
    249243         ! Horizontal tracer gradient 
    250          ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    251244         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )  
    252245            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    … …  
    254247         END_3D 
    255248         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    256             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell) 
    257249               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )            ! bottom correction (partial bottom cell) 
    258250               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    … …  
    260252            END_2D 
    261253            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    262                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    263254               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
    264255                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 
    … …  
    274265         DO jk = 1, jpkm1                                 ! Horizontal slab 
    275266            ! 
    276             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    277267            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    278268               !                             !== Vertical tracer gradient 
    … …  
    284274            END_2D 
    285275            ! 
    286             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes 
    287276            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )           !==  Horizontal fluxes 
    288277               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    … …  
    314303            END_2D 
    315304            ! 
    316             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta 
    317305            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !== horizontal divergence and add to pta 
    318306               ! round brackets added to fix the order of floating point operations 
    … …  
    336324         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    337325 
    338          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    339326         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    340327            ! 
    … …  
    367354         !                                !==  add the vertical 33 flux  ==! 
    368355         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    369             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    370356            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    371357               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   & 
    … …  
    377363            SELECT CASE( kpass ) 
    378364            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    379                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    380365               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    381366                  ztfw(ji,jj,jk) =   & 
    … …  
    384369               END_3D 
    385370            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    386                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    387371               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
    388372                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  & 
    … …  
    393377         ENDIF 
    394378         ! 
    395          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
    396379         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!  
    397380            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)   & 

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

    r14667 r14757  
    239239      END SELECT 
    240240      ! 
    241       ! [comm_cleanup]  
    242       IF (nn_hls.EQ.1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
     241      IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    243242      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    244243      IF( ln_zps ) THEN 

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

    r14667 r14757  
    148148      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
    149149         ! 
    150          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    151150         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    152151            akz     (ji,jj,jk) = 0._wp 
    … …  
    155154         ! 
    156155         DO kp = 0, 1                            ! i-k triads 
    157             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    158156            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    159157               ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
    … …  
    179177         ! 
    180178         DO kp = 0, 1                            ! j-k triads 
    181             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    182179            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    183180               ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
    … …  
    207204            ! 
    208205            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    209                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    210206               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    211207                  akz(ji,jj,jk) = 16._wp           & 
    … …  
    216212               END_3D 
    217213            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    218                ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    219214               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    220215                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    … …  
    225220           ! 
    226221         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    227             ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    228222            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    229223               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    … …  
    270264         zftv(:,:,:) = 0._wp 
    271265         ! 
    272          ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
    273266         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
    274267            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    … …  
    276269         END_3D 
    277270         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
    278             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                    ! bottom level 
    279271            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                    ! bottom level 
    280272               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    … …  
    282274            END_2D 
    283275            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    284                ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    285276               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    286277                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
    … …  
    296287         DO jk = 1, jpkm1 
    297288            !                    !==  Vertical tracer gradient at level jk and jk+1 
    298             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    299289            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    300290               zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    … …  
    304294            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    305295            ELSE 
    306                ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    307296               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    308297                  zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    … …  
    314303            IF( ln_botmix_triad ) THEN 
    315304               DO kp = 0, 1              !==  Horizontal & vertical fluxes 
    316                   ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    317305                  DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    318306                     ze1ur = r1_e1u(ji,jj) 
    … …  
    351339               ! 
    352340               DO kp = 0, 1 
    353                   ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    354341                  DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    355342                     ze2vr = r1_e2v(ji,jj) 
    … …  
    389376               ! 
    390377               DO kp = 0, 1               !==  Horizontal & vertical fluxes 
    391                   ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    392378                  DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    393379                     ze1ur = r1_e1u(ji,jj) 
    … …  
    428414               ! 
    429415               DO kp = 0, 1 
    430                   ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    431416                  DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    432417                     ze2vr = r1_e2v(ji,jj) 
    … …  
    466451            ENDIF 
    467452            !                             !==  horizontal divergence and add to the general trend  ==! 
    468             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    469453            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    470454               ! round brackets added to fix the order of floating point operations 
    … …  
    482466         !                                !==  add the vertical 33 flux  ==! 
    483467         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    484             ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    485468            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    486469               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    … …  
    491474            SELECT CASE( kpass ) 
    492475            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    493                ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    494476               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    495477                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    … …  
    497479               END_3D 
    498480            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    499                ! [comm_cleanup] ! DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    500481               DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    501482                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    … …  
    506487         ENDIF 
    507488         ! 
    508          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
    509489         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
    510490            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 

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

    r14538 r14757  
    110110         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    111111         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    112             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    113112            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    114113               zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 
    … …  
    116115            END_2D 
    117116         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    118             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    119117            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    120118               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    … …  
    122120            END_2D 
    123121         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    124             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    125122            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    126123               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    … …  
    129126         END SELECT 
    130127         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    131             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    132128            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    133129               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & 
    … …  
    141137            ! 
    142138         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    143             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    144139            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    145140               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               & 
    … …  
    154149         !                                      !==  MLD used for MLE  ==! 
    155150         !                                                ! compute from the 10m density to deal with the diurnal cycle 
    156          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    157151         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    158152            inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
    159153         END_2D 
    160154         IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    161            ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
    162155           DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
    163156              IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
    … …  
    170163         zbm (:,:) = 0._wp 
    171164         zn2 (:,:) = 0._wp 
    172          ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
    173165         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
    174166            zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    … …  
    180172         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    181173         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    182             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    183174            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    184175               zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
    … …  
    186177            END_2D 
    187178         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    188             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    189179            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    190180               zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
    … …  
    192182            END_2D 
    193183         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    194             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    195184            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    196185               zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
    … …  
    199188         END SELECT 
    200189         !                                                ! convert density into buoyancy 
    201          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    202190         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    203191            zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
    … …  
    213201         ! 
    214202         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    215             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    216203            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    217204               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
    … …  
    225212            ! 
    226213         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    227             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    228214            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    229215               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    … …  
    236222         ! 
    237223         IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
    238             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    239224            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    240225               IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
    … …  
    245230      ENDIF  ! end of ln_osm_mle conditional 
    246231    !                                      !==  structure function value at uw- and vw-points  ==! 
    247     ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    248232    DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    249233       zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu 
    … …  
    254238    zpsi_vw(:,:,:) = 0._wp 
    255239    ! 
    256       ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 
    257240      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0 
    258241       
    … …  
    270253      !                                      !==  transport increased by the MLE induced transport ==! 
    271254      DO jk = 1, ikmax 
    272          ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 
    273255         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    274256            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    275257            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    276258         END_2D 
    277          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    278259         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    279260            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
    … …  
    290271         ! 
    291272         IF (ln_osm_mle.and.ln_zdfosm) THEN 
    292             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    293273            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    294274               zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    295275            END_2D 
    296276         ELSE 
    297             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    298277            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    299278               zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    … …  
    302281         ! 
    303282         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    304          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 
    305283         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) 
    306284            zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 

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

    r14667 r14757  
    169169      END DO 
    170170      ! 
    171       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     171      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    172172      ! 
    173173      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    202202            ENDIF 
    203203         END_2D 
    204          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     204         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    205205         ! 
    206206      END IF 
    … …  
    350350      END DO 
    351351      ! 
    352       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     352      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    353353 
    354354      ! horizontal derivative of density anomalies (rd) 
    … …  
    392392         END_2D 
    393393 
    394          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     394         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    395395         ! 
    396396      END IF 
    … …  
    443443         ! 
    444444      END DO 
    445       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     445      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    446446 
    447447      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    482482 
    483483         END_2D 
    484          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
     484         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    485485         ! 
    486486      END IF 

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

    r14601 r14757  
    9595!!gm                            and many acces in memory 
    9696          
    97          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    9897         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    9998            zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    … …  
    112111         END_2D 
    113112 
    114          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )           !==  indicators  ==! 
    115113         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )           !==  indicators  ==! 
    116114            ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    … …  
    143141         ! ------------------ 
    144142         ! Constant eddy coefficient: reset to the background value 
    145          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    146143         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    147144            zinr = 1._wp / zrau(ji,jj) 

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

    r14601 r14757  
    117117      ! 
    118118      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    119          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    120119         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    121120            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    … …  
    130129         END_2D 
    131130      ELSE                                            !==  standard Cd  ==! 
    132          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    133131         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    134132            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    … …  
    178176      ENDIF 
    179177 
    180       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    181178      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    182179         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
    … …  
    192189      ! 
    193190      IF( ln_isfcav ) THEN        ! ocean cavities 
    194          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    195191         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    196192            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
    … …  
    436432            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    437433            ! 
    438             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
    439434            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
    440435               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 

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

    r14601 r14757  
    8787!         END WHERE 
    8888         ! 
    89          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    9089         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    9190            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    … …  
    104103!         END WHERE 
    105104 
    106          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    107105         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    108106            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 

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

    r14601 r14757  
    179179 
    180180      ! Compute surface, top and bottom friction at T-points 
    181       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )          !==  surface ocean friction 
    182181      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          !==  surface ocean friction  
    183182         ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)   ! surface friction 
    … …  
    187186      ! 
    188187      IF( .NOT.ln_drg_OFF ) THEN     !== top/bottom friction   (explicit before friction) 
    189          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )         ! bottom friction (explicit before friction) 
    190188         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          ! bottom friction (explicit before friction) 
    191189            zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    … …  
    195193         END_2D 
    196194         IF( ln_isfcav ) THEN 
    197             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )      ! top friction 
    198195            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )      ! top friction 
    199196               zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    … …  
    223220      zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro 
    224221      ! 
    225       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    226222      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    227223         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
    … …  
    233229 
    234230      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada 
    235          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    236231         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    237232            zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
    … …  
    255250      ! Warning : after this step, en : right hand side of the matrix 
    256251 
    257       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    258252      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    259253         ! 
    … …  
    333327      ! at k=2, set de/dz=Fw 
    334328      !cbr 
    335       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
    336329      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )   ! zdiag zd_lw not defined/used on the halo 
    337330         zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    … …  
    355348         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    356349         !                      ! Balance between the production and the dissipation terms 
    357          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    358350         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    359351!!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ???? 
    … …  
    374366         ! 
    375367         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    376             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    377368            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    378369               itop   = mikt(ji,jj)       ! k   top w-point 
    … …  
    393384      CASE ( 1 )             ! Neumman boundary condition 
    394385         ! 
    395          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    396386         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    397387            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    … …  
    409399         END_2D 
    410400         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    411             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    412401            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    413402               itop   = mikt(ji,jj)       ! k   top w-point 
    … …  
    431420      ! ---------------------------------------------------------- 
    432421      ! 
    433       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1  
    434422      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    435423         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    436424      END_3D 
    437       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    438425      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    439426         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    440427      END_3D 
    441       ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    442428      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    443429         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    … …  
    455441      ! 
    456442      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    457          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    458443         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    459444            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
    … …  
    461446         ! 
    462447      CASE( 1 )               ! k-eps 
    463          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    464448         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    465449            psi(ji,jj,jk)  = eps(ji,jj,jk) 
    … …  
    467451         ! 
    468452      CASE( 2 )               ! k-w 
    469          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    470453         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    471454            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
    … …  
    473456         ! 
    474457      CASE( 3 )               ! generic 
    475          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    476458         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    477459            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
    … …  
    487469      ! Warning : after this step, en : right hand side of the matrix 
    488470 
    489       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    490471      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    491472         ! 
    … …  
    560541         ! 
    561542         ! Neumann condition at k=2 
    562          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
    563543         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )   ! zdiag zd_lw not defined/used on the halo 
    564544            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    … …  
    589569         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    590570         !                      ! Balance between the production and the dissipation terms 
    591          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    592571         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    593572            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    … …  
    609588      CASE ( 1 )             ! Neumman boundary condition 
    610589         ! 
    611          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    612590         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    613591            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    … …  
    638616      ! ---------------- 
    639617      ! 
    640       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1  
    641618      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    642619         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    643620      END_3D 
    644       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    645621      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    646622         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    647623      END_3D 
    648       ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    649624      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    650625         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    … …  
    657632      ! 
    658633      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    659          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    660634         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    661635            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 
    … …  
    663637         ! 
    664638      CASE( 1 )               ! k-eps 
    665          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    666639         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    667640            eps(ji,jj,jk) = psi(ji,jj,jk) 
    … …  
    669642         ! 
    670643      CASE( 2 )               ! k-w 
    671          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    672644         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    673645            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
    … …  
    678650         zex1  =      ( 1.5_wp + rmm/rnn ) 
    679651         zex2  = -1._wp / rnn 
    680          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    681652         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    682653            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
    … …  
    687658      ! Limit dissipation rate under stable stratification 
    688659      ! -------------------------------------------------- 
    689       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
    690660      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
    691661         ! limitation 
    … …  
    704674      ! 
    705675      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions 
    706          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    707676         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    708677            ! zcof =  l²/q² 
    … …  
    722691         ! 
    723692      CASE ( 2, 3 )               ! Canuto stability functions 
    724          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    725693         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    726694            ! zcof =  l²/q² 
    … …  
    755723      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    756724      zstm(:,:,jpk) = 0. 
    757       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )             ! update bottom with good values 
    758725      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! update bottom with good values 
    759726         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    … …  
    771738      !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 
    772739      !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 
    773       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 
    774740      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    775741         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 

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

    r14601 r14757  
    143143      ! Set to zero the 1st and last vertical levels of appropriate variables 
    144144      IF( iom_use("emix_iwm") ) THEN 
    145          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    146145         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    147146            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
    … …  
    149148      ENDIF 
    150149      IF( iom_use("av_ratio") ) THEN 
    151          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    152150         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    153151            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
    … …  
    155153      ENDIF 
    156154      IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 
    157          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    158155         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    159156            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
    … …  
    167164      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    168165      !                                                 using an exponential decay from the seafloor. 
    169       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )             ! part independent of the level 
    170166      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! part independent of the level 
    171167         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    … …  
    174170      END_2D 
    175171!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    176       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! complete with the level-dependent part 
    177172      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! complete with the level-dependent part 
    178173         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    … …  
    195190      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    196191         ! 
    197          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    198192         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    199193            zfact(ji,jj) = 0._wp 
    200194         END_2D 
    201          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    202195         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    203196            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    204197         END_3D 
    205198         ! 
    206          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    207199         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    208200            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    209201         END_2D 
    210202         ! 
    211          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
    212203         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    213204            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    … …  
    216207      CASE ( 2 )               ! Dissipation scales as N^2 
    217208         ! 
    218          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    219209         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    220210            zfact(ji,jj) = 0._wp 
    221211         END_2D 
    222          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    223212         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    224213            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    225214         END_3D 
    226215         ! 
    227          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    228216         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    229217            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    230218         END_2D 
    231219         ! 
    232          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    233220         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    234221            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    … …  
    240227      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    241228      ! 
    242       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    243229      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244230         zwkb(ji,jj,1) = 0._wp 
    245231      END_2D 
    246       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    247232      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    248233         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    249234      END_3D 
    250       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    251235      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    252236         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
    253237      END_2D 
    254238      ! 
    255       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    256239      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    257240         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    258241            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    259242      END_3D 
    260       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    261243      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    262244         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
    263245      END_2D 
    264246      ! 
    265       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    266247      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    267248         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    … …  
    273254      END_3D 
    274255      ! 
    275       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    276256      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    277257         zfact(ji,jj) = 0._wp 
    278258      END_2D 
    279       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
    280259      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    281260         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    282261      END_3D 
    283262      ! 
    284       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    285263      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    286264         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    287265      END_2D 
    288266      ! 
    289       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
    290267      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    291268         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
    … …  
    296273!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    297274      ! Calculate molecular kinematic viscosity 
    298       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    299275      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    300276         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
    … …  
    302278            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
    303279      END_3D 
    304       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    305280      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    306281         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    … …  
    309284      ! 
    310285      ! Calculate turbulence intensity parameter Reb 
    311       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    312286      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    313287         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    … …  
    315289      ! 
    316290      ! Define internal wave-induced diffusivity 
    317       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    318291      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    319292         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    … …  
    321294      ! 
    322295      IF( ln_mevar ) THEN                ! Variable mixing efficiency case : modify zav_wave in the 
    323          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    324296         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    325297            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    … …  
    331303      ENDIF 
    332304      ! 
    333       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
    334305      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
    335306         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    … …  
    339310         zztmp = 0._wp 
    340311!!gm used of glosum 3D.... 
    341          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    342312         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    343313            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   & 
    … …  
    362332      IF( ln_tsdiff ) THEN                !* Option for differential mixing of salinity and temperature 
    363333         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    364          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
    365334         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
    366335            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    … …  
    372341         END_3D 
    373342         CALL iom_put( "av_ratio", zav_ratio ) 
    374          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    375343         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    376344            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    … …  
    380348         ! 
    381349      ELSE                                !* update momentum & tracer diffusivity with wave-driven mixing 
    382          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    383350         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    384351            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 

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

    r14601 r14757  
    218218         WHERE(zrautbm1 .NE. 0.) zfbuo(:,:)  =  grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:) 
    219219 
    220          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    221220         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    222221 
    … …  
    377376      ! 
    378377      ! 
    379       ! [comm_cleanup]  
    380       IF (nn_hls.eq.1) CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
     378      IF (nn_hls==1) CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
    381379      ! 
    382380   END SUBROUTINE tra_mfc 

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

    r14601 r14757  
    9999      hmlp(:,:)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2 
    100100      zN2_c = grav * rho_c * r1_rho0      ! convert density criteria into N^2 criteria 
    101       ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 )   ! Mixed layer level: w-level 
    102101      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 )   ! Mixed layer level: w-level 
    103102         ikt = mbkt(ji,jj) 
    … …  
    109108      ! w-level of the turbocline and mixing layer (iom_use) 
    110109      imld(:,:) = mbkt(:,:) + 1                ! Initialization to the number of w ocean point 
    111       ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
    112110      DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
    113111         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    114112      END_3D 
    115113      ! depth of the mixing and mixed layers 
    116       ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    117114      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    118115         iiki = imld(ji,jj) 

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

    r14601 r14757  
    284284      CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
    285285      CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
    286       ! [comm_cleanup] ! modified but not tested - no ref config uses this scheme 
    287286      CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
    288287!     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    … …  
    323322 
    324323      !                                         !* Lateral boundary conditions (sign unchanged) 
    325       ! [comm_cleanup] ! lbc_lnk shifted in stp 
    326       IF(nn_hls.eq.1) THEN  
     324      IF(nn_hls==1) THEN  
    327325         IF( l_zdfsh2 ) THEN 
    328326            CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 

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

    r14601 r14757  
    156156      ! 
    157157      !                       !==  avm and avt = F(Richardson number)  ==! 
    158       ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
    159158      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
    160159         zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  ) 
    … …  
    170169      IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==! 
    171170         ! 
    172          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )             !* Ekman depth 
    173171         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )  
    174172            zustar = SQRT( taum(ji,jj) * r1_rho0 ) 
    … …  
    176174            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
    177175         END_2D 
    178          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
    179176         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
    180177            IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 

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

    r14601 r14757  
    6565      DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form) 
    6666         IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution 
    67             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 
    6867            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    6968               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        & 
    … …  
    7978            END_2D 
    8079         ELSE 
    81             ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    8280            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    8381               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    … …  
    9391            END_2D 
    9492         ENDIF 
    95          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    9693         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    9794            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 

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

    r14601 r14757  
    6363      ! 
    6464      zcoef = 1._wp * 0.353553_wp 
    65       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    6665      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    6766         zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 

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

    r14601 r14757  
    241241      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    242242      ! 
    243       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    244243      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    245244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) 
    … …  
    259258      IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE 
    260259         ! 
    261          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )        ! bottom friction 
    262260         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )        ! bottom friction 
    263261            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    … …  
    269267         END_2D 
    270268         IF( ln_isfcav ) THEN 
    271             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )     ! top friction 
    272269            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     ! top friction  
    273270               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    … …  
    297294!!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 
    298295!!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect ! 
    299             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    300296            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    301297!!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  ) 
    … …  
    305301!  Projection of Stokes drift in the wind stress direction 
    306302! 
    307             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    308303            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    309304                  ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 
    … …  
    312307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
    313308            END_2D 
    314             ! [comm_cleanup] 
    315             IF (nn_hls.eq.1) CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
     309            IF (nn_hls==1) CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
    316310! 
    317311         ELSE                          ! Surface Stokes drift deduced from surface stress 
    … …  
    321315            !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 
    322316            zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag 
    323             ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    324317            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    325318               zWlc2(ji,jj) = zcof * taum(ji,jj) 
    … …  
    338331         !                             !- compare LHS to RHS of Eq.47 
    339332         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    340          ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
    341333         DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 ) 
    342334            IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk 
    343335         END_3D 
    344336         !                               ! finite LC depth 
    345          ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 
    346337         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    347338            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    … …  
    349340         ! 
    350341         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    351          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    352342         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    353343            zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift 
    354344            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    355345         END_2D 
    356          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
    357346         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
    358347            IF ( zus3(ji,jj) /= 0._wp ) THEN 
    … …  
    376365      ! 
    377366      IF( nn_pdl == 1 ) THEN          !* Prandtl number = F( Ri ) 
    378          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    379367         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    380368            !                             ! local Richardson number 
    … …  
    389377      ENDIF 
    390378      ! 
    391       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* Matrix and right hand side in en 
    392379      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* Matrix and right hand side in en 
    393380         zcof   = zfact1 * tmask(ji,jj,jk) 
    … …  
    419406 
    420407         CASE ( 0 ) ! Dirichlet BC 
    421             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
    422408            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
    423409               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    … …  
    427413 
    428414         CASE ( 1 ) ! Neumann BC 
    429             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    430415            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    431416               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    … …  
    442427      ! 
    443428      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    444       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    445429      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    446430         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    … …  
    450434!         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    451435!      END_2D 
    452       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    453436      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    454437         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    455438      END_3D 
    456       ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    457439      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    458440         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    459441      END_2D 
    460       ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 
    461442      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 
    462443         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    463444      END_3D 
    464       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! set the minimum value of tke 
    465445      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! set the minimum value of tke 
    466446         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    … …  
    476456      ! 
    477457      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    478          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    479458         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    480459            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    … …  
    482461         END_3D 
    483462      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    484          ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    485463         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    486464            jk = nmln(ji,jj) 
    … …  
    489467         END_2D 
    490468      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    491          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    492469         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    493470            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    … …  
    571548            zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    572549#if ! defined key_si3 && ! defined key_cice 
    573             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
    574550            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                  ! No sea-ice 
    575551               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    … …  
    579555            ! 
    580556            CASE( 0 )                      ! No scaling under sea-ice 
    581                ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    582557               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    583558                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
    … …  
    585560               ! 
    586561            CASE( 1 )                      ! scaling with constant sea-ice thickness 
    587                ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    588562               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    589563                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    … …  
    592566               ! 
    593567            CASE( 2 )                      ! scaling with mean sea-ice thickness 
    594                ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    595568               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    596569#if defined key_si3 
    … …  
    605578               ! 
    606579            CASE( 3 )                      ! scaling with max sea-ice thickness 
    607                ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    608580               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    609581                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    … …  
    615587#endif 
    616588            ! 
    617             ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 
    618589            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    619590               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    … …  
    625596      ENDIF 
    626597      ! 
    627       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    628598      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    629599         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    … …  
    641611      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 
    642612      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    643          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    644613         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    645614            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   & 
    … …  
    653622         ! 
    654623      CASE ( 1 )           ! bounded by the vertical scale factor 
    655          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    656624         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    657625            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 
    … …  
    661629         ! 
    662630      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    663          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! from the surface to the bottom : 
    664631         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! from the surface to the bottom : 
    665632            zmxlm(ji,jj,jk) =   & 
    666633               &    MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    667634         END_3D 
    668          ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : 
    669635         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : 
    670636            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    … …  
    674640         ! 
    675641      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    676          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : lup 
    677642         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )        ! from the surface to the bottom : lup 
    678643            zmxld(ji,jj,jk) =    & 
    679644               &    MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    680645         END_3D 
    681          ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
    682646         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
    683647            zmxlm(ji,jj,jk) =   & 
    684648               &    MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    685649         END_3D 
    686          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    687650         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    688651            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    … …  
    697660      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    698661      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    699       ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
    700662      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
    701663         zsqen = SQRT( en(ji,jj,jk) ) 
    … …  
    708670      ! 
    709671      IF( nn_pdl == 1 ) THEN          !* Prandtl number case: update avt 
    710          ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    711672         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    712673            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 

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

    r14511 r14757  
    390390      CALL mpp_init 
    391391 
     392#if ! defined key_qco && ! defined key_linssh 
     393      IF( nn_hls == 2 ) THEN 
     394         CALL ctl_stop( 'STOP', 'nemogcm : Extra-halo can not be used if key_qco is not defined' ) 
     395      ENDIF 
     396#endif 
     397#if defined key_loop_fusion 
     398      IF( nn_hls == 1 ) THEN 
     399         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 
     400      ENDIF 
     401#endif 
     402 
    392403      CALL halo_mng_init() 
    393404      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 

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

    r14682 r14757  
    168168                         CALL bn2    ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn  ) ! now    Brunt-Vaisala frequency 
    169169 
    170       ! [comm_cleanup]  
    171       IF (nn_hls.eq.2) THEN 
    172          IF( l_zdfsh2 ) THEN 
    173             CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    174                &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    175          ELSE 
    176             CALL lbc_lnk( 'stp', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    177          ENDIF 
    178       ENDIF 
    179170      !  VERTICAL PHYSICS 
    180171                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
    … …  
    224215               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    225216#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 
    233217                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    234218                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    … …  
    304288      ENDIF 
    305289#endif 
    306  
    307      ! [comm_cleanup] 
    308      IF (nn_hls.EQ.2) THEN 
    309          SELECT CASE ( nadv ) 
    310          CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    311                CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) 
    312                CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 
    313          CASE ( np_MUS )                                 ! MUSCL 
    314                 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
    315          CASE ( np_UBS )                                 ! UBS 
    316                 CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
    317          CASE ( np_QCK )                                 ! QUICKEST 
    318                CALL lbc_lnk( 'stp', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) 
    319                CALL lbc_lnk( 'stp', ts(:,:,:,:,Nbb), 'T', 1.) 
    320          END SELECT 
    321       ENDIF 
    322290 
    323291      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    … …  
    355323!! 
    356324!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    357                          ! [comm_cleanup]  
    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  
    361325                         CALL tra_atf       ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    362326                         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

    r14730 r14757  
    248248      ENDIF 
    249249 
    250       IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp) 
     250      IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp ) 
    251251 
    252252      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    275275      IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    276276      ! 
    277       IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp ) 
     277      IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp ) 
    278278#if defined key_top 
    279279      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    350350                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv     )   ! time filtering of "now" velocities 
    351351 
    352       IF( nn_hls.eq.2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 
     352      IF( nn_hls==2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 
    353353 
    354354      IF(.NOT.lk_linssh) THEN 
    … …  
    517517                       &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
    518518      ! 
    519       IF (nn_hls.eq.2) THEN 
     519      IF (nn_hls==2) THEN 
    520520         IF( l_zdfsh2 ) THEN 
    521             CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    522                 &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    523          ELSE 
    524             CALL lbc_lnk( 'stp_MLF', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     521            CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp)  
    525522         ENDIF 
    526523      ENDIF 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/SWE/stprk3.F90

    r14730 r14757  
    172172      ! 
    173173      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    174       ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
    175       IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
     174      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    176175      ! 
    177176      !                                 !==  Swap time levels  ==! 
    … …  
    239238      ! 
    240239      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    241       ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
    242       IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
     240      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    243241      ! 
    244242      !                                 !==  Swap time levels  ==! 
    … …  
    304302      ! 
    305303      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
    306       ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
    307       IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
     304      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    308305      ! 
    309306      !                                 !==  Swap time levels  ==! 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcadv.F90

    r14730 r14757  
    129129         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    130130      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    131          IF (nn_hls.EQ.2) THEN 
     131         IF (nn_hls==2) THEN 
    132132#if defined key_loop_fusion 
    133133            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    139139         END IF 
    140140      CASE ( np_MUS )                                 ! MUSCL 
    141          IF (nn_hls.EQ.2) THEN 
     141         IF (nn_hls==2) THEN 
    142142#if defined key_loop_fusion 
    143143            CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcldf.F90

    r14609 r14757  
    8383      zahv(:,:,:) = rldf * ahtv(:,:,:) 
    8484      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain 
    85       ! [ comm_cleanup ] DO_3D( 1, 1, 1, 1, 1, jpk ) 
    8685      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    8786         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
    … …  
    103102           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    104103      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
    105          IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.) 
    106104         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    107105           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 
Note: See TracChangeset for help on using the changeset viewer.