Changeset 10802


Ignore:
Timestamp:
2019-03-26T09:50:57+01:00 (18 months 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).

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
Files:
12 edited

Legend:

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

    r10789 r10802  
    234234      ENDIF 
    235235      !                                         ! Control print 
    236       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' uu(:,:,:,ktlev1)s2 adv - Ua: ', mask1=umask,   & 
     236      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
    237237         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    238238      ! 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynvor.F90

    r10789 r10802  
    878878      IF( ln_dynvor_msk )   CALL ctl_stop( 'dyn_vor_init:   masked vorticity is not currently not available') 
    879879 
    880 !!gm  this should be removed when choosing a uu(:,:,:,ktlev)ique strategy for fmask at the coast 
     880!!gm  this should be removed when choosing a unique strategy for fmask at the coast 
    881881      ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks 
    882882      ! at angles with three ocean points and one land point 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv.F90

    r10068 r10802  
    7575CONTAINS 
    7676 
    77    SUBROUTINE tra_adv( kt ) 
     77   SUBROUTINE tra_adv( kt, ktlev1, ktlev2, ktlev3, pts_rhs ) 
    7878      !!---------------------------------------------------------------------- 
    7979      !!                  ***  ROUTINE tra_adv  *** 
     
    8181      !! ** Purpose :   compute the ocean tracer advection trend. 
    8282      !! 
    83       !! ** Method  : - Update (ua,va) with the advection term following nadv 
    84       !!---------------------------------------------------------------------- 
    85       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     83      !! ** Method  : - Update (pu_rhs,pv_rhs) with the advection term following nadv 
     84      !!---------------------------------------------------------------------- 
     85      INTEGER, INTENT(in) ::   kt                       ! ocean time-step index 
     86      INTEGER, INTENT(in) ::   ktlev1, ktlev2, ktlev3   ! time level indices for source terms 
     87      REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
    8688      ! 
    8789      INTEGER ::   jk   ! dummy loop index 
     
    103105      IF( ln_wave .AND. ln_sdw )  THEN 
    104106         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    105             zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
    106             zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
    107             zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
     107            zun(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,ktlev2) * ( uu(:,:,jk,ktlev2) + usd(:,:,jk) ) 
     108            zvn(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,ktlev2) * ( vv(:,:,jk,ktlev2) + vsd(:,:,jk) ) 
     109            zwn(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    108110         END DO 
    109111      ELSE 
    110112         DO jk = 1, jpkm1 
    111             zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only 
    112             zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    113             zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     113            zun(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,ktlev2) * uu(:,:,jk,ktlev2)               ! eulerian transport only 
     114            zvn(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,ktlev2) * vv(:,:,jk,ktlev2) 
     115            zwn(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk) 
    114116         END DO 
    115117      ENDIF 
     
    139141      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    140142         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    141          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    142          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     143         ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) 
     144         ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) 
    143145      ENDIF 
    144146      ! 
     
    146148      ! 
    147149      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    148          CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
     150         CALL tra_adv_cen    ( kt, nit000, ktlev2, 'TRA',         zun, zvn, zwn     , ts(:,:,:,:,ktlev2), pts_rhs, jpts, nn_cen_h, nn_cen_v ) 
    149151      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    150          CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
     152         CALL tra_adv_fct    ( kt, nit000, ktlev1, ktlev2, ktlev3, 'TRA', r2dt, zun, zvn, zwn,                      & 
     153     &                         ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts, nn_fct_h, nn_fct_v ) 
    151154      CASE ( np_MUS )                                 ! MUSCL 
    152          CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
     155         CALL tra_adv_mus    ( kt, nit000, ktlev2, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1),      pts_rhs, jpts        , ln_mus_ups )  
    153156      CASE ( np_UBS )                                 ! UBS 
    154          CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
     157         CALL tra_adv_ubs    ( kt, nit000, ktlev2, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts        , nn_ubs_v   ) 
    155158      CASE ( np_QCK )                                 ! QUICKEST 
    156          CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
     159         CALL tra_adv_qck    ( kt, nit000, ktlev2, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts                     ) 
    157160      ! 
    158161      END SELECT 
     
    160163      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
    161164         DO jk = 1, jpkm1 
    162             ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
    163             ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     165            ztrdt(:,:,jk) = pts_rhs(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     166            ztrds(:,:,jk) = pts_rhs(:,:,jk,jp_sal) - ztrds(:,:,jk) 
    164167         END DO 
    165168         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_cen.F90

    r10425 r10802  
    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, ktlev, cdtype, pu, pv, pwn,     & 
     47      &                                               pt, pt_rhs, kjpt, 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_rhs  with the now advective tracer trends 
    6262      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    6363      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
     
    6565      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    6666      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     67      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    6768      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    6869      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    6970      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    7071      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  
     72      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pwn   ! 3 ocean velocity components 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt             ! now tracer fields 
     74      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
    7475      ! 
    7576      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    106107               DO jj = 1, jpjm1 
    107108                  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) ) 
     109                     zwx(ji,jj,jk) = 0.5_wp * pu(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji+1,jj  ,jk,jn) ) 
     110                     zwy(ji,jj,jk) = 0.5_wp * pv(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji  ,jj+1,jk,jn) ) 
    110111                  END DO 
    111112               END DO 
     
    118119               DO jj = 2, jpjm1 
    119120                  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) 
     121                     ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     122                     ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    122123                  END DO 
    123124               END DO 
     
    128129               DO jj = 2, jpjm1 
    129130                  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) 
     131                     zC2t_u = pt(ji,jj,jk,jn) + pt(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2) 
     132                     zC2t_v = pt(ji,jj,jk,jn) + pt(ji  ,jj+1,jk,jn) 
    132133                     !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    133134                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 
    134135                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 
    135136                     !                                                  ! 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 
     137                     zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * zC4t_u 
     138                     zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * zC4t_v 
    138139                  END DO 
    139140               END DO 
     
    150151               DO jj = 2, jpjm1 
    151152                  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                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    153154                  END DO 
    154155               END DO 
     
    156157            ! 
    157158         CASE(  4  )                         !* 4th order compact 
    158             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point 
     159            CALL interp_4th_cpt( pt(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point 
    159160            DO jk = 2, jpkm1 
    160161               DO jj = 2, jpjm1 
     
    171172               DO jj = 1, jpj 
    172173                  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                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn)  
    174175                  END DO 
    175176               END DO    
    176177            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
    177                zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
     178               zwz(:,:,1) = pwn(:,:,1) * pt(:,:,1,jn) 
    178179            ENDIF 
    179180         ENDIF 
     
    182183            DO jj = 2, jpjm1 
    183184               DO ji = fs_2, fs_jpim1   ! vector opt. 
    184                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    & 
     185                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    185186                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
    186187                     &                + 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                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    188189               END DO 
    189190            END DO 
     
    191192         !                             ! trend diagnostics 
    192193         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) ) 
     194            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt(:,:,:,jn) ) 
     195            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt(:,:,:,jn) ) 
     196            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, pt(:,:,:,jn) ) 
    196197         END IF 
    197198         !                                 ! "Poleward" heat and salt transports  
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90

    r10425 r10802  
    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, ktlev1, ktlev2, ktlev3, cdtype, p2dt, pu, pv, pwn,       & 
     55      &                                                                pt_lev1, pt_lev2, pt_rhs, kjpt, 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_rhs  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      !!---------------------------------------------------------------------- 
    7171      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     72      INTEGER                              , INTENT(in   ) ::   ktlev1, ktlev2, ktlev3   ! time level indices for source terms 
    7273      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    7374      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     
    7677      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    7778      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  
     79      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pwn   ! 3 ocean velocity components 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
    8182      ! 
    8283      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices   
     
    125126               DO ji = 1, fs_jpim1   ! vector opt. 
    126127                  ! 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) ) 
     128                  zfp_ui = pu(ji,jj,jk) + ABS( pu(ji,jj,jk) ) 
     129                  zfm_ui = pu(ji,jj,jk) - ABS( pu(ji,jj,jk) ) 
     130                  zfp_vj = pv(ji,jj,jk) + ABS( pv(ji,jj,jk) ) 
     131                  zfm_vj = pv(ji,jj,jk) - ABS( pv(ji,jj,jk) ) 
     132                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt_lev1(ji,jj,jk,jn) + zfm_ui * pt_lev1(ji+1,jj  ,jk,jn) ) 
     133                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt_lev1(ji,jj,jk,jn) + zfm_vj * pt_lev1(ji  ,jj+1,jk,jn) ) 
    133134               END DO 
    134135            END DO 
     
    140141                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    141142                  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) 
     143                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt_lev1(ji,jj,jk,jn) + zfm_wk * pt_lev1(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    143144               END DO 
    144145            END DO 
     
    148149               DO jj = 1, jpj 
    149150                  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  
     151                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt_lev1(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    151152                  END DO 
    152153               END DO    
    153154            ELSE                             ! no cavities: only at the ocean surface 
    154                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     155               zwz(:,:,1) = pwn(:,:,1) * pt_lev1(:,:,1,jn) 
    155156            ENDIF 
    156157         ENDIF 
     
    164165                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
    165166                  !                             ! 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) 
     167                  pt_rhs(ji,jj,jk,jn) =                     pt_rhs(ji,jj,jk,jn) +        ztra   / e3t(ji,jj,jk,ktlev2) * tmask(ji,jj,jk) 
     168                  zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,ktlev1) * pt_lev1(ji,jj,jk,jn) + p2dt * ztra ) / e3t(ji,jj,jk,ktlev3) * tmask(ji,jj,jk) 
    168169               END DO 
    169170            END DO 
     
    184185               DO jj = 1, jpjm1 
    185186                  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) 
     187                     zwx(ji,jj,jk) = 0.5_wp * pu(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
     188                     zwy(ji,jj,jk) = 0.5_wp * pv(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
    188189                  END DO 
    189190               END DO 
     
    196197               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
    197198                  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) 
     199                     ztu(ji,jj,jk) = ( pt_lev2(ji+1,jj  ,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     200                     ztv(ji,jj,jk) = ( pt_lev2(ji  ,jj+1,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    200201                  END DO 
    201202               END DO 
     
    212213               DO jj = 1, jpjm1 
    213214                  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) 
     215                     zC2t_u = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points 
     216                     zC2t_v = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) 
    216217                     !                                                  ! 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) 
     218                     zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
     219                     zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    219220                  END DO 
    220221               END DO 
     
    227228               DO jj = 1, jpjm1 
    228229                  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) 
     230                     ztu(ji,jj,jk) = ( pt_lev2(ji+1,jj  ,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     231                     ztv(ji,jj,jk) = ( pt_lev2(ji  ,jj+1,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    231232                  END DO 
    232233               END DO 
     
    237238               DO jj = 2, jpjm1 
    238239                  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) 
     240                     zC2t_u = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
     241                     zC2t_v = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) 
    241242                     !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    242243                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) ) 
    243244                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) ) 
    244245                     !                                                  ! 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) 
     246                     zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
     247                     zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    247248                  END DO 
    248249               END DO 
     
    257258               DO jj = 2, jpjm1 
    258259                  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) )   & 
     260                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj,jk-1,jn) )   & 
    260261                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
    261262                  END DO 
     
    264265            ! 
    265266         CASE(  4  )                   !- 4th order COMPACT 
    266             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     267            CALL interp_4th_cpt( pt_lev2(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    267268            DO jk = 2, jpkm1 
    268269               DO jj = 2, jpjm1 
     
    282283         !        !==  monotonicity algorithm  ==! 
    283284         ! 
    284          CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
     285         CALL nonosc( pt_lev1(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt, e3t(:,:,:,ktlev2) ) 
    285286         ! 
    286287         !        !==  final trend with corrected fluxes  ==! 
     
    289290            DO jj = 2, jpjm1 
    290291               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  )   & 
     292                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    292293                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    293294                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) & 
    294                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     295                     &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev2) 
    295296               END DO 
    296297            END DO 
     
    303304            ! 
    304305            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) ) 
     306               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu, pt_lev2(:,:,:,jn) ) 
     307               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv, pt_lev2(:,:,:,jn) ) 
     308               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, pt_lev2(:,:,:,jn) ) 
    308309            ENDIF 
    309310            !                             ! heat/salt transport 
     
    328329 
    329330 
    330    SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
     331   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt, pe3t ) 
    331332      !!--------------------------------------------------------------------- 
    332333      !!                    ***  ROUTINE nonosc  *** 
     
    341342      !!       in-space based differencing for fluid 
    342343      !!---------------------------------------------------------------------- 
    343       REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step 
    344       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    345       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
     344      REAL(wp)                         , INTENT(in   ) ::   p2dt             ! tracer time-step 
     345      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft, pe3t ! before & after field, now e3t field 
     346      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc    ! monotonic fluxes in the 3 directions 
    346347      ! 
    347348      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    392393 
    393394               ! up & down beta terms 
    394                zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 
     395               zbt = e1e2t(ji,jj) * pe3t(ji,jj,jk) / 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 
     
    634635      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL  
    635636      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 
    636       !!        The solution is pta. 
     637      !!        The solution is pt_rhs. 
    637638      !!        The 3d array zwt is used as a work space array. 
    638639      !!---------------------------------------------------------------------- 
  • 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 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_qck.F90

    r10425 r10802  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    50       &                                       ptb, ptn, pta, kjpt ) 
     49   SUBROUTINE tra_adv_qck ( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pwn,      & 
     50      &                                                pt_lev1, pt_lev2, pt_rhs, kjpt ) 
    5151      !!---------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE tra_adv_qck  *** 
     
    7272      !!         dt = 2*rdtra and the scalar values are tb and sb 
    7373      !! 
    74       !!       On the vertical, the simple centered scheme used ptn 
     74      !!       On the vertical, the simple centered scheme used pt_lev2 
    7575      !! 
    7676      !!               The fluxes are bounded by the ULTIMATE limiter to 
     
    7878      !!            prevent the appearance of spurious numerical oscillations 
    7979      !! 
    80       !! ** Action : - update pta  with the now advective tracer trends 
     80      !! ** Action : - update pt_rhs  with the now advective tracer trends 
    8181      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    8282      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
     
    8686      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8787      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     88      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    8889      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    8990      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    9091      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    91       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     92      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pwn   ! 3 ocean velocity components 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
    9495      !!---------------------------------------------------------------------- 
    9596      ! 
     
    108109      ! 
    109110      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    110       CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt )  
    111       CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt )  
     111      CALL tra_adv_qck_i( kt, ktlev, cdtype, p2dt, pu, pt_lev1, pt_lev2, pt_rhs, kjpt )  
     112      CALL tra_adv_qck_j( kt, ktlev, cdtype, p2dt, pv, pt_lev1, pt_lev2, pt_rhs, kjpt )  
    112113 
    113114      !        ! vertical fluxes are computed with the 2nd order centered scheme 
    114       CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
     115      CALL tra_adv_cen2_k( kt, ktlev, cdtype, pwn,         pt_lev2, pt_rhs, kjpt ) 
    115116      ! 
    116117   END SUBROUTINE tra_adv_qck 
    117118 
    118119 
    119    SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  & 
    120       &                                        ptb, ptn, pta, kjpt   ) 
     120   SUBROUTINE tra_adv_qck_i( kt, ktlev, cdtype, p2dt, pu,                  & 
     121      &                                        pt_lev1, pt_lev2, pt_rhs, kjpt   ) 
    121122      !!---------------------------------------------------------------------- 
    122123      !! 
    123124      !!---------------------------------------------------------------------- 
    124125      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     126      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    125127      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    126128      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    127129      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step 
    128       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components 
    129       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     130      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu        ! i-velocity components 
     131      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2   ! before and now tracer fields 
     132      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend  
    131133      !! 
    132134      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    145147            DO jj = 2, jpjm1 
    146148               DO ji = fs_2, fs_jpim1   ! vector opt. 
    147                   zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
    148                   zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
     149                  zfc(ji,jj,jk) = pt_lev1(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
     150                  zfd(ji,jj,jk) = pt_lev1(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
    149151               END DO 
    150152            END DO 
     
    158160            DO jj = 2, jpjm1 
    159161               DO ji = fs_2, fs_jpim1   ! vector opt.          
    160                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     162                  zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    161163                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    162164               END DO 
     
    167169            DO jj = 2, jpjm1 
    168170               DO ji = fs_2, fs_jpim1   ! vector opt.    
    169                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    170                   zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk) 
    171                   zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    172                   zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T 
    173                   zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T 
     171                  zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     172                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,ktlev) 
     173                  zwx(ji,jj,jk)  = ABS( pu(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     174                  zfc(ji,jj,jk)  = zdir * pt_lev1(ji  ,jj,jk,jn) + ( 1. - zdir ) * pt_lev1(ji+1,jj,jk,jn)  ! FC in the x-direction for T 
     175                  zfd(ji,jj,jk)  = zdir * pt_lev1(ji+1,jj,jk,jn) + ( 1. - zdir ) * pt_lev1(ji  ,jj,jk,jn)  ! FD in the x-direction for T 
    174176               END DO 
    175177            END DO 
     
    197199            DO jj = 2, jpjm1 
    198200               DO ji = fs_2, fs_jpim1   ! vector opt.                
    199                   zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     201                  zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    200202                  !--- If the second ustream point is a land point 
    201203                  !--- the flux is computed by the 1st order UPWIND scheme 
    202204                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 
    203205                  zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 
    204                   zwx(ji,jj,jk) = zwx(ji,jj,jk) * pun(ji,jj,jk) 
     206                  zwx(ji,jj,jk) = zwx(ji,jj,jk) * pu(ji,jj,jk) 
    205207               END DO 
    206208            END DO 
     
    213215            DO jj = 2, jpjm1 
    214216               DO ji = fs_2, fs_jpim1   ! vector opt.   
    215                   zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     217                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    216218                  ! horizontal advective trends 
    217219                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
    218220                  !--- add it to the general tracer trends 
    219                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     221                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ztra 
    220222               END DO 
    221223            END DO 
    222224         END DO 
    223225         !                                 ! trend diagnostics 
    224          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     226         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt_lev2(:,:,:,jn) ) 
    225227         ! 
    226228      END DO 
     
    229231 
    230232 
    231    SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                & 
    232       &                                        ptb, ptn, pta, kjpt ) 
     233   SUBROUTINE tra_adv_qck_j( kt, ktlev, cdtype, p2dt, pv,                & 
     234      &                                        pt_lev1, pt_lev2, pt_rhs, kjpt ) 
    233235      !!---------------------------------------------------------------------- 
    234236      !! 
    235237      !!---------------------------------------------------------------------- 
    236238      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     239      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    237240      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    238241      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    239242      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step 
    240       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components 
    241       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
    242       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     243      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pv        ! j-velocity components 
     244      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2   ! before and now tracer fields 
     245      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend  
    243246      !! 
    244247      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
     
    259262               DO ji = fs_2, fs_jpim1   ! vector opt. 
    260263                  ! Upstream in the x-direction for the tracer 
    261                   zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn) 
     264                  zfc(ji,jj,jk) = pt_lev1(ji,jj-1,jk,jn) 
    262265                  ! Downstream in the x-direction for the tracer 
    263                   zfd(ji,jj,jk) = ptb(ji,jj+1,jk,jn) 
     266                  zfd(ji,jj,jk) = pt_lev1(ji,jj+1,jk,jn) 
    264267               END DO 
    265268            END DO 
     
    275278            DO jj = 2, jpjm1 
    276279               DO ji = fs_2, fs_jpim1   ! vector opt.          
    277                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     280                  zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    278281                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    279282               END DO 
     
    284287            DO jj = 2, jpjm1 
    285288               DO ji = fs_2, fs_jpim1   ! vector opt.    
    286                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    287                   zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
    288                   zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    289                   zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T 
    290                   zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T 
     289                  zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     290                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,ktlev) 
     291                  zwy(ji,jj,jk)  = ABS( pv(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     292                  zfc(ji,jj,jk)  = zdir * pt_lev1(ji,jj  ,jk,jn) + ( 1. - zdir ) * pt_lev1(ji,jj+1,jk,jn)  ! FC in the x-direction for T 
     293                  zfd(ji,jj,jk)  = zdir * pt_lev1(ji,jj+1,jk,jn) + ( 1. - zdir ) * pt_lev1(ji,jj  ,jk,jn)  ! FD in the x-direction for T 
    291294               END DO 
    292295            END DO 
     
    314317            DO jj = 2, jpjm1 
    315318               DO ji = fs_2, fs_jpim1   ! vector opt.                
    316                   zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     319                  zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    317320                  !--- If the second ustream point is a land point 
    318321                  !--- the flux is computed by the 1st order UPWIND scheme 
    319322                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 
    320323                  zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 
    321                   zwy(ji,jj,jk) = zwy(ji,jj,jk) * pvn(ji,jj,jk) 
     324                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * pv(ji,jj,jk) 
    322325               END DO 
    323326            END DO 
     
    330333            DO jj = 2, jpjm1 
    331334               DO ji = fs_2, fs_jpim1   ! vector opt.   
    332                   zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     335                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    333336                  ! horizontal advective trends 
    334337                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
    335338                  !--- add it to the general tracer trends 
    336                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     339                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ztra 
    337340               END DO 
    338341            END DO 
    339342         END DO 
    340343         !                                 ! trend diagnostics 
    341          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     344         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt_lev2(:,:,:,jn) ) 
    342345         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    343346         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     
    348351 
    349352 
    350    SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           & 
    351      &                                    ptn, pta, kjpt ) 
     353   SUBROUTINE tra_adv_cen2_k( kt, ktlev, cdtype, pwn,           & 
     354     &                                    pt_lev2, pt_rhs, kjpt ) 
    352355      !!---------------------------------------------------------------------- 
    353356      !! 
    354357      !!---------------------------------------------------------------------- 
    355358      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     359      INTEGER                              , INTENT(in   ) ::   ktlev    ! time level index for source terms 
    356360      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    357361      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
    358362      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity  
    359       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields 
    360       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
     363      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev2      ! before and now tracer fields 
     364      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs      ! tracer trend  
    361365      ! 
    362366      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    374378            DO jj = 2, jpjm1 
    375379               DO ji = fs_2, fs_jpim1   ! vector opt. 
    376                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     380                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt_lev2(ji,jj,jk-1,jn) + pt_lev2(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
    377381               END DO 
    378382            END DO 
     
    382386               DO jj = 1, jpj 
    383387                  DO ji = 1, jpi 
    384                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     388                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt_lev2(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    385389                  END DO 
    386390               END DO    
    387391            ELSE                                   ! no ocean cavities (only ocean surface) 
    388                zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
     392               zwz(:,:,1) = pwn(:,:,1) * pt_lev2(:,:,1,jn) 
    389393            ENDIF 
    390394         ENDIF 
     
    393397            DO jj = 2, jpjm1 
    394398               DO ji = fs_2, fs_jpim1   ! vector opt. 
    395                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    396                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     399                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
     400                     &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    397401               END DO 
    398402            END DO 
    399403         END DO 
    400404         !                                 ! Send trends for diagnostic 
    401          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
     405         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, pt_lev2(:,:,:,jn) ) 
    402406         ! 
    403407      END DO 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_ubs.F90

    r10425 r10802  
    4646CONTAINS 
    4747 
    48    SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          & 
    49       &                                                ptb, ptn, pta, kjpt, kn_ubs_v ) 
     48   SUBROUTINE tra_adv_ubs( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pwn,          & 
     49      &                                                pt_lev1, pt_lev2, pt_rhs, kjpt, kn_ubs_v ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_adv_ubs  *** 
     
    5858      !!      It is only used in the horizontal direction. 
    5959      !!      For example the i-component of the advective fluxes are given by : 
    60       !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0 
     60      !!                !  e2u e3u uu ( mi(Tn) - zltu(i  ) ,ktlev)   if uu(i,ktlev) >= 0 
    6161      !!          ztu = !  or  
    62       !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0 
     62      !!                !  e2u e3u uu ( mi(Tn) - zltu(i+1) ,ktlev)   if uu(i,ktlev) < 0 
    6363      !!      where zltu is the second derivative of the before temperature field: 
    6464      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ] 
     
    7777      !!      scheme (kn_ubs_v=4). 
    7878      !! 
    79       !! ** Action : - update pta  with the now advective tracer trends 
     79      !! ** Action : - update pt_rhs  with the now advective tracer trends 
    8080      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    8181      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
     
    8686      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8787      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
     88      INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    8889      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    8990      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    9091      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers 
    9192      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     93      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pwn   ! 3 ocean transport components 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
    9596      ! 
    9697      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    126127            DO jj = 1, jpjm1              ! First derivative (masked gradient) 
    127128               DO ji = 1, fs_jpim1   ! vector opt. 
    128                   zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    129                   zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    130                   ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    131                   ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     129                  zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,ktlev) * umask(ji,jj,jk) 
     130                  zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,ktlev) * vmask(ji,jj,jk) 
     131                  ztu(ji,jj,jk) = zeeu * ( pt_lev1(ji+1,jj  ,jk,jn) - pt_lev1(ji,jj,jk,jn) ) 
     132                  ztv(ji,jj,jk) = zeev * ( pt_lev1(ji  ,jj+1,jk,jn) - pt_lev1(ji,jj,jk,jn) ) 
    132133               END DO 
    133134            END DO 
    134135            DO jj = 2, jpjm1              ! Second derivative (divergence) 
    135136               DO ji = fs_2, fs_jpim1   ! vector opt. 
    136                   zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) ) 
     137                  zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,ktlev) ) 
    137138                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
    138139                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef 
     
    146147            DO jj = 1, jpjm1 
    147148               DO ji = 1, fs_jpim1   ! vector opt. 
    148                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2) 
    149                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
    150                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    151                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
     149                  zfp_ui = pu(ji,jj,jk) + ABS( pu(ji,jj,jk) )      ! upstream transport (x2) 
     150                  zfm_ui = pu(ji,jj,jk) - ABS( pu(ji,jj,jk) ) 
     151                  zfp_vj = pv(ji,jj,jk) + ABS( pv(ji,jj,jk) ) 
     152                  zfm_vj = pv(ji,jj,jk) - ABS( pv(ji,jj,jk) ) 
    152153                  !                                                  ! 2nd order centered advective fluxes (x2) 
    153                   zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) ) 
    154                   zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) ) 
     154                  zcenut = pu(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn) ) 
     155                  zcenvt = pv(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) ) 
    155156                  !                                                  ! UBS advective fluxes 
    156157                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 
     
    160161         END DO          
    161162         ! 
    162          zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update 
     163         zltu(:,:,:) = pt_rhs(:,:,:,jn)      ! store the initial trends before its update 
    163164         ! 
    164165         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==! 
    165166            DO jj = 2, jpjm1 
    166167               DO ji = fs_2, fs_jpim1   ! vector opt. 
    167                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        & 
     168                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                        & 
    168169                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
    169                      &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     170                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    170171               END DO 
    171172            END DO 
     
    173174         END DO 
    174175         ! 
    175          zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
     176         zltu(:,:,:) = pt_rhs(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
    176177         !                                            ! and/or in trend diagnostic (l_trd=T)  
    177178         !                 
    178179         IF( l_trd ) THEN                  ! trend diagnostics 
    179              CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) ) 
    180              CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 
     180             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pu, pt_lev2(:,:,:,jn) ) 
     181             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pv, pt_lev2(:,:,:,jn) ) 
    181182         END IF 
    182183         !      
     
    193194         CASE(  2  )                   ! 2nd order FCT  
    194195            !          
    195             IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag. 
     196            IF( l_trd )   zltv(:,:,:) = pt_rhs(:,:,:,jn)          ! store pt_rhs if trend diag. 
    196197            ! 
    197198            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==! 
     
    201202                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    202203                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    203                      ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk) 
     204                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * pt_lev1(ji,jj,jk,jn) + zfm_wk * pt_lev1(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk) 
    204205                  END DO 
    205206               END DO 
     
    209210                  DO jj = 1, jpj 
    210211                     DO ji = 1, jpi 
    211                         ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     212                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt_lev1(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    212213                     END DO 
    213214                  END DO    
    214215               ELSE                                ! no cavities: only at the ocean surface 
    215                   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     216                  ztw(:,:,1) = pwn(:,:,1) * pt_lev1(:,:,1,jn) 
    216217               ENDIF 
    217218            ENDIF 
     
    220221               DO jj = 2, jpjm1 
    221222                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    222                      ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    223                      pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak  
    224                      zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
     223                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     224                     pt_rhs(ji,jj,jk,jn) =   pt_rhs(ji,jj,jk,jn) +  ztak  
     225                     zti(ji,jj,jk)    = ( pt_lev1(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    225226                  END DO 
    226227               END DO 
     
    232233               DO jj = 1, jpj 
    233234                  DO ji = 1, jpi 
    234                      ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   & 
     235                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj,jk-1,jn) )   & 
    235236                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk) 
    236237                  END DO 
     
    240241            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked 
    241242            ! 
    242             CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm 
     243            CALL nonosc_z( pt_lev1(:,:,:,jn), ztw, zti, p2dt, e3t(:,:,:,ktlev) )      !  monotonicity algorithm 
    243244            ! 
    244245         CASE(  4  )                               ! 4th order COMPACT 
    245             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point 
     246            CALL interp_4th_cpt( pt_lev2(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point 
    246247            DO jk = 2, jpkm1 
    247248               DO jj = 2, jpjm1 
     
    251252               END DO 
    252253            END DO 
    253             IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work 
     254            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * pt_lev2(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work 
    254255            ! 
    255256         END SELECT 
     
    258259            DO jj = 2, jpjm1  
    259260               DO ji = fs_2, fs_jpim1   ! vector opt.    
    260                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     261                  pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    261262               END DO 
    262263            END DO 
     
    264265         ! 
    265266         IF( l_trd )  THEN       ! vertical advective trend diagnostics 
    266             DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w]) 
     267            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + pt_lev2.dk[w]) 
    267268               DO jj = 2, jpjm1 
    268269                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    269                      zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          & 
    270                         &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   & 
    271                         &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     270                     zltv(ji,jj,jk) = pt_rhs(ji,jj,jk,jn) - zltv(ji,jj,jk)                          & 
     271                        &           + pt_lev2(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   & 
     272                        &                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    272273                  END DO 
    273274               END DO 
     
    281282 
    282283 
    283    SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt ) 
     284   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt, pe3t ) 
    284285      !!--------------------------------------------------------------------- 
    285286      !!                    ***  ROUTINE nonosc_z  *** 
     
    296297      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step 
    297298      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
     299      REAL(wp), INTENT(in   ), DIMENSION (jpi,jpj,jpk) ::   pe3t   ! now cell thickness field 
    298300      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 
    299301      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction 
     
    352354               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
    353355               ! up & down beta terms 
    354                zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 
     356               zbt = e1e2t(ji,jj) * pe3t(ji,jj,jk) / p2dt 
    355357               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 
    356358               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/oce.F90

    r10789 r10802  
    2323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wi             !: vertical vel. (adaptive-implicit) [m/s] 
    2424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1] 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celsius,psu]  
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:), TARGET :: ts             !: 4D T-S fields                  [Celsius,psu]  
    2626   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    2727   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
     
    7272   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s] 
    7373   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           wn             !: k-vertical   velocity        [m/s] 
     74   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                [Celsius,psu]          
     75   !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    7476 
    7577   !!---------------------------------------------------------------------- 
     
    9092      ALLOCATE( uu   (jpi,jpj,jpk, jpt) , vv   (jpi,jpj,jpk,jpt)  ,                             & 
    9193         &      ww   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    92          &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
     94         &      ts  (jpi,jpj,jpk,jpts,jpt) ,                                                    & 
    9395         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             & 
    9496         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             & 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/step.F90

    r10799 r10802  
    247247               &         CALL Agrif_Sponge_tra        ! tracers sponge 
    248248#endif 
    249                          CALL tra_adv       ( kstp )  ! horizontal & vertical advection 
     249                         CALL tra_adv       ( kstp, Nm1, Nnn, Np1, ts(:,:,:,:,Nrhs) )  ! horizontal & vertical advection 
    250250      IF( ln_zdfosm  )   CALL tra_osm       ( kstp )  ! OSMOSIS non-local tracer fluxes 
    251251      IF( lrst_oce .AND. ln_zdfosm ) & 
     
    344344      wn => ww(:,:,:) 
    345345 
     346      tsb => ts(:,:,:,:,Nm1); tsn => ts(:,:,:,:,Nnn); tsa => ts(:,:,:,:,Np1) 
     347 
    346348      e3t_b => e3t(:,:,:,Nm1); e3t_n => e3t(:,:,:,Nnn); e3t_a => e3t(:,:,:,Np1) 
    347349      e3u_b => e3u(:,:,:,Nm1); e3u_n => e3u(:,:,:,Nnn); e3u_a => e3u(:,:,:,Np1) 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcadv.F90

    r10068 r10802  
    6868CONTAINS 
    6969 
    70    SUBROUTINE trc_adv( kt ) 
     70   SUBROUTINE trc_adv( kt, ktlev1, ktlev2, ktlev3 ) 
    7171      !!---------------------------------------------------------------------- 
    7272      !!                  ***  ROUTINE trc_adv  *** 
     
    7777      !!---------------------------------------------------------------------- 
    7878      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     79      INTEGER, INTENT(in) ::   ktlev1, ktlev2, ktlev3   ! time level indices for source terms 
    7980      ! 
    8081      INTEGER ::   jk   ! dummy loop index 
     
    123124      ! 
    124125      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    125          CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     126         CALL tra_adv_cen( kt, nittrc000, ktlev2, 'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
    126127      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    127          CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     128         CALL tra_adv_fct( kt, nittrc000, ktlev1, ktlev2, ktlev3, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
    128129      CASE ( np_MUS )                                 ! MUSCL 
    129          CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     130         CALL tra_adv_mus( kt, nittrc000, ktlev2, 'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
    130131      CASE ( np_UBS )                                 ! UBS 
    131          CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     132         CALL tra_adv_ubs( kt, nittrc000, ktlev2, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
    132133      CASE ( np_QCK )                                 ! QUICKEST 
    133          CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     134         CALL tra_adv_qck( kt, nittrc000, ktlev2, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
    134135      ! 
    135136      END SELECT 
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trctrp.F90

    r10068 r10802  
    6464         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
    6565         IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends 
    66                                 CALL trc_adv    ( kt )      ! horizontal & vertical advection  
     66                                CALL trc_adv    ( kt, Nm1, Nnn, Np1 )      ! horizontal & vertical advection  
    6767         !                                                         ! Partial top/bottom cell: GRADh( trb )   
    6868         IF( ln_zps ) THEN 
Note: See TracChangeset for help on using the changeset viewer.