Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (11 months ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/OCE/TRD/trddyn.F90

    r10425 r12377  
    3636 
    3737   !! * Substitutions 
    38 #  include "vectopt_loop_substitute.h90" 
     38#  include "do_loop_substitute.h90" 
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4444CONTAINS 
    4545 
    46    SUBROUTINE 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 
    124                                  DO jj = 2, jpjm1 
    125                                     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                                     END DO 
    129                                  END DO 
    130                               END DO 
     125                              DO_3D_00_00( 1, jpkm1 ) 
     126                                 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) ) 
     127                                 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) ) 
     128                              END_3D 
    131129                              CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 
    132130                              CALL iom_put( "utrd_udx", z3dx  ) 
     
    142140                              !                                    ! wind stress trends 
    143141                              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 ) 
     142                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u(:,:,1,Kmm) * rau0 ) 
     143                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v(:,:,1,Kmm) * rau0 ) 
    146144                              CALL iom_put( "utrd_tau", z2dx ) 
    147145                              CALL iom_put( "vtrd_tau", z2dy ) 
     
    159157!                                          ikbv = mbkv(ji,jj) 
    160158!                                          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) 
     159!                                               &         * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 
    162160!                                          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) 
     161!                                               &         * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 
    164162!                                    END DO 
    165163!                                 END DO 
  • NEMO/trunk/src/OCE/TRD/trdglo.F90

    r10425 r12377  
    5151 
    5252   !! * Substitutions 
    53 #  include "vectopt_loop_substitute.h90" 
     53#  include "do_loop_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    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 
     
    8485         ! 
    8586         CASE( 'TRA' )          !==  Tracers (T & S)  ==! 
    86             DO jk = 1, jpkm1       ! global sum of mask volume trend and trend*T (including interior mask) 
    87                DO jj = 1, jpj 
    88                   DO ji = 1, jpi         
    89                      zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    90                      zvt = ptrdx(ji,jj,jk) * zvm 
    91                      zvs = ptrdy(ji,jj,jk) * zvm 
    92                      tmo(ktrd) = tmo(ktrd) + zvt    
    93                      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) 
    96                   END DO 
    97                END DO 
    98             END DO 
     87            DO_3D_11_11( 1, jpkm1 ) 
     88               zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     89               zvt = ptrdx(ji,jj,jk) * zvm 
     90               zvs = ptrdy(ji,jj,jk) * zvm 
     91               tmo(ktrd) = tmo(ktrd) + zvt    
     92               smo(ktrd) = smo(ktrd) + zvs 
     93               t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm) 
     94               s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm) 
     95            END_3D 
    9996            !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 
    10097            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(:,:)  ) 
     98               tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 
     99               smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     100               t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
     101               s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:)  ) 
    105102            ENDIF 
    106103            ! 
     
    117114            ! 
    118115         CASE( 'DYN' )          !==  Momentum and KE  ==!         
    119             DO jk = 1, jpkm1 
    120                DO jj = 1, jpjm1 
    121                   DO ji = 1, jpim1 
    122                      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                      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                      umo(ktrd) = umo(ktrd) + zvt 
    127                      vmo(ktrd) = vmo(ktrd) + zvs 
    128                      hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs 
    129                   END DO 
    130                END DO 
    131             END DO 
     116            DO_3D_10_10( 1, jpkm1 ) 
     117               zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     118                  &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     119               zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     120                  &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     121               umo(ktrd) = umo(ktrd) + zvt 
     122               vmo(ktrd) = vmo(ktrd) + zvs 
     123               hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 
     124            END_3D 
    132125            !                  
    133126            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend 
    134127               z1_2rau0 = 0.5_wp / rau0 
    135                DO jj = 1, jpjm1 
    136                   DO ji = 1, jpim1 
    137                      zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    138                         &                                                     * z1_2rau0       * e1e2u(ji,jj) 
    139                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    140                         &                                                     * z1_2rau0       * e1e2v(ji,jj) 
    141                      umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    142                      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                   END DO 
    145                END DO 
     128               DO_2D_10_10 
     129                  zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     130                     &                                                     * z1_2rau0       * e1e2u(ji,jj) 
     131                  zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     132                     &                                                     * z1_2rau0       * e1e2v(ji,jj) 
     133                  umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
     134                  vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
     135                  hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 
     136               END_2D 
    146137            ENDIF 
    147138            !                        
     
    155146!                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels 
    156147!                        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) 
     148!                        zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 
     149!                        zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 
    159150!                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 
    160151!                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 
    161 !                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs 
     152!                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 
    162153!                     END DO 
    163154!                  END DO 
     
    183174 
    184175 
    185    SUBROUTINE glo_dyn_wri( kt ) 
     176   SUBROUTINE glo_dyn_wri( kt, Kmm ) 
    186177      !!--------------------------------------------------------------------- 
    187178      !!                  ***  ROUTINE glo_dyn_wri  *** 
     
    190181      !!---------------------------------------------------------------------- 
    191182      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     183      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    192184      ! 
    193185      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    209201         zkepe(:,:,:) = 0._wp 
    210202    
    211          CALL eos( tsn, rhd, rhop )       ! now potential density 
     203         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop )       ! now potential density 
    212204 
    213205         zcof = 0.5_wp / rau0             ! Density flux at w-point 
    214206         zkz(:,:,1) = 0._wp 
    215207         DO jk = 2, jpk 
    216             zkz(:,:,jk) = zcof * e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
     208            zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
    217209         END DO 
    218210          
    219211         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
    220          DO jk = 1, jpkm1 
    221             DO jj = 1, jpjm1 
    222                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                END DO 
    226             END DO 
    227          END DO 
     212         DO_3D_10_10( 1, jpkm1 ) 
     213            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) ) 
     214            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) ) 
     215         END_3D 
    228216          
    229          DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
    230             DO jj = 2, jpjm1 
    231                DO ji = 2, jpim1 
    232                   zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
    233                      &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    234                      &                 + 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) 
    236                END DO 
    237             END DO 
    238          END DO 
     217         DO_3D_00_00( 1, jpkm1 ) 
     218            zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
     219               &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
     220               &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
     221               &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     222         END_3D 
    239223 
    240224         ! I.2 Basin averaged kinetic energy trend 
     
    242226         peke = 0._wp 
    243227         DO jk = 1, jpkm1 
    244             peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) ) 
     228            peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 
    245229         END DO 
    246230         peke = grav * peke 
     
    506490 
    507491 
    508    SUBROUTINE trd_glo_init 
     492   SUBROUTINE trd_glo_init( Kmm ) 
    509493      !!--------------------------------------------------------------------- 
    510494      !!                  ***  ROUTINE trd_glo_init  *** 
     
    512496      !! ** Purpose :   Read the namtrd namelist 
    513497      !!---------------------------------------------------------------------- 
     498      INTEGER, INTENT(in) ::   Kmm   ! time level index 
    514499      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    515500      !!---------------------------------------------------------------------- 
     
    524509      tvolt = 0._wp 
    525510      DO jk = 1, jpkm1 
    526          tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     511         tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 
    527512      END DO 
    528513      CALL mpp_sum( 'trdglo', tvolt )   ! sum over the global domain 
     
    538523      tvolv = 0._wp 
    539524 
    540       DO jk = 1, jpk 
    541          DO jj = 2, jpjm1 
    542             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) 
    545             END DO 
    546          END DO 
    547       END DO 
     525      DO_3D_00_00( 1, jpk ) 
     526         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) 
     527         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) 
     528      END_3D 
    548529      CALL mpp_sum( 'trdglo', tvolu )   ! sums over the global domain 
    549530      CALL mpp_sum( 'trdglo', tvolv ) 
  • NEMO/trunk/src/OCE/TRD/trdini.F90

    r11536 r12377  
    2525   PUBLIC   trd_init   ! called by nemogcm.F90 module 
    2626 
    27    !! * Substitutions 
    28 #  include "vectopt_loop_substitute.h90" 
    2927   !!---------------------------------------------------------------------- 
    3028   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3432CONTAINS 
    3533 
    36    SUBROUTINE trd_init 
     34   SUBROUTINE trd_init( Kmm ) 
    3735      !!---------------------------------------------------------------------- 
    3836      !!                  ***  ROUTINE trd_init  *** 
     
    4038      !! ** Purpose :   Initialization of trend diagnostics 
    4139      !!---------------------------------------------------------------------- 
     40      INTEGER, INTENT(in) ::   Kmm  ! time level index 
    4241      INTEGER ::   ios   ! local integer 
    4342      !! 
     
    4645      !!---------------------------------------------------------------------- 
    4746      ! 
    48       REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : trends diagnostic 
    4947      READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 ) 
    5048901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd in reference namelist' ) 
    5149      ! 
    52       REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : trends diagnostic 
    5350      READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 
    5451902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd in configuration namelist' ) 
     
    9693 
    9794      !                             ! diagnostic initialization   
    98       IF( ln_glo_trd )   CALL trd_glo_init      ! global domain averaged trends 
     95      IF( ln_glo_trd )   CALL trd_glo_init( Kmm )      ! global domain averaged trends 
    9996      IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends   
    10097      IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends 
  • NEMO/trunk/src/OCE/TRD/trdken.F90

    r10425 r12377  
    4040 
    4141   !! * Substitutions 
    42 #  include "vectopt_loop_substitute.h90" 
     42#  include "do_loop_substitute.h90" 
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    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      ! 
     
    100101      zke(1,:, : ) = 0._wp 
    101102      zke(:,1, : ) = 0._wp 
    102       DO jk = 1, jpkm1 
    103          DO jj = 2, jpj 
    104             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) 
    109             END DO 
    110          END DO 
    111       END DO 
     103      DO_3D_01_01( 1, jpkm1 ) 
     104         zke(ji,jj,jk) = 0.5_wp * rau0 *( uu(ji  ,jj,jk,Kmm) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
     105            &                           + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  & 
     106            &                           + vv(ji,jj  ,jk,Kmm) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  & 
     107            &                           + vv(ji,jj-1,jk,Kmm) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk) 
     108      END_3D 
    112109      ! 
    113110      SELECT CASE( ktrd ) 
     
    122119         !                   !                                          ! wind stress trends 
    123120                                 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) 
     121                           z2dx(:,:) = uu(:,:,1,Kmm) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 
     122                           z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 
    126123                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    127                            DO jj = 2, jpj 
    128                               DO ji = 2, jpi 
    129                                  zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    130                                  &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    131                               END DO 
    132                            END DO 
     124                           DO_2D_01_01 
     125                              zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     126                              &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
     127                           END_2D 
    133128                                 CALL iom_put( "ketrd_tau"   , zke2d )  !  
    134129                                 DEALLOCATE( z2dx , z2dy , zke2d ) 
     
    141136!                  ikbu = mbku(ji,jj)         ! deepest ocean u- & v-levels 
    142137!                  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) 
     138!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) 
     139!                  z2dy(ji,jj) = vv(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) 
    145140!               END DO 
    146141!            END DO 
     
    157152         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf"   , zke )    ! asselin filter trends  
    158153!! 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.... 
     154!! reflechir a une possible sauvegarde du "vrai" uu(Kmm),vv(Kmm) pour le calcul de atf.... 
    160155! 
    161156!         IF( ln_drgimp ) THEN                                          ! bottom friction (implicit case) 
     
    164159!                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    165160!                  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) 
     161!                  z2dx(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrua(ji,jj) * uu(ji,jj,ikbu,Kmm) / e3u(ji,jj,ikbu,Kmm) 
     162!                  z2dy(ji,jj) = uu(ji,jj,ikbu,Kmm) * bfrva(ji,jj) * vv(ji,jj,ikbv,Kmm) / e3v(ji,jj,ikbv,Kmm) 
    168163!               END DO 
    169164!            END DO 
     
    179174        CASE( jpdyn_ken )   ;   ! kinetic energy 
    180175                    ! called in dynnxt.F90 before asselin time filter 
    181                     ! with putrd=ua and pvtrd=va 
     176                    ! with putrd=uu(Krhs) and pvtrd=vv(Krhs) 
    182177                    zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    183178                    CALL iom_put( "KE", zke ) 
    184179                    ! 
    185                     CALL ken_p2k( kt , zke ) 
     180                    CALL ken_p2k( kt , zke, Kmm ) 
    186181                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    187182         ! 
     
    191186 
    192187 
    193    SUBROUTINE ken_p2k( kt , pconv ) 
     188   SUBROUTINE ken_p2k( kt , pconv, Kmm ) 
    194189      !!--------------------------------------------------------------------- 
    195190      !!                 ***  ROUTINE ken_p2k  *** 
     
    202197      !!----------------------------------------------------------------------  
    203198      INTEGER                   , INTENT(in   ) ::   kt      ! ocean time-step index 
     199      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    204200      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pconv   !  
    205201      ! 
     
    214210       
    215211      !  Surface value (also valid in partial step case) 
    216       zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1) 
     212      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * ww(:,:,1) * e3w(:,:,1,Kmm) 
    217213 
    218214      ! interior value (2=<jk=<jpkm1) 
    219215      DO jk = 2, jpk 
    220          zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk) 
     216         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * ww(:,:,jk) * e3w(:,:,jk,Kmm) 
    221217      END DO 
    222218 
    223219      ! conv value on T-point 
    224       DO jk = 1, jpkm1 
    225          DO jj = 1, jpj 
    226             DO ji = 1, jpi 
    227                zcoef = 0.5_wp / e3t_n(ji,jj,jk) 
    228                pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 
    229             END DO 
    230          END DO 
    231       END DO 
     220      DO_3D_11_11( 1, jpkm1 ) 
     221         zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 
     222         pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) 
     223      END_3D 
    232224      ! 
    233225   END SUBROUTINE ken_p2k 
  • NEMO/trunk/src/OCE/TRD/trdmxl.F90

    r11536 r12377  
    6868   INTEGER ::   ionce, icount                    
    6969 
     70   !! * Substitutions 
     71#  include "do_loop_substitute.h90" 
    7072   !!---------------------------------------------------------------------- 
    7173   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    8688 
    8789 
    88    SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln ) 
     90   SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln, Kmm ) 
    8991      !!---------------------------------------------------------------------- 
    9092      !!                  ***  ROUTINE trd_tra_mng  *** 
     
    98100      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    99101      INTEGER                   , INTENT(in   ) ::   kt      ! time step index 
     102      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    100103      REAL(wp)                  , INTENT(in   ) ::   p2dt    ! time step  [s] 
    101104      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   kmxln   ! number of t-box for the vertical average  
     
    116119         ! 
    117120         wkx(:,:,:) = 0._wp         !==  now ML weights for vertical averaging  ==! 
    118          DO jk = 1, jpktrd               ! initialize wkx with vertical scale factor in mixed-layer 
    119             DO jj = 1,jpj 
    120                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                END DO 
    123             END DO 
    124          END DO 
     121         DO_3D_11_11( 1, jpktrd ) 
     122            IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     123         END_3D 
    125124         hmxl(:,:) = 0._wp               ! NOW mixed-layer depth 
    126125         DO jk = 1, jpktrd 
     
    136135         tml(:,:) = 0._wp   ;   sml(:,:) = 0._wp 
    137136         DO jk = 1, jpktrd 
    138             tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem) 
    139             sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal) 
     137            tml(:,:) = tml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_tem,Kmm) 
     138            sml(:,:) = sml(:,:) + wkx(:,:,jk) * ts(:,:,jk,jp_sal,Kmm) 
    140139         END DO 
    141140         ! 
     
    371370         hmxlbn(:,:) = hmxl(:,:) 
    372371 
    373          IF( ln_ctl ) THEN 
     372         IF( sn_cfctl%l_prtctl ) THEN 
    374373            WRITE(numout,*) '             we reach kt == nit000 + 1 = ', nit000+1 
    375374            CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask) 
     
    380379      END IF 
    381380 
    382       IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl ) ) THEN 
     381      IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. sn_cfctl%l_prtctl ) THEN 
    383382         IF( ln_trdmxl_instant ) THEN 
    384383            WRITE(numout,*) '             restart from kt == nit000 = ', nit000 
     
    548547         hmxlbn         (:,:)   = hmxl    (:,:) 
    549548          
    550          IF( ln_ctl ) THEN 
     549         IF( sn_cfctl%l_prtctl ) THEN 
    551550            IF( ln_trdmxl_instant ) THEN 
    552551               CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask) 
     
    732731      !!---------------------------------------------------------------------- 
    733732      ! 
    734       REWIND( numnam_ref )              ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic 
    735733      READ  ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 ) 
    736734901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist' ) 
    737735 
    738       REWIND( numnam_cfg )              ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic 
    739736      READ  ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 ) 
    740737902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist' ) 
  • NEMO/trunk/src/OCE/TRD/trdpen.F90

    r10425 r12377  
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S 
    3636 
    37    !! * Substitutions 
    38 #  include "vectopt_loop_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5553 
    5654 
    57    SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt ) 
     55   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm ) 
    5856      !!--------------------------------------------------------------------- 
    5957      !!                  ***  ROUTINE trd_tra_mng  *** 
     
    6664      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index 
    6765      INTEGER                   , INTENT(in) ::   kt             ! time step index 
     66      INTEGER                   , INTENT(in) ::   Kmm            ! time level index 
    6867      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s] 
    6968      ! 
     
    7776      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step 
    7877         nkstp = kt 
    79          CALL eos_pen( tsn, rab_PE, zpe ) 
     78         CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 
    8079         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 
    8180         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) 
     
    9594                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    9695                                   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) 
     96                                   z2d(:,:) = ww(:,:,1) * ( & 
     97                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm)    & 
     98                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm)    & 
     99                                     & ) / e3t(:,:,1,Kmm) 
    101100                                   CALL iom_put( "petrd_sad" , z2d ) 
    102101                                   DEALLOCATE( z2d ) 
     
    112111      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux) 
    113112      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 
    122113         ! 
    123114      END SELECT 
  • NEMO/trunk/src/OCE/TRD/trdtra.F90

    r10425 r12377  
    4141 
    4242   !! * Substitutions 
    43 #  include "vectopt_loop_substitute.h90" 
     43#  include "do_loop_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    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)  
     136               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     137               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
    137138            END DO 
    138             CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt 
     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)  
     150               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 
     151               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm)  
    151152            END DO 
    152             CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt 
     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 
     
    211213      ptrd(:,:,jpk) = 0._wp 
    212214      ! 
    213       DO jk = 1, jpkm1         ! advective trend 
    214          DO jj = 2, jpjm1 
    215             DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                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             END DO 
    220          END DO 
    221       END DO 
     215      DO_3D_00_00( 1, jpkm1 ) 
     216         ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
     217           &                  - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk)  )   & 
     218           &              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
     219      END_3D 
    222220      ! 
    223221   END SUBROUTINE trd_tra_adv 
    224222 
    225223 
    226    SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt ) 
     224   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    227225      !!--------------------------------------------------------------------- 
    228226      !!                  ***  ROUTINE trd_tra_mng  *** 
     
    236234      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    237235      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     236      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    238237      !!---------------------------------------------------------------------- 
    239238 
     
    243242 
    244243      !                   ! 3D output of tracers trends using IOM interface 
    245       IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
     244      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    246245 
    247246      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    248       IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
     247      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 
    249248 
    250249      !                   ! Potential ENergy trends 
    251       IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
     250      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt, Kmm ) 
    252251 
    253252      !                   ! Mixed layer trends for active tracers 
     
    290289 
    291290 
    292    SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt ) 
     291   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 
    293292      !!--------------------------------------------------------------------- 
    294293      !!                  ***  ROUTINE trd_tra_iom  *** 
     
    300299      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    301300      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     301      INTEGER                   , INTENT(in   ) ::   Kmm     ! time level index 
    302302      !! 
    303303      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     
    326326                                  IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    327327                                     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) 
     328                                     z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 
     329                                     z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 
    330330                                     CALL iom_put( "ttrd_sad", z2dx ) 
    331331                                     CALL iom_put( "strd_sad", z2dy ) 
  • NEMO/trunk/src/OCE/TRD/trdtrc.F90

    r10068 r12377  
    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/trunk/src/OCE/TRD/trdvor.F90

    r11536 r12377  
    5656 
    5757   !! * Substitutions 
    58 #  include "vectopt_loop_substitute.h90" 
     58#  include "do_loop_substitute.h90" 
    5959   !!---------------------------------------------------------------------- 
    6060   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    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 
    105          DO jj = 2, jpjm1                                                             ! wind stress trends 
    106             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 ) 
    109             END DO 
    110          END DO 
    111          ! 
    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  
     106         DO_2D_00_00 
     107            ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rau0 ) 
     108            ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rau0 ) 
     109         END_2D 
     110         ! 
     111         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm )                             ! zdf trend including surf./bot. stresses  
     112         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm )                             ! surface wind stress  
    114113      CASE( jpdyn_bfr ) 
    115          CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress 
     114         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm )                             ! Bottom stress 
    116115         ! 
    117116      CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends 
    118          CALL trd_vor_iom( kt ) 
     117         CALL trd_vor_iom( kt, Kmm ) 
    119118      END SELECT 
    120119      ! 
     
    122121 
    123122 
    124    SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
     123   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm ) 
    125124      !!---------------------------------------------------------------------------- 
    126125      !!                  ***  ROUTINE trd_vor_zint  *** 
     
    150149      !!---------------------------------------------------------------------- 
    151150      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
     151      INTEGER                     , INTENT(in   ) ::   Kmm        ! time level index 
    152152      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    153153      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
     
    171171      ! 
    172172      CASE( jpvor_bfr )        ! bottom friction 
    173          DO jj = 2, jpjm1 
    174             DO ji = fs_2, fs_jpim1  
    175                ikbu = mbkv(ji,jj) 
    176                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             END DO 
    180          END DO 
     173         DO_2D_00_00 
     174            ikbu = mbkv(ji,jj) 
     175            ikbv = mbkv(ji,jj)             
     176            zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu) 
     177            zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv) 
     178         END_2D 
    181179         ! 
    182180      CASE( jpvor_swf )        ! wind stress 
    183          zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1) 
    184          zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1) 
     181         zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1) 
     182         zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1) 
    185183         ! 
    186184      END SELECT 
    187185 
    188186      ! Average except for Beta.V 
    189       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    190       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     187      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     188      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    191189    
    192190      ! Curl 
     
    207205 
    208206 
    209    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
     207   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm ) 
    210208      !!---------------------------------------------------------------------------- 
    211209      !!                  ***  ROUTINE trd_vor_zint  *** 
     
    236234      ! 
    237235      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
     236      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level index 
    238237      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    239238      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
     
    257256      ! putrdvor and pvtrdvor terms 
    258257      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) 
     258        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk) 
     259        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk) 
    261260      END DO 
    262261 
     
    273272         END DO 
    274273         ! Average of the Curl and Surface mask 
    275          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 
     274         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 
    276275      ENDIF 
    277276      ! 
    278277      ! Average  
    279       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    280       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     278      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     279      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    281280      ! 
    282281      ! Curl 
     
    298297 
    299298 
    300    SUBROUTINE trd_vor_iom( kt ) 
     299   SUBROUTINE trd_vor_iom( kt , Kmm ) 
    301300      !!---------------------------------------------------------------------- 
    302301      !!                  ***  ROUTINE trd_vor  *** 
     
    306305      !!---------------------------------------------------------------------- 
    307306      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     307      INTEGER                   , INTENT(in   ) ::   Kmm            ! time level index 
    308308      ! 
    309309      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    310310      INTEGER  ::   it, itmod        ! local integers 
    311311      REAL(wp) ::   zmean            ! local scalars 
    312       REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn 
     312      REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv 
    313313      !!---------------------------------------------------------------------- 
    314314 
     
    327327 
    328328      vor_avr   (:,:) = 0._wp 
    329       zun       (:,:) = 0._wp 
    330       zvn       (:,:) = 0._wp 
     329      zuu       (:,:) = 0._wp 
     330      zvv       (:,:) = 0._wp 
    331331      vor_avrtot(:,:) = 0._wp 
    332332      vor_avrres(:,:) = 0._wp 
     
    334334      ! Vertically averaged velocity 
    335335      DO jk = 1, jpk - 1 
    336          zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk) 
    337          zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk) 
     336         zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm) 
     337         zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm) 
    338338      END DO 
    339339  
    340       zun(:,:) = zun(:,:) * r1_hu_n(:,:) 
    341       zvn(:,:) = zvn(:,:) * r1_hv_n(:,:) 
     340      zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 
     341      zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 
    342342 
    343343      ! Curl 
    344344      DO ji = 1, jpim1 
    345345         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) 
     346            vor_avr(ji,jj) = (  ( zvv(ji+1,jj) - zvv(ji,jj) )    & 
     347               &              - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
    348348         END DO 
    349349      END DO 
Note: See TracChangeset for help on using the changeset viewer.