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

Ignore:
Timestamp:
2019-03-26T09:50:57+01:00 (5 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : introduce new T/S variables and convert tracer advection routines (including calls from TOP).

File:
1 edited

Legend:

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

    r10425 r10802  
    5454CONTAINS 
    5555 
    56    SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             & 
    57       &                                              ptb, pta, kjpt, ld_msc_ups ) 
     56   SUBROUTINE tra_adv_mus( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pwn,             & 
     57      &                                                     pt, pt_rhs, kjpt, ld_msc_ups ) 
    5858      !!---------------------------------------------------------------------- 
    5959      !!                    ***  ROUTINE tra_adv_mus  *** 
     
    6666      !!              ld_msc_ups=T :  
    6767      !! 
    68       !! ** Action : - update pta  with the now advective tracer trends 
     68      !! ** Action : - update pt_rhs  with the now advective tracer trends 
    6969      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    7070      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
     
    7575      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7676      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     77      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    7778      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    7879      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    7980      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8081      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    81       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     82      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pwn   ! 3 ocean velocity components 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt             ! before tracer field 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
    8485      ! 
    8586      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    134135            DO jj = 1, jpjm1       
    135136               DO ji = 1, fs_jpim1   ! vector opt. 
    136                   zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) ) 
    137                   zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     137                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) ) 
     138                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
    138139               END DO 
    139140           END DO 
     
    172173               DO ji = fs_2, fs_jpim1   ! vector opt. 
    173174                  ! MUSCL fluxes 
    174                   z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
     175                  z0u = SIGN( 0.5, pu(ji,jj,jk) ) 
    175176                  zalpha = 0.5 - z0u 
    176                   zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    177                   zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
    178                   zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
    179                   zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     177                  zu  = z0u - 0.5 * pu(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 
     178                  zzwx = pt(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
     179                  zzwy = pt(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
     180                  zwx(ji,jj,jk) = pu(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    180181                  ! 
    181                   z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
     182                  z0v = SIGN( 0.5, pv(ji,jj,jk) ) 
    182183                  zalpha = 0.5 - z0v 
    183                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    184                   zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
    185                   zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
    186                   zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     184                  zv  = z0v - 0.5 * pv(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 
     185                  zzwx = pt(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
     186                  zzwy = pt(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
     187                  zwy(ji,jj,jk) = pv(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    187188               END DO 
    188189            END DO 
     
    193194            DO jj = 2, jpjm1       
    194195               DO ji = fs_2, fs_jpim1   ! vector opt. 
    195                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
     196                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    196197                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    197                   &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     198                  &                                   * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    198199               END DO 
    199200           END DO 
     
    201202         !                                ! trend diagnostics 
    202203         IF( l_trd )  THEN 
    203             CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 
    204             CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
     204            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt(:,:,:,jn) ) 
     205            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt(:,:,:,jn) ) 
    205206         END IF 
    206207         !                                 ! "Poleward" heat and salt transports  
     
    215216         zwx(:,:,jpk) = 0._wp 
    216217         DO jk = 2, jpkm1                       ! interior values 
    217             zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 
     218            zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) 
    218219         END DO 
    219220         !                                !-- Slopes of tracer 
     
    242243                  zalpha = 0.5 + z0w 
    243244                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1) 
    244                   zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
    245                   zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
     245                  zzwx = pt(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
     246                  zzwy = pt(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
    246247                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 
    247248               END DO  
     
    252253               DO jj = 1, jpj 
    253254                  DO ji = 1, jpi 
    254                      zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) 
     255                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn) 
    255256                  END DO 
    256257               END DO    
    257258            ELSE                                      ! no cavities: only at the ocean surface 
    258                zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     259               zwx(:,:,1) = pwn(:,:,1) * pt(:,:,1,jn) 
    259260            ENDIF 
    260261         ENDIF 
     
    263264            DO jj = 2, jpjm1       
    264265               DO ji = fs_2, fs_jpim1   ! vector opt. 
    265                   pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     266                  pt_rhs(ji,jj,jk,jn) =  pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    266267               END DO 
    267268            END DO 
    268269         END DO 
    269270         !                                ! send trends for diagnostic 
    270          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
     271         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, pt(:,:,:,jn) ) 
    271272         ! 
    272273      END DO                     ! end of tracer loop 
Note: See TracChangeset for help on using the changeset viewer.