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 13295 for NEMO/trunk/src/OCE/DYN/dynhpg.F90 – NEMO

Ignore:
Timestamp:
2020-07-10T20:24:21+02:00 (4 years ago)
Author:
acc
Message:

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/DYN/dynhpg.F90

    r13288 r13295  
    257257 
    258258      ! Surface value 
    259       DO_2D_00_00 
     259      DO_2D( 0, 0, 0, 0 ) 
    260260         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
    261261         ! hydrostatic pressure gradient 
    … …  
    269269      ! 
    270270      ! interior value (2=<jk=<jpkm1) 
    271       DO_3D_00_00( 2, jpkm1 ) 
     271      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    272272         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
    273273         ! hydrostatic pressure gradient 
    … …  
    319319 
    320320      !  Surface value (also valid in partial step case) 
    321       DO_2D_00_00 
     321      DO_2D( 0, 0, 0, 0 ) 
    322322         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
    323323         ! hydrostatic pressure gradient 
    … …  
    330330 
    331331      ! interior value (2=<jk=<jpkm1) 
    332       DO_3D_00_00( 2, jpkm1 ) 
     332      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    333333         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
    334334         ! hydrostatic pressure gradient 
    … …  
    346346 
    347347      ! partial steps correction at the last level  (use zgru & zgrv computed in zpshde.F90) 
    348       DO_2D_00_00 
     348      DO_2D( 0, 0, 0, 0 ) 
    349349         iku = mbku(ji,jj) 
    350350         ikv = mbkv(ji,jj) 
    … …  
    411411      ! 
    412412      IF( ln_wd_il ) THEN 
    413         DO_2D_00_00 
     413        DO_2D( 0, 0, 0, 0 ) 
    414414          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)               ,  ssh(ji+1,jj,Kmm) ) >                & 
    415415               &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    452452 
    453453      ! Surface value 
    454       DO_2D_00_00 
     454      DO_2D( 0, 0, 0, 0 ) 
    455455         ! hydrostatic pressure gradient along s-surfaces 
    456456         zhpi(ji,jj,1) =   & 
    … …  
    481481 
    482482      ! interior value (2=<jk=<jpkm1) 
    483       DO_3D_00_00( 2, jpkm1 ) 
     483      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    484484         ! hydrostatic pressure gradient along s-surfaces 
    485485         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    … …  
    563563!===== Compute surface value =====================================================  
    564564!================================================================================== 
    565       DO_2D_00_00 
     565      DO_2D( 0, 0, 0, 0 ) 
    566566         ikt    = mikt(ji,jj) 
    567567         iktp1i = mikt(ji+1,jj) 
    … …  
    592592!================================================================================== 
    593593      ! interior value (2=<jk=<jpkm1) 
    594       DO_3D_00_00( 2, jpkm1 ) 
     594      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    595595         ! hydrostatic pressure gradient along s-surfaces 
    596596         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    … …  
    643643      IF( ln_wd_il ) THEN 
    644644         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    645         DO_2D_00_00 
     645        DO_2D( 0, 0, 0, 0 ) 
    646646          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    647647               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    699699!!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really 
    700700 
    701       DO_3D_00_00( 2, jpkm1 ) 
     701      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    702702         drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1) 
    703703         dzz  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji,jj,jk-1) 
    … …  
    716716!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj 
    717717 
    718       DO_3D_00_00( 2, jpkm1 ) 
     718      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    719719         cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1) 
    720720 
    … …  
    784784!          true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
    785785 
    786       DO_2D_00_00 
     786      DO_2D( 0, 0, 0, 0 ) 
    787787         rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) )               & 
    788788            &                   * (  rhd(ji,jj,1)                                     & 
    … …  
    795795!!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop 
    796796 
    797       DO_3D_00_00( 2, jpkm1 ) 
     797      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    798798 
    799799         rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   & 
    … …  
    830830      !  Surface value 
    831831      ! --------------- 
    832       DO_2D_00_00 
     832      DO_2D( 0, 0, 0, 0 ) 
    833833         zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
    834834         zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
    … …  
    845845      !  interior value   (2=<jk=<jpkm1) 
    846846      ! ---------------- 
    847       DO_3D_00_00( 2, jpkm1 ) 
     847      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    848848         ! hydrostatic pressure gradient along s-surfaces 
    849849         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                & 
    … …  
    911911      IF( ln_wd_il ) THEN 
    912912         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    913          DO_2D_00_00 
     913         DO_2D( 0, 0, 0, 0 ) 
    914914          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    915915               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    960960 
    961961      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    962       DO_2D_11_11 
     962      DO_2D( 1, 1, 1, 1 ) 
    963963       jk = mbkt(ji,jj) 
    964964       IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    … …  
    973973 
    974974      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    975       DO_2D_11_11 
     975      DO_2D( 1, 1, 1, 1 ) 
    976976         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 
    977977      END_2D 
    978978 
    979       DO_3D_11_11( 2, jpk ) 
     979      DO_3D( 1, 1, 1, 1, 2, jpk ) 
    980980         zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) 
    981981      END_3D 
    … …  
    990990 
    991991      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    992       DO_2D_01_01 
     992      DO_2D( 0, 1, 0, 1 ) 
    993993       zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
    994994          &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
    … …  
    999999 
    10001000      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    1001       DO_3D_01_01( 2, jpkm1 ) 
     1001      DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 
    10021002      zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
    10031003         &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
    … …  
    10091009 
    10101010      ! Prepare zsshu_n and zsshv_n 
    1011       DO_2D_00_00 
     1011      DO_2D( 0, 0, 0, 0 ) 
    10121012!!gm BUG ?    if it is ssh at u- & v-point then it should be: 
    10131013!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & 
    … …  
    10241024      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
    10251025 
    1026       DO_2D_00_00 
     1026      DO_2D( 0, 0, 0, 0 ) 
    10271027       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad)  
    10281028       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 
    10291029      END_2D 
    10301030 
    1031       DO_3D_00_00( 2, jpkm1 ) 
     1031      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    10321032      zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
    10331033      zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
    10341034      END_3D 
    10351035 
    1036       DO_3D_00_00( 1, jpkm1 ) 
     1036      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10371037      zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
    10381038      zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
    10391039      END_3D 
    10401040 
    1041       DO_3D_00_00( 1, jpkm1 ) 
     1041      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10421042      zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    10431043      zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    … …  
    10471047 
    10481048 
    1049       DO_3D_00_00( 1, jpkm1 ) 
     1049      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10501050      zpwes = 0._wp; zpwed = 0._wp 
    10511051      zpnss = 0._wp; zpnsd = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.