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/DYN/dynkeg.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/DYN/dynkeg.F90

    r11536 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 dyn_keg( kt, kscheme ) 
     46   SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs ) 
    4747      !!---------------------------------------------------------------------- 
    4848      !!                  ***  ROUTINE dyn_keg  *** 
     
    5757      !!              * kscheme = nkeg_HW : Hollingsworth correction following 
    5858      !!      Arakawa (2001). The now horizontal kinetic energy is given by: 
    59       !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  ) 
    60       !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ] 
     59      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((u(j+1)+u(j-1))/2)^2  ) 
     60      !!                    + mj-1(  2 * vn^2 + ((v(i+1)+v(i-1))/2)^2  ) ] 
    6161      !!       
    6262      !!      Take its horizontal gradient and add it to the general momentum 
    63       !!      trend (ua,va). 
    64       !!         ua = ua - 1/e1u di[ zhke ] 
    65       !!         va = va - 1/e2v dj[ zhke ] 
     63      !!      trend. 
     64      !!         u(rhs) = u(rhs) - 1/e1u di[ zhke ] 
     65      !!         v(rhs) = v(rhs) - 1/e2v dj[ zhke ] 
    6666      !! 
    67       !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
     67      !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend 
    6868      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
    6969      !! 
     
    7171      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    7272      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    74       INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
     73      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
     74      INTEGER                             , INTENT( in )  ::  kscheme          ! =0/1   type of KEG scheme  
     75      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    7577      ! 
    7678      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     
    9092      IF( l_trddyn ) THEN           ! Save the input trends 
    9193         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    92          ztrdu(:,:,:) = ua(:,:,:)  
    93          ztrdv(:,:,:) = va(:,:,:)  
     94         ztrdu(:,:,:) = puu(:,:,:,Krhs)  
     95         ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
    9496      ENDIF 
    9597       
     
    99101      ! 
    100102      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
    101          DO jk = 1, jpkm1 
    102             DO jj = 2, jpj 
    103                DO ji = fs_2, jpi   ! vector opt. 
    104                   zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    105                      &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
    106                   zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    107                      &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
    108                   zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
    109                END DO   
    110             END DO 
    111          END DO 
     103         DO_3D_01_01( 1, jpkm1 ) 
     104            zu =    puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)   & 
     105               &  + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) 
     106            zv =    pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)   & 
     107               &  + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) 
     108            zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
     109         END_3D 
    112110      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    113          DO jk = 1, jpkm1 
    114             DO jj = 2, jpjm1        
    115                DO ji = fs_2, jpim1   ! vector opt. 
    116                   zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
    117                      &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
    118                      &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
    119                      &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
    120                      ! 
    121                   zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
    122                      &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
    123                      &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
    124                      &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
    125                   zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    126                END DO   
    127             END DO 
    128          END DO 
     111         DO_3D_00_00( 1, jpkm1 ) 
     112            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    & 
     113               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  & 
     114               &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
     115               &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     116               ! 
     117            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    & 
     118               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  & 
     119               &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   & 
     120               &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) 
     121            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
     122         END_3D 
    129123         CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. ) 
    130124         ! 
    131125      END SELECT  
    132126      ! 
    133       DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    134          DO jj = 2, jpjm1 
    135             DO ji = fs_2, fs_jpim1   ! vector opt. 
    136                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    137                va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    138             END DO  
    139          END DO 
    140       END DO 
     127      DO_3D_00_00( 1, jpkm1 ) 
     128         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     129         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     130      END_3D 
    141131      ! 
    142132      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    143          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    144          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    145          CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
     133         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
     134         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     135         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt, Kmm ) 
    146136         DEALLOCATE( ztrdu , ztrdv ) 
    147137      ENDIF 
    148138      ! 
    149       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   & 
    150          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     139      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg  - Ua: ', mask1=umask,   & 
     140         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    151141      ! 
    152142      IF( ln_timing )   CALL timing_stop('dyn_keg') 
Note: See TracChangeset for help on using the changeset viewer.