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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_cen.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals
      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRA/traadv_cen.F90

    r10425 r12928  
    3636 
    3737   !! * Substitutions 
    38 #  include "vectopt_loop_substitute.h90" 
     38#  include "do_loop_substitute.h90" 
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4444CONTAINS 
    4545 
    46    SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     & 
    47       &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
     46   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pU, pV, pW,     & 
     47      &                    Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )  
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE tra_adv_cen  *** 
     
    5959      !!                = 4  ==>> 4th order COMPACT  scheme     -      - 
    6060      !! 
    61       !! ** Action : - update pta  with the now advective tracer trends 
     61      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
    6262      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    63       !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
     63      !!             - poleward advective heat and salt transport (l_diaptr=T) 
    6464      !!---------------------------------------------------------------------- 
    65       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    66       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    67       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    68       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    69       INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    70       INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme) 
    71       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    72       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     65      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index 
     66      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs       ! ocean time level indices 
     67      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index 
     68      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     69      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
     70      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
     71      INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme) 
     72      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    7474      ! 
    7575      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    8989      l_hst = .FALSE. 
    9090      l_ptr = .FALSE. 
    91       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )        l_trd = .TRUE. 
    92       IF(   cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE.  
     91      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
     92      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )    l_ptr = .TRUE.  
    9393      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    94          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
     94         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    9595      ! 
    9696      !                     
     
    103103         ! 
    104104         CASE(  2  )                         !* 2nd order centered 
    105             DO jk = 1, jpkm1 
    106                DO jj = 1, jpjm1 
    107                   DO ji = 1, fs_jpim1   ! vector opt. 
    108                      zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) ) 
    109                      zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) ) 
    110                   END DO 
    111                END DO 
    112             END DO 
     105            DO_3D_10_10( 1, jpkm1 ) 
     106               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) ) 
     107               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) ) 
     108            END_3D 
    113109            ! 
    114110         CASE(  4  )                         !* 4th order centered 
    115111            ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero 
    116112            ztv(:,:,jpk) = 0._wp 
    117             DO jk = 1, jpkm1                       ! masked gradient 
    118                DO jj = 2, jpjm1 
    119                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    120                      ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    121                      ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    122                   END DO 
    123                END DO 
    124             END DO 
     113            DO_3D_00_00( 1, jpkm1 ) 
     114               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     115               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
     116            END_3D 
    125117            CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1. , ztv, 'V', -1. )   ! Lateral boundary cond. 
    126118            ! 
    127             DO jk = 1, jpkm1                       ! Horizontal advective fluxes 
    128                DO jj = 2, jpjm1 
    129                   DO ji = 1, fs_jpim1   ! vector opt. 
    130                      zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2) 
    131                      zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
    132                      !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    133                      zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 
    134                      zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 
    135                      !                                                  ! C4 fluxes 
    136                      zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u 
    137                      zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v 
    138                   END DO 
    139                END DO 
    140             END DO          
     119            DO_3D_00_10( 1, jpkm1 ) 
     120               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2) 
     121               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     122               !                                                  ! C4 interpolation of T at u- & v-points (x2) 
     123               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 
     124               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 
     125               !                                                  ! C4 fluxes 
     126               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u 
     127               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
     128            END_3D 
    141129            ! 
    142130         CASE DEFAULT 
     
    147135         ! 
    148136         CASE(  2  )                         !* 2nd order centered 
    149             DO jk = 2, jpk 
    150                DO jj = 2, jpjm1 
    151                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    152                      zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    153                   END DO 
    154                END DO 
    155             END DO 
     137            DO_3D_00_00( 2, jpk ) 
     138               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) 
     139            END_3D 
    156140            ! 
    157141         CASE(  4  )                         !* 4th order compact 
    158             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point 
    159             DO jk = 2, jpkm1 
    160                DO jj = 2, jpjm1 
    161                   DO ji = fs_2, fs_jpim1 
    162                      zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    163                   END DO 
    164                END DO 
    165             END DO 
     142            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )      ! ztw = interpolated value of T at w-point 
     143            DO_3D_00_00( 2, jpkm1 ) 
     144               zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
     145            END_3D 
    166146            ! 
    167147         END SELECT 
     
    169149         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask) 
    170150            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
    171                DO jj = 1, jpj 
    172                   DO ji = 1, jpi 
    173                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)  
    174                   END DO 
    175                END DO    
     151               DO_2D_11_11 
     152                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)  
     153               END_2D 
    176154            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
    177                zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
     155               zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 
    178156            ENDIF 
    179157         ENDIF 
    180158         !                
    181          DO jk = 1, jpkm1              !--  Divergence of advective fluxes  --! 
    182             DO jj = 2, jpjm1 
    183                DO ji = fs_2, fs_jpim1   ! vector opt. 
    184                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    & 
    185                      &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
    186                      &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    & 
    187                      &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    188                END DO 
    189             END DO 
    190          END DO 
     159         DO_3D_00_00( 1, jpkm1 ) 
     160            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)    & 
     161               &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
     162               &                + 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) 
     164         END_3D 
    191165         !                             ! trend diagnostics 
    192166         IF( l_trd ) THEN 
    193             CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    194             CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    195             CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
     167            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 
     168            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 
     169            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 
    196170         END IF 
    197171         !                                 ! "Poleward" heat and salt transports  
Note: See TracChangeset for help on using the changeset viewer.