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/dynldf_iso.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/dynldf_iso.F90

    r12377 r13540  
    4242   !! * Substitutions 
    4343#  include "do_loop_substitute.h90" 
     44#  include "domzgr_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    4546   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    127128      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    128129         ! 
    129          DO_3D_00_00( 1, jpk ) 
     130         DO_3D( 0, 0, 0, 0, 1, jpk )      ! set the slopes of iso-level 
    130131            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    131132            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    … …  
    134135         END_3D 
    135136         ! Lateral boundary conditions on the slopes 
    136          CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. ) 
     137         CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    137138         ! 
    138139       ENDIF 
    … …  
    167168 
    168169         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u) 
    169             DO_2D_00_01 
    170                zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u(ji,jj,jk,Kmm), e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) 
     170            DO_2D( 0, 0, 0, 1 ) 
     171               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj)   & 
     172                  &    * MIN( e3u(ji  ,jj,jk,Kmm),                & 
     173                  &           e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) 
    171174 
    172175               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
    … …  
    180183            END_2D 
    181184         ELSE                   ! other coordinate system (zco or sco) : e3t 
    182             DO_2D_00_01 
    183                zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) 
     185            DO_2D( 0, 0, 0, 1 ) 
     186               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b )   & 
     187                  &     * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) 
    184188 
    185189               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
    … …  
    195199 
    196200         ! j-flux at f-point 
    197          DO_2D_10_10 
    198             zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) 
     201         DO_2D( 1, 0, 1, 0 ) 
     202            zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b )   & 
     203               &     * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) 
    199204 
    200205            zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
    … …  
    214219         ! i-flux at f-point              |   t   | 
    215220 
    216          DO_2D_00_10 
    217             zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) 
     221         DO_2D( 0, 0, 1, 0 ) 
     222            zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b )   & 
     223               &     * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) 
    218224 
    219225            zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
    … …  
    229235         ! j-flux at t-point 
    230236         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u) 
    231             DO_2D_01_10 
    232                zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v(ji,jj,jk,Kmm), e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) 
     237            DO_2D( 0, 1, 1, 0 ) 
     238               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj)   & 
     239                  &     * MIN( e3v(ji,jj  ,jk,Kmm),                 & 
     240                  &            e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) 
    233241 
    234242               zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
    … …  
    242250            END_2D 
    243251         ELSE                   ! other coordinate system (zco or sco) : e3t 
    244             DO_2D_01_10 
    245                zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) 
     252            DO_2D( 0, 1, 1, 0 ) 
     253               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b )   & 
     254                  &     * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) 
    246255 
    247256               zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    … …  
    259268         ! Second derivative (divergence) and add to the general trend 
    260269         ! ----------------------------------------------------------- 
    261          DO_2D_00_00 
     270         DO_2D( 0, 0, 0, 0 )      !!gm Question vectop possible??? !!bug 
    262271            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (  ziut(ji+1,jj) - ziut(ji,jj  )    & 
    263                &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     272               &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj)   & 
     273               &                           / e3u(ji,jj,jk,Kmm) 
    264274            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    & 
    265                &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     275               &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj)   & 
     276               &                           / e3v(ji,jj,jk,Kmm) 
    266277         END_2D 
    267278         !                                             ! =============== 
    … …  
    375386         DO jk = 1, jpkm1 
    376387            DO ji = 2, jpim1 
    377                puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
    378                pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     388               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj)   & 
     389                  &               / e3u(ji,jj,jk,Kmm) 
     390               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj)   & 
     391                  &               / e3v(ji,jj,jk,Kmm) 
    379392            END DO 
    380393         END DO 
Note: See TracChangeset for help on using the changeset viewer.