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 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD – NEMO

Ignore:
Timestamp:
2019-11-22T15:29:17+01:00 (4 years ago)
Author:
acc
Message:

Merge in changes from 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. This just creates a fresh copy of this branch to use as the merge base. See ticket #2341

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src

    • Property svn:mergeinfo deleted

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trddyn.F90

    r10425 r11949  
    4444CONTAINS 
    4545 
    46    SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt ) 
     46   SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt, Kmm ) 
    4747      !!--------------------------------------------------------------------- 
    4848      !!                  ***  ROUTINE trd_mod  *** 
    … …  
    5555      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    5656      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     57      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    6667      !   3D output of momentum and/or tracers trends using IOM interface 
    6768      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    68       IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt ) 
     69      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 
    6970          
    7071      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    7172      !  Integral Constraints Properties for momentum and/or tracers trends 
    7273      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    73       IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt ) 
     74      IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt, Kmm ) 
    7475 
    7576      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    7677      !  Kinetic Energy trends 
    7778      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    78       IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt ) 
     79      IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 
    7980 
    8081      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8182      !  Vorticity trends 
    8283      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    83       IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt ) 
     84      IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 
    8485 
    8586      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    9192 
    9293 
    93    SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt ) 
     94   SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt, Kmm ) 
    9495      !!--------------------------------------------------------------------- 
    9596      !!                  ***  ROUTINE trd_dyn_iom  *** 
    … …  
    100101      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    101102      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     103      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    102104      ! 
    103105      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    … …  
    121123                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation) 
    122124                              z3dy(:,:,:) = 0._wp 
    123                               DO jk = 1, jpkm1   ! no mask as un,vn are masked 
     125                              DO jk = 1, jpkm1   ! no mask as uu, vv are masked 
    124126                                 DO jj = 2, jpjm1 
    125127                                    DO ji = 2, jpim1 
    126                                        z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) ) 
    127                                        z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) ) 
     128                                       z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) ) 
     129                                       z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) 
    128130                                    END DO 
    129131                                 END DO 
    … …  
    142144                              !                                    ! wind stress trends 
    143145                              ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 
    144                               z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 
    145                               z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 
     146                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rau0 ) 
     147                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rau0 ) 
    146148                              CALL iom_put( "utrd_tau", z2dx ) 
    147149                              CALL iom_put( "vtrd_tau", z2dy ) 
    … …  
    159161!                                          ikbv = mbkv(ji,jj) 
    160162!                                          z3dx(ji,jj,jk) = 0.5 * ( rCdU_bot(ji+1,jj) + rCdU_bot(ji,jj) ) &  
    161 !                                               &         * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 
     163!                                               &         * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 
    162164!                                          z3dy(ji,jj,jk) = 0.5 * ( rCdU_bot(ji,jj+1) + rCdU_bot(ji,jj) ) & 
    163 !                                               &         * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 
     165!                                               &         * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 
    164166!                                    END DO 
    165167!                                 END DO 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdglo.F90

    r10425 r11949  
    5959CONTAINS 
    6060 
    61    SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt ) 
     61   SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                  ***  ROUTINE trd_glo  *** 
    … …  
    7272      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type (='DYN'/'TRA') 
    7373      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     74      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    7475      !! 
    7576      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    … …  
    8788               DO jj = 1, jpj 
    8889                  DO ji = 1, jpi         
    89                      zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     90                     zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    9091                     zvt = ptrdx(ji,jj,jk) * zvm 
    9192                     zvs = ptrdy(ji,jj,jk) * zvm 
    9293                     tmo(ktrd) = tmo(ktrd) + zvt    
    9394                     smo(ktrd) = smo(ktrd) + zvs 
    94                      t2 (ktrd) = t2(ktrd)  + zvt * tsn(ji,jj,jk,jp_tem) 
    95                      s2 (ktrd) = s2(ktrd)  + zvs * tsn(ji,jj,jk,jp_sal) 
     95                     t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm) 
     96                     s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm) 
    9697                  END DO 
    9798               END DO 
    … …  
    99100            !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 
    100101            IF( ln_linssh .AND. ktrd == jptra_zad ) THEN   
    101                tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) ) 
    102                smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  ) 
    103                t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:)  ) 
    104                s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  ) 
     102               tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 
     103               smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     104               t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     105               s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
    105106            ENDIF 
    106107            ! 
    … …  
    121122                  DO ji = 1, jpim1 
    122123                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    123                         &                                     * e1e2u  (ji,jj) * e3u_n(ji,jj,jk) 
     124                        &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
    124125                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    125                         &                                     * e1e2v  (ji,jj) * e3u_n(ji,jj,jk) 
     126                        &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm) 
    126127                     umo(ktrd) = umo(ktrd) + zvt 
    127128                     vmo(ktrd) = vmo(ktrd) + zvs 
    128                      hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs 
     129                     hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 
    129130                  END DO 
    130131               END DO 
    … …  
    141142                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    142143                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
    143                      hke(jpdyn_tau) = hke(jpdyn_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs 
     144                     hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 
    144145                  END DO 
    145146               END DO 
    … …  
    155156!                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels 
    156157!                        ikbv = mbkv(ji,jj) 
    157 !                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj) 
    158 !                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj) 
     158!                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 
     159!                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 
    159160!                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 
    160161!                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 
    161 !                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs 
     162!                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 
    162163!                     END DO 
    163164!                  END DO 
    … …  
    183184 
    184185 
    185    SUBROUTINE glo_dyn_wri( kt ) 
     186   SUBROUTINE glo_dyn_wri( kt, Kmm ) 
    186187      !!--------------------------------------------------------------------- 
    187188      !!                  ***  ROUTINE glo_dyn_wri  *** 
    … …  
    190191      !!---------------------------------------------------------------------- 
    191192      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     193      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    192194      ! 
    193195      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    209211         zkepe(:,:,:) = 0._wp 
    210212    
    211          CALL eos( tsn, rhd, rhop )       ! now potential density 
     213         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop )       ! now potential density 
    212214 
    213215         zcof = 0.5_wp / rau0             ! Density flux at w-point 
    214216         zkz(:,:,1) = 0._wp 
    215217         DO jk = 2, jpk 
    216             zkz(:,:,jk) = zcof * e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
     218            zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
    217219         END DO 
    218220          
    … …  
    221223            DO jj = 1, jpjm1 
    222224               DO ji = 1, jpim1 
    223                   zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    224                   zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     225                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     226                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    225227               END DO 
    226228            END DO 
    … …  
    233235                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    234236                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
    235                      &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     237                     &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    236238               END DO 
    237239            END DO 
    … …  
    242244         peke = 0._wp 
    243245         DO jk = 1, jpkm1 
    244             peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 
     246            peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 
    245247         END DO 
    246248         peke = grav * peke 
    … …  
    506508 
    507509 
    508    SUBROUTINE trd_glo_init 
     510   SUBROUTINE trd_glo_init( Kmm ) 
    509511      !!--------------------------------------------------------------------- 
    510512      !!                  ***  ROUTINE trd_glo_init  *** 
    … …  
    512514      !! ** Purpose :   Read the namtrd namelist 
    513515      !!---------------------------------------------------------------------- 
     516      INTEGER, INTENT(in) ::   Kmm   ! time level index 
    514517      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    515518      !!---------------------------------------------------------------------- 
    … …  
    524527      tvolt = 0._wp 
    525528      DO jk = 1, jpkm1 
    526          tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     529         tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 
    527530      END DO 
    528531      CALL mpp_sum( 'trdglo', tvolt )   ! sum over the global domain 
    … …  
    541544         DO jj = 2, jpjm1 
    542545            DO ji = fs_2, fs_jpim1   ! vector opt. 
    543                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    544                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
     546               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     547               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    545548            END DO 
    546549         END DO 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdini.F90

    r11536 r11949  
    3434CONTAINS 
    3535 
    36    SUBROUTINE trd_init 
     36   SUBROUTINE trd_init( Kmm ) 
    3737      !!---------------------------------------------------------------------- 
    3838      !!                  ***  ROUTINE trd_init  *** 
    … …  
    4040      !! ** Purpose :   Initialization of trend diagnostics 
    4141      !!---------------------------------------------------------------------- 
     42      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    4243      INTEGER ::   ios   ! local integer 
    4344      !! 
    … …  
    9697 
    9798      !                             ! diagnostic initialization   
    98       IF( ln_glo_trd )   CALL trd_glo_init      ! global domain averaged trends 
     99      IF( ln_glo_trd )   CALL trd_glo_init( Kmm )      ! global domain averaged trends 
    99100      IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends   
    100101      IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdken.F90

    r10425 r11949  
    5959 
    6060 
    61    SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt ) 
     61   SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt, Kmm ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                  ***  ROUTINE trd_ken  *** 
    … …  
    6767      !! ** Method  : - apply lbc to the input masked velocity trends  
    6868      !!              - compute the associated KE trend: 
    69       !!          zke = 0.5 * (  mi-1[ un * putrd * bu ] + mj-1[ vn * pvtrd * bv]  ) / bt 
     69      !!          zke = 0.5 * (  mi-1[ uu(Kmm) * putrd * bu ] + mj-1[ vv(Kmm) * pvtrd * bv]  ) / bt 
    7070      !!      where bu, bv, bt are the volume of u-, v- and t-boxes.  
    7171      !!              - vertical diffusion case (jpdyn_zdf):  
    … …  
    8080      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    8181      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     82      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    8283      ! 
    8384      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    … …  
    9293      nkstp = kt 
    9394      DO jk = 1, jpkm1 
    94          bu   (:,:,jk) =    e1e2u(:,:) * e3u_n(:,:,jk) 
    95          bv   (:,:,jk) =    e1e2v(:,:) * e3v_n(:,:,jk) 
    96          r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk) 
     95         bu   (:,:,jk) =    e1e2u(:,:) * e3u(:,:,jk,Kmm) 
     96         bv   (:,:,jk) =    e1e2v(:,:) * e3v(:,:,jk,Kmm) 
     97         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    9798      END DO 
    9899      ! 
    … …  
    103104         DO jj = 2, jpj 
    104105            DO ji = 2, jpi 
    105                zke(ji,jj,jk) = 0.5_wp * rau0 *( un(ji  ,jj,jk) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
    106                   &                           + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  & 
    107                   &                           + vn(ji,jj  ,jk) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  & 
    108                   &                           + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk) 
     106               zke(ji,jj,jk) = 0.5_wp * rau0 *( uu(ji  ,jj,jk,Kmm) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
     107                  &                           + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  & 
     108                  &                           + vv(ji,jj  ,jk,Kmm) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  & 
     109                  &                           + vv(ji,jj-1,jk,Kmm) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk) 
    109110            END DO 
    110111         END DO 
    … …  
    122123         !                   !                                          ! wind stress trends 
    123124                                 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) ) 
    124                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 
    125                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 
     125                           z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 
     126                           z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 
    126127                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    127128                           DO jj = 2, jpj 
    … …  
    141142!                  ikbu = mbku(ji,jj)         ! deepest ocean u- & v-levels 
    142143!                  ikbv = mbkv(ji,jj)    
    143 !                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) 
    144 !                  z2dy(ji,jj) = vn(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) 
     144!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) 
     145!                  z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) 
    145146!               END DO 
    146147!            END DO 
    … …  
    157158         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf"   , zke )    ! asselin filter trends  
    158159!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 
    159 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 
     160!! reflechir a une possible sauvegarde du "vrai" uu(Kmm),vv(Kmm) pour le calcul de atf.... 
    160161! 
    161162!         IF( ln_drgimp ) THEN                                          ! bottom friction (implicit case) 
    … …  
    164165!                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    165166!                  ikbv = mbkv(ji,jj) 
    166 !                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 
    167 !                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 
     167!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 
     168!                  z2dy(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 
    168169!               END DO 
    169170!            END DO 
    … …  
    179180        CASE( jpdyn_ken )   ;   ! kinetic energy 
    180181                    ! called in dynnxt.F90 before asselin time filter 
    181                     ! with putrd=ua and pvtrd=va 
     182                    ! with putrd=uu(Krhs) and pvtrd=vv(Krhs) 
    182183                    zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    183184                    CALL iom_put( "KE", zke ) 
    184185                    ! 
    185                     CALL ken_p2k( kt , zke ) 
     186                    CALL ken_p2k( kt , zke, Kmm ) 
    186187                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    187188         ! 
    … …  
    191192 
    192193 
    193    SUBROUTINE ken_p2k( kt , pconv ) 
     194   SUBROUTINE ken_p2k( kt , pconv, Kmm ) 
    194195      !!--------------------------------------------------------------------- 
    195196      !!                 ***  ROUTINE ken_p2k  *** 
    … …  
    202203      !!----------------------------------------------------------------------  
    203204      INTEGER                   , INTENT(in   ) ::   kt      ! ocean time-step index 
     205      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    204206      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pconv   !  
    205207      ! 
    … …  
    214216       
    215217      !  Surface value (also valid in partial step case) 
    216       zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1) 
     218      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm) 
    217219 
    218220      ! interior value (2=<jk=<jpkm1) 
    219221      DO jk = 2, jpk 
    220          zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk) 
     222         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm) 
    221223      END DO 
    222224 
    … …  
    225227         DO jj = 1, jpj 
    226228            DO ji = 1, jpi 
    227                zcoef = 0.5_wp / e3t_n(ji,jj,jk) 
     229               zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 
    228230               pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 
    229231            END DO 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdmxl.F90

    r11536 r11949  
    8686 
    8787 
    88    SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln ) 
     88   SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln, Kmm ) 
    8989      !!---------------------------------------------------------------------- 
    9090      !!                  ***  ROUTINE trd_tra_mng  *** 
    … …  
    9898      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    9999      INTEGER                   , INTENT(in   ) ::   kt      ! time step index 
     100      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    100101      REAL(wp)                  , INTENT(in   ) ::   p2dt    ! time step  [s] 
    101102      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   kmxln   ! number of t-box for the vertical average  
    … …  
    119120            DO jj = 1,jpj 
    120121               DO ji = 1,jpi 
    121                   IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     122                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    122123               END DO 
    123124            END DO 
    … …  
    136137         tml(:,:) = 0._wp   ;   sml(:,:) = 0._wp 
    137138         DO jk = 1, jpktrd 
    138             tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem) 
    139             sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal) 
     139            tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm) 
     140            sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm) 
    140141         END DO 
    141142         ! 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdpen.F90

    r10425 r11949  
    5555 
    5656 
    57    SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt ) 
     57   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm ) 
    5858      !!--------------------------------------------------------------------- 
    5959      !!                  ***  ROUTINE trd_tra_mng  *** 
    … …  
    6666      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index 
    6767      INTEGER                   , INTENT(in) ::   kt             ! time step index 
     68      INTEGER                   , INTENT(in) ::   Kmm            ! time level index 
    6869      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s] 
    6970      ! 
    … …  
    7778      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step 
    7879         nkstp = kt 
    79          CALL eos_pen( tsn, rab_PE, zpe ) 
     80         CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 
    8081         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 
    8182         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) 
    … …  
    9596                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    9697                                   ALLOCATE( z2d(jpi,jpj) ) 
    97                                    z2d(:,:) = wn(:,:,1) * ( & 
    98                                      &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
    99                                      &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
    100                                      & ) / e3t_n(:,:,1) 
     98                                   z2d(:,:) = ww(:,:,1) * ( & 
     99                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm)    & 
     100                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm)    & 
     101                                     & ) / e3t(:,:,1,Kmm) 
    101102                                   CALL iom_put( "petrd_sad" , z2d ) 
    102103                                   DEALLOCATE( z2d ) 
    … …  
    112113      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux) 
    113114      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend) 
    114                                 !IF( ln_linssh ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation) 
    115                                 !   ALLOCATE( z2d(jpi,jpj) ) 
    116                                 !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 & 
    117                                 !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    & 
    118                                 !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt ) 
    119                                 !   CALL iom_put( "petrd_sad" , z2d ) 
    120                                 !   DEALLOCATE( z2d ) 
    121                                 !ENDIF 
    122115         ! 
    123116      END SELECT 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdtra.F90

    r10425 r11949  
    6060 
    6161 
    62    SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) 
     62   SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra ) 
    6363      !!--------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE trd_tra  *** 
    … …  
    7777      INTEGER                         , INTENT(in)           ::   ktra    ! tracer index 
    7878      INTEGER                         , INTENT(in)           ::   ktrd    ! tracer trend index 
     79      INTEGER                         , INTENT(in)           ::   Kmm, Krhs ! time level indices 
    7980      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::   ptrd    ! tracer trend  or flux 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pun     ! now velocity  
     81      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pu      ! now velocity  
    8182      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8283      ! 
    … …  
    9495         SELECT CASE( ktrd ) 
    9596         !                            ! advection: transform the advective flux into a trend 
    96          CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
    97          CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
    98          CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
     97         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
     98         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm )  
     99         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm ) 
    99100         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng 
    100101            &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    101102                                 ztrds(:,:,:) = 0._wp 
    102                                  CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     103                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 
    103104 !!gm Gurvan, verify the jptra_evd trend please ! 
    104105         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    … …  
    114115         !                            ! advection: transform the advective flux into a trend 
    115116         !                            !            and send T & S trends to trd_tra_mng 
    116          CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds )  
    117                                   CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   ) 
    118          CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds )  
    119                                   CALL trd_tra_mng( trdty, ztrds, ktrd, kt   ) 
    120          CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds )  
    121                                   CALL trd_tra_mng( trdt , ztrds, ktrd, kt   ) 
     117         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'X'  , ztrds, Kmm )  
     118                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm   ) 
     119         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Y'  , ztrds, Kmm )  
     120                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm   ) 
     121         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pu  , ptra, 'Z'  , ztrds, Kmm )  
     122                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm   ) 
    122123         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap) 
    123124            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 
    … …  
    127128            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    128129            DO jk = 2, jpk 
    129                zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    130                zws(:,:,jk) = avs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     130               zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     131               zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    131132            END DO 
    132133            ! 
    133134            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    134135            DO jk = 1, jpkm1 
    135                ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 
    136                ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk)  
    137             END DO 
    138             CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     136               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     137               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
     138            END DO 
     139            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm )   
    139140            ! 
    140141            !                         ! Also calculate EVD trend at this point.  
    141142            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes 
    142143            DO jk = 2, jpk 
    143                zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
    144                zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk) 
     144               zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
     145               zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 
    145146            END DO 
    146147            ! 
    147148            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    148149            DO jk = 1, jpkm1 
    149                ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk) 
    150                ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk)  
    151             END DO 
    152             CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )   
     150               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     151               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
     152            END DO 
     153            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm )   
    153154            ! 
    154155            DEALLOCATE( zwt, zws, ztrdt ) 
    … …  
    156157         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
    157158            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    158             CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
     159            CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm )   
    159160         END SELECT 
    160161      ENDIF 
    … …  
    164165         SELECT CASE( ktrd ) 
    165166         !                            ! advection: transform the advective flux into a masked trend 
    166          CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds )  
    167          CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds )  
    168          CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds )  
     167         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  
     168         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm )  
     169         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm )  
    169170         CASE DEFAULT                 ! other trends: just masked  
    170171                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    171172         END SELECT 
    172173         !                            ! send trend to trd_trc 
    173          CALL trd_trc( ztrds, ktra, ktrd, kt )  
     174         CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm )  
    174175         ! 
    175176      ENDIF 
    … …  
    178179 
    179180 
    180    SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) 
     181   SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm ) 
    181182      !!--------------------------------------------------------------------- 
    182183      !!                  ***  ROUTINE trd_tra_adv  *** 
    … …  
    191192      !!---------------------------------------------------------------------- 
    192193      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction 
    193       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer  
     194      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu      ! now velocity   in one direction 
     195      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt      ! now or before tracer  
    195196      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction 
    196197      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction 
     198      INTEGER,  INTENT(in)                            ::   Kmm     ! time level index 
    197199      ! 
    198200      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    215217            DO ji = fs_2, fs_jpim1   ! vector opt. 
    216218               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    217                  &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
    218                  &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     219                 &                  - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk)  )   & 
     220                 &              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    219221            END DO 
    220222         END DO 
    … …  
    224226 
    225227 
    226    SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt ) 
     228   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    227229      !!--------------------------------------------------------------------- 
    228230      !!                  ***  ROUTINE trd_tra_mng  *** 
    … …  
    236238      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    237239      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     240      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    238241      !!---------------------------------------------------------------------- 
    239242 
    … …  
    243246 
    244247      !                   ! 3D output of tracers trends using IOM interface 
    245       IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
     248      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    246249 
    247250      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    248       IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
     251      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 
    249252 
    250253      !                   ! Potential ENergy trends 
    251       IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
     254      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt, Kmm ) 
    252255 
    253256      !                   ! Mixed layer trends for active tracers 
    … …  
    290293 
    291294 
    292    SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt ) 
     295   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    293296      !!--------------------------------------------------------------------- 
    294297      !!                  ***  ROUTINE trd_tra_iom  *** 
    … …  
    300303      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    301304      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     305      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    302306      !! 
    303307      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    … …  
    326330                                  IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    327331                                     ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 
    328                                      z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 
    329                                      z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 
     332                                     z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 
     333                                     z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 
    330334                                     CALL iom_put( "ttrd_sad", z2dx ) 
    331335                                     CALL iom_put( "strd_sad", z2dy ) 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdtrc.F90

    r10068 r11949  
    99CONTAINS 
    1010 
    11    SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) 
     11   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm ) 
    1212      INTEGER ::   kt, kjn, ktrd    
     13      INTEGER ::   Kmm            ! time level index 
    1314      REAL    ::   ptrtrd(:,:,:)   
    1415      WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdvor.F90

    r11536 r11949  
    7878 
    7979 
    80    SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 
     80   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 
    8181      !!---------------------------------------------------------------------- 
    8282      !!                  ***  ROUTINE trd_vor  *** 
    … …  
    8888      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
    8989      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     90      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    9091      ! 
    9192      INTEGER ::   ji, jj   ! dummy loop indices 
    … …  
    9495 
    9596      SELECT CASE( ktrd )  
    96       CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg )   ! Hydrostatique Pressure Gradient  
    97       CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg )   ! KE Gradient  
    98       CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo )   ! Relative Vorticity  
    99       CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo )   ! Planetary Vorticity Term  
    100       CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf )   ! Horizontal Diffusion  
    101       CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad )   ! Vertical Advection  
    102       CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg )   ! Surface Pressure Grad.  
     97      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm )   ! Hydrostatique Pressure Gradient  
     98      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm )   ! KE Gradient  
     99      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm )   ! Relative Vorticity  
     100      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm )   ! Planetary Vorticity Term  
     101      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm )   ! Horizontal Diffusion  
     102      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm )   ! Vertical Advection  
     103      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm )   ! Surface Pressure Grad.  
    103104      CASE( jpdyn_zdf )                                                      ! Vertical Diffusion  
    104105         ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    105106         DO jj = 2, jpjm1                                                             ! wind stress trends 
    106107            DO ji = fs_2, fs_jpim1   ! vector opt. 
    107                ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 
    108                ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 
     108               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rau0 ) 
     109               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rau0 ) 
    109110            END DO 
    110111         END DO 
    111112         ! 
    112          CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf )                             ! zdf trend including surf./bot. stresses  
    113          CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                             ! surface wind stress  
     113         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm )                             ! zdf trend including surf./bot. stresses  
     114         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm )                             ! surface wind stress  
    114115      CASE( jpdyn_bfr ) 
    115          CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress 
     116         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm )                             ! Bottom stress 
    116117         ! 
    117118      CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends 
    118          CALL trd_vor_iom( kt ) 
     119         CALL trd_vor_iom( kt, Kmm ) 
    119120      END SELECT 
    120121      ! 
    … …  
    122123 
    123124 
    124    SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
     125   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm ) 
    125126      !!---------------------------------------------------------------------------- 
    126127      !!                  ***  ROUTINE trd_vor_zint  *** 
    … …  
    150151      !!---------------------------------------------------------------------- 
    151152      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
     153      INTEGER                     , INTENT(in   ) ::   Kmm        ! time level index 
    152154      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    153155      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    … …  
    175177               ikbu = mbkv(ji,jj) 
    176178               ikbv = mbkv(ji,jj)             
    177                zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 
    178                zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 
     179               zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu) 
     180               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv) 
    179181            END DO 
    180182         END DO 
    181183         ! 
    182184      CASE( jpvor_swf )        ! wind stress 
    183          zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1) 
    184          zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1) 
     185         zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1) 
     186         zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1) 
    185187         ! 
    186188      END SELECT 
    187189 
    188190      ! Average except for Beta.V 
    189       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    190       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     191      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     192      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    191193    
    192194      ! Curl 
    … …  
    207209 
    208210 
    209    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
     211   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm ) 
    210212      !!---------------------------------------------------------------------------- 
    211213      !!                  ***  ROUTINE trd_vor_zint  *** 
    … …  
    236238      ! 
    237239      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
     240      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level index 
    238241      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    239242      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    … …  
    257260      ! putrdvor and pvtrdvor terms 
    258261      DO jk = 1,jpk 
    259         zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk) 
    260         zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 
     262        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk) 
     263        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk) 
    261264      END DO 
    262265 
    … …  
    273276         END DO 
    274277         ! Average of the Curl and Surface mask 
    275          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 
     278         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 
    276279      ENDIF 
    277280      ! 
    278281      ! Average  
    279       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    280       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     282      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     283      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    281284      ! 
    282285      ! Curl 
    … …  
    298301 
    299302 
    300    SUBROUTINE trd_vor_iom( kt ) 
     303   SUBROUTINE trd_vor_iom( kt , Kmm ) 
    301304      !!---------------------------------------------------------------------- 
    302305      !!                  ***  ROUTINE trd_vor  *** 
    … …  
    306309      !!---------------------------------------------------------------------- 
    307310      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     311      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    308312      ! 
    309313      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    310314      INTEGER  ::   it, itmod        ! local integers 
    311315      REAL(wp) ::   zmean            ! local scalars 
    312       REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn 
     316      REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv 
    313317      !!---------------------------------------------------------------------- 
    314318 
    … …  
    327331 
    328332      vor_avr   (:,:) = 0._wp 
    329       zun       (:,:) = 0._wp 
    330       zvn       (:,:) = 0._wp 
     333      zuu       (:,:) = 0._wp 
     334      zvv       (:,:) = 0._wp 
    331335      vor_avrtot(:,:) = 0._wp 
    332336      vor_avrres(:,:) = 0._wp 
    … …  
    334338      ! Vertically averaged velocity 
    335339      DO jk = 1, jpk - 1 
    336          zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk) 
    337          zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk) 
     340         zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm) 
     341         zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm) 
    338342      END DO 
    339343  
    340       zun(:,:) = zun(:,:) * r1_hu_n(:,:) 
    341       zvn(:,:) = zvn(:,:) * r1_hv_n(:,:) 
     344      zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 
     345      zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 
    342346 
    343347      ! Curl 
    344348      DO ji = 1, jpim1 
    345349         DO jj = 1, jpjm1 
    346             vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    & 
    347                &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
     350            vor_avr(ji,jj) = (  ( zvv(ji+1,jj) - zvv(ji,jj) )    & 
     351               &              - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
    348352         END DO 
    349353      END DO 
Note: See TracChangeset for help on using the changeset viewer.