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_ubs.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (3 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_ubs.F90

    r12377 r13540  
    3939   !! * Substitutions 
    4040#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    8283      !! 
    8384      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.  
    84       !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
     85      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731�1741. 
    8586      !!---------------------------------------------------------------------- 
    8687      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index 
     
    123124         !                                                       ! =========== 
    124125         !                                               
    125          DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==! 
    126             DO_2D_10_10 
     126         DO jk = 1, jpkm1                !==  horizontal laplacian of before tracer ==! 
     127            DO_2D( 1, 0, 1, 0 )                   ! First derivative (masked gradient) 
    127128               zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    128129               zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     
    130131               ztv(ji,jj,jk) = zeev * ( pt(ji  ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    131132            END_2D 
    132             DO_2D_00_00 
     133            DO_2D( 0, 0, 0, 0 )                   ! Second derivative (divergence) 
    133134               zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 
    134135               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
     
    137138            !                                     
    138139         END DO          
    139          CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1. )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
     140         CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    140141         !     
    141          DO_3D_10_10( 1, jpkm1 ) 
    142             zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )      ! upstream transport (x2) 
     142         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 
     143            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )        ! upstream transport (x2) 
    143144            zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 
    144145            zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) 
     
    155156         ! 
    156157         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==! 
    157             DO_2D_00_00 
     158            DO_2D( 0, 0, 0, 0 ) 
    158159               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)                        & 
    159160                  &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
    160                   &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     161                  &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) & 
     162                  &                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    161163            END_2D 
    162164            !                                              
     
    164166         ! 
    165167         zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
    166          !                                            ! and/or in trend diagnostic (l_trd=T)  
     168         !                                                ! and/or in trend diagnostic (l_trd=T)  
    167169         !                 
    168170         IF( l_trd ) THEN                  ! trend diagnostics 
     
    185187            IF( l_trd )   zltv(:,:,:) = pt(:,:,:,jn,Krhs)          ! store pt(:,:,:,:,Krhs) if trend diag. 
    186188            ! 
    187             !                          !*  upstream advection with initial mass fluxes & intermediate update  ==! 
    188             DO_3D_11_11( 2, jpkm1 ) 
     189            !                               !*  upstream advection with initial mass fluxes & intermediate update  ==! 
     190            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    189191               zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 
    190192               zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 
    191193               ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb)  ) * wmask(ji,jj,jk) 
    192194            END_3D 
    193             IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked) 
    194                IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface 
    195                   DO_2D_11_11 
     195            IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked) 
     196               IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface 
     197                  DO_2D( 1, 1, 1, 1 ) 
    196198                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
    197199                  END_2D 
    198                ELSE                                ! no cavities: only at the ocean surface 
     200               ELSE                                   ! no cavities: only at the ocean surface 
    199201                  ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 
    200202               ENDIF 
    201203            ENDIF 
    202204            ! 
    203             DO_3D_00_00( 1, jpkm1 ) 
    204                ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     205            DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* trend and after field with monotonic scheme 
     206               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    & 
     207                  &     * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    205208               pt(ji,jj,jk,jn,Krhs) =   pt(ji,jj,jk,jn,Krhs) +  ztak  
    206209               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    207210            END_3D 
    208             CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
     211            CALL lbc_lnk( 'traadv_ubs', zti, 'T', 1.0_wp )      ! Lateral boundary conditions on zti, zsi   (unchanged sign) 
    209212            ! 
    210213            !                          !*  anti-diffusive flux : high order minus low order 
    211             DO_3D_11_11( 2, jpkm1 ) 
     214            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    212215               ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    213216                  &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk) 
     
    220223         CASE(  4  )                               ! 4th order COMPACT 
    221224            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )         ! 4th order compact interpolation of T at w-point 
    222             DO_3D_00_00( 2, jpkm1 ) 
     225            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    223226               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    224227            END_3D 
     
    227230         END SELECT 
    228231         ! 
    229          DO_3D_00_00( 1, jpkm1 ) 
    230             pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     232         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !  final trend with corrected fluxes 
     233            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    & 
     234               &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    231235         END_3D 
    232236         ! 
    233          IF( l_trd )  THEN       ! vertical advective trend diagnostics 
    234             DO_3D_00_00( 1, jpkm1 ) 
     237         IF( l_trd )  THEN               ! vertical advective trend diagnostics 
     238            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w]) 
    235239               zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          & 
    236240                  &           + pt(ji,jj,jk,jn,Kmm) * (  pW(ji,jj,jk) - pW(ji,jj,jk+1)  )   & 
     
    270274      !!---------------------------------------------------------------------- 
    271275      ! 
    272       zbig  = 1.e+40_wp 
     276      zbig  = 1.e+38_wp 
    273277      zrtrn = 1.e-15_wp 
    274278      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
     
    282286      DO jk = 1, jpkm1     ! search maximum in neighbourhood 
    283287         ikm1 = MAX(jk-1,1) 
    284          DO_2D_00_00 
     288         DO_2D( 0, 0, 0, 0 ) 
    285289            zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   & 
    286290               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   & 
     
    294298      DO jk = 1, jpkm1     ! search minimum in neighbourhood 
    295299         ikm1 = MAX(jk-1,1) 
    296          DO_2D_00_00 
     300         DO_2D( 0, 0, 0, 0 ) 
    297301            zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   & 
    298302               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   & 
     
    306310      ! Positive and negative part of fluxes and beta terms 
    307311      ! --------------------------------------------------- 
    308       DO_3D_00_00( 1, jpkm1 ) 
     312      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    309313         ! positive & negative part of the flux 
    310314         zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) ) 
     
    318322      ! monotonic flux in the k direction, i.e. pcc 
    319323      ! ------------------------------------------- 
    320       DO_3D_00_00( 2, jpkm1 ) 
     324      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    321325         za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 
    322326         zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 
    323          zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) ) 
     327         zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) ) 
    324328         pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 
    325329      END_3D 
Note: See TracChangeset for help on using the changeset viewer.