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 12377 for NEMO/trunk/src/OCE/TRD/trdken.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years 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:
2 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/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 
Note: See TracChangeset for help on using the changeset viewer.