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_mus.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_mus.F90

    r12377 r13540  
    4747   !! * Substitutions 
    4848#  include "do_loop_substitute.h90" 
     49#  include "domzgr_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    5051   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    131132         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    132133         zwy(:,:,jpk) = 0._wp   
    133          DO_3D_10_10( 1, jpkm1 ) 
     134         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    134135            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    135136            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    136137         END_3D 
    137138         ! lateral boundary conditions   (changed sign) 
    138          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 
     139         CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    139140         !                                !-- Slopes of tracer 
    140141         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    141142         zslpy(:,:,jpk) = 0._wp 
    142          DO_3D_01_01( 1, jpkm1 ) 
    143             zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    144                &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    145             zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
    146                &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
    147          END_3D 
    148          ! 
    149          DO_3D_01_01( 1, jpkm1 ) 
    150             zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    151                &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    152                &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) ) 
    153             zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
    154                &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   & 
    155                &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) ) 
    156          END_3D 
    157          ! 
    158          DO_3D_00_00( 1, jpkm1 ) 
     143         DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
     144            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
     145               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     146            zslpy(ji,jj,jk) =                       ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   & 
     147               &            * ( 0.25 + SIGN( 0.25_wp, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) ) 
     148         END_3D 
     149         ! 
     150         DO_3D( 0, 1, 0, 1, 1, jpkm1 )    !-- Slopes limitation 
     151            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
     152               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
     153               &                                                     2.*ABS( zwx  (ji  ,jj,jk) ) ) 
     154            zslpy(ji,jj,jk) = SIGN( 1.0_wp, zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   & 
     155               &                                                     2.*ABS( zwy  (ji,jj-1,jk) ),   & 
     156               &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) ) 
     157         END_3D 
     158         ! 
     159         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
    159160            ! MUSCL fluxes 
    160             z0u = SIGN( 0.5, pU(ji,jj,jk) ) 
     161            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    161162            zalpha = 0.5 - z0u 
    162163            zu  = z0u - 0.5 * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
    … …  
    165166            zwx(ji,jj,jk) = pU(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    166167            ! 
    167             z0v = SIGN( 0.5, pV(ji,jj,jk) ) 
     168            z0v = SIGN( 0.5_wp, pV(ji,jj,jk) ) 
    168169            zalpha = 0.5 - z0v 
    169170            zv  = z0v - 0.5 * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
    … …  
    172173            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    173174         END_3D 
    174          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
    175          ! 
    176          DO_3D_00_00( 1, jpkm1 ) 
     175         CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
     176         ! 
     177         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend 
    177178            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    178179            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    … …  
    199200         !                                !-- Slopes of tracer 
    200201         zslpx(:,:,1) = 0._wp                   ! surface values 
    201          DO_3D_11_11( 2, jpkm1 ) 
    202             zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
    203                &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
    204          END_3D 
    205          DO_3D_11_11( 2, jpkm1 ) 
    206             zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
    207                &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   & 
    208                &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  ) 
    209          END_3D 
    210          DO_3D_00_00( 1, jpk-2 ) 
    211             z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 
     202         DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     203            zslpx(ji,jj,jk) =                        ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
     204               &            * (  0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
     205         END_3D 
     206         DO_3D( 1, 1, 1, 1, 2, jpkm1 )    !-- Slopes limitation 
     207            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
     208               &                                                     2.*ABS( zwx  (ji,jj,jk+1) ),   & 
     209               &                                                     2.*ABS( zwx  (ji,jj,jk  ) )  ) 
     210         END_3D 
     211         DO_3D( 0, 0, 0, 0, 1, jpk-2 )    !-- vertical advective flux 
     212            z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) 
    212213            zalpha = 0.5 + z0w 
    213214            zw  = z0w - 0.5 * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm) 
    … …  
    218219         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    219220            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    220                DO_2D_11_11 
     221               DO_2D( 1, 1, 1, 1 ) 
    221222                  zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 
    222223               END_2D 
    … …  
    226227         ENDIF 
    227228         ! 
    228          DO_3D_00_00( 1, jpkm1 ) 
    229             pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     229         DO_3D( 0, 0, 0, 0, 1, jpkm1 )     !-- vertical advective trend 
     230            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )   & 
     231               &                                      * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    230232         END_3D 
    231233         !                                ! send trends for diagnostic 
Note: See TracChangeset for help on using the changeset viewer.