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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynkeg.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals

      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynkeg.F90

    r12178 r12928  
    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.