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 13540 for NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/dynhpg.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/r12377_ticket2386

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 

  • NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/dynhpg.F90

    r12377 r13540  
    7676   !! * Substitutions 
    7777#  include "do_loop_substitute.h90" 
     78#  include "domzgr_substitute.h90" 
     79 
    7880   !!---------------------------------------------------------------------- 
    7981   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    255257 
    256258      ! Surface value 
    257       DO_2D_00_00 
     259      DO_2D( 0, 0, 0, 0 ) 
    258260         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
    259261         ! hydrostatic pressure gradient 
    … …  
    267269      ! 
    268270      ! interior value (2=<jk=<jpkm1) 
    269       DO_3D_00_00( 2, jpkm1 ) 
     271      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    270272         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
    271273         ! hydrostatic pressure gradient 
    … …  
    317319 
    318320      !  Surface value (also valid in partial step case) 
    319       DO_2D_00_00 
     321      DO_2D( 0, 0, 0, 0 ) 
    320322         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
    321323         ! hydrostatic pressure gradient 
    … …  
    328330 
    329331      ! interior value (2=<jk=<jpkm1) 
    330       DO_3D_00_00( 2, jpkm1 ) 
     332      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    331333         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
    332334         ! hydrostatic pressure gradient 
    … …  
    344346 
    345347      ! partial steps correction at the last level  (use zgru & zgrv computed in zpshde.F90) 
    346       DO_2D_00_00 
     348      DO_2D( 0, 0, 0, 0 ) 
    347349         iku = mbku(ji,jj) 
    348350         ikv = mbkv(ji,jj) 
    … …  
    409411      ! 
    410412      IF( ln_wd_il ) THEN 
    411         DO_2D_00_00 
     413        DO_2D( 0, 0, 0, 0 ) 
    412414          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)               ,  ssh(ji+1,jj,Kmm) ) >                & 
    413415               &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    446448          END IF 
    447449        END_2D 
    448         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     450        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    449451      END IF 
    450452 
    451453      ! Surface value 
    452       DO_2D_00_00 
     454      DO_2D( 0, 0, 0, 0 ) 
    453455         ! hydrostatic pressure gradient along s-surfaces 
    454          zhpi(ji,jj,1) = zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    & 
    455             &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj) 
    456          zhpj(ji,jj,1) = zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    & 
    457             &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj) 
     456         zhpi(ji,jj,1) =   & 
     457            &  zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    & 
     458            &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) & 
     459            &           * r1_e1u(ji,jj) 
     460         zhpj(ji,jj,1) =   & 
     461            &  zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    & 
     462            &            - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) & 
     463            &           * r1_e2v(ji,jj) 
    458464         ! s-coordinate pressure gradient correction 
    459465         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    … …  
    475481 
    476482      ! interior value (2=<jk=<jpkm1) 
    477       DO_3D_00_00( 2, jpkm1 ) 
     483      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    478484         ! hydrostatic pressure gradient along s-surfaces 
    479485         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    … …  
    557563!===== Compute surface value =====================================================  
    558564!================================================================================== 
    559       DO_2D_00_00 
     565      DO_2D( 0, 0, 0, 0 ) 
    560566         ikt    = mikt(ji,jj) 
    561567         iktp1i = mikt(ji+1,jj) 
    … …  
    586592!================================================================================== 
    587593      ! interior value (2=<jk=<jpkm1) 
    588       DO_3D_00_00( 2, jpkm1 ) 
     594      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    589595         ! hydrostatic pressure gradient along s-surfaces 
    590596         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    591             &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
    592             &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
     597            &           * (  e3w(ji+1,jj,jk,Kmm)                   & 
     598            &                  * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
     599            &              - e3w(ji  ,jj,jk,Kmm)                   & 
     600            &                  * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
    593601         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    594             &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
    595             &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
     602            &           * (  e3w(ji,jj+1,jk,Kmm)                   & 
     603            &                  * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
     604            &              - e3w(ji,jj  ,jk,Kmm)                   & 
     605            &                  * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
    596606         ! s-coordinate pressure gradient correction 
    597607         zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    … …  
    633643      IF( ln_wd_il ) THEN 
    634644         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    635         DO_2D_00_00 
     645        DO_2D( 0, 0, 0, 0 ) 
    636646          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    637647               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    669679          END IF 
    670680        END_2D 
    671         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     681        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    672682      END IF 
    673683 
    … …  
    689699!!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really 
    690700 
    691       DO_3D_00_00( 2, jpkm1 ) 
     701      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    692702         drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1) 
    693703         dzz  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji,jj,jk-1) 
    … …  
    706716!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj 
    707717 
    708       DO_3D_00_00( 2, jpkm1 ) 
     718      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    709719         cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1) 
    710720 
    … …  
    771781      !------------------------------------------------------------- 
    772782 
    773 !!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified 
    774 !          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
    775  
    776       DO_2D_00_00 
     783!!bug gm   :  e3w-gde3w(:,:,:) = 0.5*e3w  ....  and gde3w(:,:,2)-gde3w(:,:,1)=e3w(:,:,2,Kmm) ....   to be verified 
     784!          true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
     785 
     786      DO_2D( 0, 0, 0, 0 ) 
    777787         rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) )               & 
    778788            &                   * (  rhd(ji,jj,1)                                     & 
    … …  
    785795!!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop 
    786796 
    787       DO_3D_00_00( 2, jpkm1 ) 
     797      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    788798 
    789799         rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   & 
    … …  
    815825 
    816826      END_3D 
    817       CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. ) 
     827      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1.0_wp, rho_i, 'U', 1.0_wp, rho_j, 'V', 1.0_wp ) 
    818828 
    819829      ! --------------- 
    820830      !  Surface value 
    821831      ! --------------- 
    822       DO_2D_00_00 
     832      DO_2D( 0, 0, 0, 0 ) 
    823833         zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
    824834         zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
    … …  
    835845      !  interior value   (2=<jk=<jpkm1) 
    836846      ! ---------------- 
    837       DO_3D_00_00( 2, jpkm1 ) 
     847      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    838848         ! hydrostatic pressure gradient along s-surfaces 
    839849         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                & 
    … …  
    901911      IF( ln_wd_il ) THEN 
    902912         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    903          DO_2D_00_00 
     913         DO_2D( 0, 0, 0, 0 ) 
    904914          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    905915               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    … …  
    942952            ENDIF 
    943953         END_2D 
    944          CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
     954         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    945955      ENDIF 
    946956 
    … …  
    950960 
    951961      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    952       DO_2D_11_11 
    953        jk = mbkt(ji,jj)+1 
    954        IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    955        ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
     962      DO_2D( 1, 1, 1, 1 ) 
     963       jk = mbkt(ji,jj) 
     964       IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
     965       ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
    956966       ELSEIF( jk < jpkm1 ) THEN 
    957967          DO jkk = jk+1, jpk 
    958968             zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
    959                 &                      gde3w(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
     969                &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
    960970          END DO 
    961971       ENDIF 
    … …  
    963973 
    964974      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    965       DO_2D_11_11 
     975      DO_2D( 1, 1, 1, 1 ) 
    966976         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 
    967977      END_2D 
    968978 
    969       DO_3D_11_11( 2, jpk ) 
     979      DO_3D( 1, 1, 1, 1, 2, jpk ) 
    970980         zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) 
    971981      END_3D 
    … …  
    980990 
    981991      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    982       DO_2D_01_01 
     992      DO_2D( 0, 1, 0, 1 ) 
    983993       zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
    984994          &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
    … …  
    989999 
    9901000      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    991       DO_3D_01_01( 2, jpkm1 ) 
     1001      DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 
    9921002      zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
    9931003         &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
    … …  
    9991009 
    10001010      ! Prepare zsshu_n and zsshv_n 
    1001       DO_2D_00_00 
     1011      DO_2D( 0, 0, 0, 0 ) 
    10021012!!gm BUG ?    if it is ssh at u- & v-point then it should be: 
    10031013!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & 
    … …  
    10121022      END_2D 
    10131023 
    1014       CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. ) 
    1015  
    1016       DO_2D_00_00 
     1024      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
     1025 
     1026      DO_2D( 0, 0, 0, 0 ) 
    10171027       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad)  
    10181028       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 
    10191029      END_2D 
    10201030 
    1021       DO_3D_00_00( 2, jpkm1 ) 
     1031      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    10221032      zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
    10231033      zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
    10241034      END_3D 
    10251035 
    1026       DO_3D_00_00( 1, jpkm1 ) 
     1036      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10271037      zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
    10281038      zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
    10291039      END_3D 
    10301040 
    1031       DO_3D_00_00( 1, jpkm1 ) 
     1041      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10321042      zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    10331043      zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    … …  
    10371047 
    10381048 
    1039       DO_3D_00_00( 1, jpkm1 ) 
     1049      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    10401050      zpwes = 0._wp; zpwed = 0._wp 
    10411051      zpnss = 0._wp; zpnsd = 0._wp 
    … …  
    13591369   !!====================================================================== 
    13601370END MODULE dynhpg 
    1361  
Note: See TracChangeset for help on using the changeset viewer.