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

    r12377 r13540  
    4141   !! * Substitutions 
    4242#  include "do_loop_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    141142         ! 
    142143!!gm why not using a SHIFT instruction... 
    143          DO_3D_00_00( 1, jpkm1 ) 
     144         DO_3D( 0, 0, 0, 0, 1, jpkm1 )     !--- Computation of the ustream and downstream value of the tracer and the mask 
    144145            zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer 
    145146            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    146147         END_3D 
    147          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     148         CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    148149          
    149150         ! 
    150151         ! Horizontal advective fluxes 
    151152         ! --------------------------- 
    152          DO_3D_00_00( 1, jpkm1 ) 
    153             zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     153         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     154            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    154155            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    155156         END_3D 
    156157         ! 
    157          DO_3D_00_00( 1, jpkm1 ) 
    158             zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     158         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     159            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    159160            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    160161            zwx(ji,jj,jk)  = ABS( pU(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    … …  
    163164         END_3D 
    164165         !--- Lateral boundary conditions  
    165          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1.,  zwx(:,:,:), 'T', 1. ) 
     166         CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    166167 
    167168         !--- QUICKEST scheme 
    … …  
    169170         ! 
    170171         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    171          DO_3D_00_00( 1, jpkm1 ) 
     172         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    172173            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    173174         END_3D 
    174          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions  
     175         CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions  
    175176 
    176177         ! 
    … …  
    178179         DO jk = 1, jpkm1   
    179180            ! 
    180             DO_2D_00_00 
    181                zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     181            DO_2D( 0, 0, 0, 0 ) 
     182               zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    182183               !--- If the second ustream point is a land point 
    183184               !--- the flux is computed by the 1st order UPWIND scheme 
    … …  
    188189         END DO 
    189190         ! 
    190          CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1. ) ! Lateral boundary conditions 
     191         CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    191192         ! 
    192193         ! Computation of the trend 
    193          DO_3D_00_00( 1, jpkm1 ) 
     194         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    194195            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    195196            ! horizontal advective trends 
    … …  
    232233            !                                              
    233234            !--- Computation of the ustream and downstream value of the tracer and the mask 
    234             DO_2D_00_00 
     235            DO_2D( 0, 0, 0, 0 ) 
    235236               ! Upstream in the x-direction for the tracer 
    236237               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
    … …  
    239240            END_2D 
    240241         END DO 
    241          CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     242         CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions  
    242243 
    243244          
    … …  
    246247         ! --------------------------- 
    247248         ! 
    248          DO_3D_00_00( 1, jpkm1 ) 
    249             zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     249         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     250            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    250251            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    251252         END_3D 
    252253         ! 
    253          DO_3D_00_00( 1, jpkm1 ) 
    254             zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     254         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     255            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    255256            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    256257            zwy(ji,jj,jk)  = ABS( pV(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    … …  
    260261 
    261262         !--- Lateral boundary conditions  
    262          CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1. , zfd(:,:,:), 'T', 1., zfc(:,:,:), 'T', 1., zwy(:,:,:), 'T', 1. ) 
     263         CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    263264 
    264265         !--- QUICKEST scheme 
    … …  
    266267         ! 
    267268         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    268          DO_3D_00_00( 1, jpkm1 ) 
     269         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    269270            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    270271         END_3D 
    271          CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions  
     272         CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions  
    272273         ! 
    273274         ! Tracer flux on the x-direction 
    274275         DO jk = 1, jpkm1   
    275276            ! 
    276             DO_2D_00_00 
    277                zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
     277            DO_2D( 0, 0, 0, 0 ) 
     278               zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0  
    278279               !--- If the second ustream point is a land point 
    279280               !--- the flux is computed by the 1st order UPWIND scheme 
    … …  
    284285         END DO 
    285286         ! 
    286          CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1. ) ! Lateral boundary conditions 
     287         CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 
    287288         ! 
    288289         ! Computation of the trend 
    289          DO_3D_00_00( 1, jpkm1 ) 
     290         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    290291            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    291292            ! horizontal advective trends 
    … …  
    326327         !                                                       ! =========== 
    327328         ! 
    328          DO_3D_00_00( 2, jpkm1 ) 
     329         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       !* Interior point   (w-masked 2nd order centered flux) 
    329330            zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk) 
    330331         END_3D 
    331332         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
    332333            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    333                DO_2D_11_11 
     334               DO_2D( 1, 1, 1, 1 ) 
    334335                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface  
    335336               END_2D 
    … …  
    339340         ENDIF 
    340341         ! 
    341          DO_3D_00_00( 1, jpkm1 ) 
     342         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !==  Tracer flux divergence added to the general trend  ==! 
    342343            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    343344               &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    … …  
    368369      !---------------------------------------------------------------------- 
    369370      ! 
    370       DO_3D_11_11( 1, jpkm1 ) 
     371      DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    371372         zc     = puc(ji,jj,jk)                         ! Courant number 
    372373         zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) 
Note: See TracChangeset for help on using the changeset viewer.