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 10880 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90 – NEMO

Ignore:
Timestamp:
2019-04-17T12:02:14+02:00 (5 years ago)
Author:
davestorkey
Message:

branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps:

  1. Move time indices from dom_oce.F90 to step.F90.
  2. Implement time dimension for passive tracers with independent set of time indices in trcstp.F90.
  3. Update all the traadv and trcadv modules.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90

    r10874 r10880  
    5252CONTAINS 
    5353 
    54    SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       & 
    55       &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v ) 
     54   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww,       & 
     55      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 
    5656      !!---------------------------------------------------------------------- 
    5757      !!                  ***  ROUTINE tra_adv_fct  *** 
     
    6565      !!               - corrected flux (monotonic correction)  
    6666      !! 
    67       !! ** Action : - update pta  with the now advective tracer trends 
     67      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
    6868      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
    6969      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    7070      !!---------------------------------------------------------------------- 
    71       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    72       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    73       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    74       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    75       INTEGER                              , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4) 
    76       INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    77       REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     71      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index 
     72      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices 
     73      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index 
     74      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     75      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
     76      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4) 
     77      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
     78      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pu_mm, pv_mm, pww   ! 3 ocean velocity components 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    8181      ! 
    8282      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices   
     
    125125               DO ji = 1, fs_jpim1   ! vector opt. 
    126126                  ! upstream scheme 
    127                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
    128                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
    129                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    130                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    131                   zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
    132                   zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
     127                  zfp_ui = pu_mm(ji,jj,jk) + ABS( pu_mm(ji,jj,jk) ) 
     128                  zfm_ui = pu_mm(ji,jj,jk) - ABS( pu_mm(ji,jj,jk) ) 
     129                  zfp_vj = pv_mm(ji,jj,jk) + ABS( pv_mm(ji,jj,jk) ) 
     130                  zfm_vj = pv_mm(ji,jj,jk) - ABS( pv_mm(ji,jj,jk) ) 
     131                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt(ji,jj,jk,jn,Kbb) + zfm_ui * pt(ji+1,jj  ,jk,jn,Kbb) ) 
     132                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji  ,jj+1,jk,jn,Kbb) ) 
    133133               END DO 
    134134            END DO 
     
    138138            DO jj = 1, jpj 
    139139               DO ji = 1, jpi 
    140                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    141                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    142                   zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
     140                  zfp_wk = pww(ji,jj,jk) + ABS( pww(ji,jj,jk) ) 
     141                  zfm_wk = pww(ji,jj,jk) - ABS( pww(ji,jj,jk) ) 
     142                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 
    143143               END DO 
    144144            END DO 
     
    148148               DO jj = 1, jpj 
    149149                  DO ji = 1, jpi 
    150                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     150                     zwz(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
    151151                  END DO 
    152152               END DO    
    153153            ELSE                             ! no cavities: only at the ocean surface 
    154                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     154               zwz(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kbb) 
    155155            ENDIF 
    156156         ENDIF 
     
    164164                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
    165165                  !                             ! update and guess with monotonic sheme 
    166                   pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    167                   zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
     166                  pt(ji,jj,jk,jn,Krhs) =                     pt(ji,jj,jk,jn,Krhs) +        ztra   / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     167                  zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
    168168               END DO 
    169169            END DO 
     
    184184               DO jj = 1, jpjm1 
    185185                  DO ji = 1, fs_jpim1   ! vector opt. 
    186                      zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
    187                      zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
     186                     zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 
     187                     zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) 
    188188                  END DO 
    189189               END DO 
     
    196196               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
    197197                  DO ji = 1, fs_jpim1   ! vector opt. 
    198                      ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    199                      ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     198                     ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     199                     ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    200200                  END DO 
    201201               END DO 
     
    212212               DO jj = 1, jpjm1 
    213213                  DO ji = 1, fs_jpim1   ! vector opt. 
    214                      zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points 
    215                      zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
     214                     zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points 
     215                     zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    216216                     !                                                  ! C4 minus upstream advective fluxes  
    217                      zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
    218                      zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
     217                     zwx(ji,jj,jk) =  0.5_wp * pu_mm(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
     218                     zwy(ji,jj,jk) =  0.5_wp * pv_mm(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    219219                  END DO 
    220220               END DO 
     
    227227               DO jj = 1, jpjm1 
    228228                  DO ji = 1, fs_jpim1   ! vector opt. 
    229                      ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    230                      ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     229                     ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     230                     ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    231231                  END DO 
    232232               END DO 
     
    237237               DO jj = 2, jpjm1 
    238238                  DO ji = 2, fs_jpim1   ! vector opt. 
    239                      zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
    240                      zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
     239                     zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
     240                     zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    241241                     !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    242242                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) ) 
    243243                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) ) 
    244244                     !                                                  ! C4 minus upstream advective fluxes  
    245                      zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
    246                      zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
     245                     zwx(ji,jj,jk) =  0.5_wp * pu_mm(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
     246                     zwy(ji,jj,jk) =  0.5_wp * pv_mm(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    247247                  END DO 
    248248               END DO 
     
    257257               DO jj = 2, jpjm1 
    258258                  DO ji = fs_2, fs_jpim1 
    259                      zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   & 
     259                     zwz(ji,jj,jk) =  (  pww(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    260260                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
    261261                  END DO 
     
    264264            ! 
    265265         CASE(  4  )                   !- 4th order COMPACT 
    266             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     266            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    267267            DO jk = 2, jpkm1 
    268268               DO jj = 2, jpjm1 
    269269                  DO ji = fs_2, fs_jpim1 
    270                      zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
     270                     zwz(ji,jj,jk) = ( pww(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    271271                  END DO 
    272272               END DO 
     
    282282         !        !==  monotonicity algorithm  ==! 
    283283         ! 
    284          CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
     284         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt ) 
    285285         ! 
    286286         !        !==  final trend with corrected fluxes  ==! 
     
    289289            DO jj = 2, jpjm1 
    290290               DO ji = fs_2, fs_jpim1   ! vector opt.   
    291                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     291                  pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    292292                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    293293                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) & 
    294                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     294                     &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    295295               END DO 
    296296            END DO 
     
    303303            ! 
    304304            IF( l_trd ) THEN              ! trend diagnostics 
    305                CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    306                CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    307                CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
     305               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu_mm, pt(:,:,:,jn,Kmm) ) 
     306               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv_mm, pt(:,:,:,jn,Kmm) ) 
     307               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pww, pt(:,:,:,jn,Kmm) ) 
    308308            ENDIF 
    309309            !                             ! heat/salt transport 
     
    328328 
    329329 
    330    SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
     330   SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt ) 
    331331      !!--------------------------------------------------------------------- 
    332332      !!                    ***  ROUTINE nonosc  *** 
     
    341341      !!       in-space based differencing for fluid 
    342342      !!---------------------------------------------------------------------- 
     343      INTEGER                          , INTENT(in   ) ::   Kmm             ! time level index  
    343344      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step 
    344345      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
     
    392393 
    393394               ! up & down beta terms 
    394                zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 
     395               zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 
    395396               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
    396397               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
Note: See TracChangeset for help on using the changeset viewer.