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/TRA/traadv_cen.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/TRA/traadv_cen.F90

    r12377 r13540  
    3737   !! * Substitutions 
    3838#  include "do_loop_substitute.h90" 
     39#  include "domzgr_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    103104         ! 
    104105         CASE(  2  )                         !* 2nd order centered 
    105             DO_3D_10_10( 1, jpkm1 ) 
     106            DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    106107               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) ) 
    107108               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) ) 
    … …  
    111112            ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero 
    112113            ztv(:,:,jpk) = 0._wp 
    113             DO_3D_00_00( 1, jpkm1 ) 
     114            DO_3D( 0, 0, 0, 0, 1, jpkm1 )          ! masked gradient 
    114115               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    115116               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    116117            END_3D 
    117             CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. 
     118            CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    118119            ! 
    119             DO_3D_00_10( 1, jpkm1 ) 
     120            DO_3D( 0, 0, 0, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
    120121               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2) 
    121122               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    … …  
    127128               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    128129            END_3D 
     130            CALL lbc_lnk_multi( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
    129131            ! 
    130132         CASE DEFAULT 
    131             CALL ctl_stop( 'traadv_fct: wrong value for nn_fct' ) 
     133            CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' ) 
    132134         END SELECT 
    133135         ! 
    … …  
    135137         ! 
    136138         CASE(  2  )                         !* 2nd order centered 
    137             DO_3D_00_00( 2, jpk ) 
     139            DO_3D( 0, 0, 0, 0, 2, jpk ) 
    138140               zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk) 
    139141            END_3D 
    … …  
    141143         CASE(  4  )                         !* 4th order compact 
    142144            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )      ! ztw = interpolated value of T at w-point 
    143             DO_3D_00_00( 2, jpkm1 ) 
     145            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    144146               zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    145147            END_3D 
    … …  
    149151         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask) 
    150152            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    151                DO_2D_11_11 
     153               DO_2D( 1, 1, 1, 1 ) 
    152154                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)  
    153155               END_2D 
    … …  
    157159         ENDIF 
    158160         !                
    159          DO_3D_00_00( 1, jpkm1 ) 
     161         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !--  Divergence of advective fluxes  --! 
    160162            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)    & 
    161163               &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
    162164               &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    & 
    163                &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     165               &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) & 
     166               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    164167         END_3D 
    165          !                             ! trend diagnostics 
     168         !                               ! trend diagnostics 
    166169         IF( l_trd ) THEN 
    167170            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
Note: See TracChangeset for help on using the changeset viewer.