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 10789 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynkeg.F90 – NEMO

Ignore:
Timestamp:
2019-03-21T16:15:22+01:00 (5 years ago)
Author:
davestorkey
Message:

branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps: Convert first batch of DYN routines and "wn" -> "ww".

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynkeg.F90

    r10425 r10789  
    4444CONTAINS 
    4545 
    46    SUBROUTINE dyn_keg( kt, kscheme ) 
     46   SUBROUTINE dyn_keg( kt, ktlev, kscheme, pu_rhs, pv_rhs ) 
    4747      !!---------------------------------------------------------------------- 
    4848      !!                  ***  ROUTINE dyn_keg  *** 
     
    5454      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that  
    5555      !!      conserve kinetic energy. Compute the now horizontal kinetic energy  
    56       !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 
     56      !!         zhke = 1/2 [ mi-1( uu(:,:,:,ktlev)^2 ) + mj-1( vv(:,:,:,ktlev)^2 ) ] 
    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 * uu(:,:,:,ktlev)^2 + ((uu(j+1,ktlev)+uu(j-1,ktlev))/2)^2  ) 
     60      !!                    + mj-1(  2 * vv(:,:,:,ktlev)^2 + ((vv(i+1,ktlev)+vv(i-1,ktlev))/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 (pu_rhs,pv_rhs). 
     64      !!         pu_rhs = pu_rhs - 1/e1u di[ zhke ] 
     65      !!         pv_rhs = pv_rhs - 1/e2v dj[ zhke ] 
    6666      !! 
    67       !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
     67      !! ** Action : - Update the (pu_rhs, pv_rhs) with the hor. ke gradient trend 
    6868      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
    6969      !! 
     
    7272      !!---------------------------------------------------------------------- 
    7373      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
     74      INTEGER, INTENT( in ) ::   ktlev     ! time level index for source terms 
    7475      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
     76      REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
    7577      ! 
    7678      INTEGER  ::   ji, jj, jk, jb    ! dummy loop indices 
     
    9294      IF( l_trddyn ) THEN           ! Save the input trends 
    9395         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    94          ztrdu(:,:,:) = ua(:,:,:)  
    95          ztrdv(:,:,:) = va(:,:,:)  
     96         ztrdu(:,:,:) = pu_rhs(:,:,:)  
     97         ztrdv(:,:,:) = pv_rhs(:,:,:)  
    9698      ENDIF 
    9799       
     
    109111                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    110112                     ifu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
    111                      un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
     113                     uu(ii-ifu,ij,jk,ktlev) = uu(ii,ij,jk,ktlev) * umask(ii,ij,jk) 
    112114                  END DO 
    113115               END DO 
     
    119121                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    120122                     ifv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
    121                      vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
     123                     vv(ii,ij-ifv,jk,ktlev) = vv(ii,ij,jk,ktlev) * vmask(ii,ij,jk) 
    122124                  END DO 
    123125               END DO 
     
    132134            DO jj = 2, jpj 
    133135               DO ji = fs_2, jpi   ! vector opt. 
    134                   zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    135                      &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
    136                   zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    137                      &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
     136                  zu =    uu(ji-1,jj  ,jk,ktlev) * uu(ji-1,jj  ,jk,ktlev)   & 
     137                     &  + uu(ji  ,jj  ,jk,ktlev) * uu(ji  ,jj  ,jk,ktlev) 
     138                  zv =    vv(ji  ,jj-1,jk,ktlev) * vv(ji  ,jj-1,jk,ktlev)   & 
     139                     &  + vv(ji  ,jj  ,jk,ktlev) * vv(ji  ,jj  ,jk,ktlev) 
    138140                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
    139141               END DO   
     
    145147            DO jj = 2, jpjm1        
    146148               DO ji = fs_2, jpim1   ! vector opt. 
    147                   zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
    148                      &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
    149                      &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
    150                      &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
     149                  zu = 8._wp * ( uu(ji-1,jj  ,jk,ktlev) * uu(ji-1,jj  ,jk,ktlev)    & 
     150                     &         + uu(ji  ,jj  ,jk,ktlev) * uu(ji  ,jj  ,jk,ktlev) )  & 
     151                     &   +     ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) ) * ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) )   & 
     152                     &   +     ( uu(ji  ,jj-1,jk,ktlev) + uu(ji  ,jj+1,jk,ktlev) ) * ( uu(ji  ,jj-1,jk,ktlev) + uu(ji  ,jj+1,jk,ktlev) ) 
    151153                     ! 
    152                   zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
    153                      &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
    154                      &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
    155                      &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
     154                  zv = 8._wp * ( vv(ji  ,jj-1,jk,ktlev) * vv(ji  ,jj-1,jk,ktlev)    & 
     155                     &         + vv(ji  ,jj  ,jk,ktlev) * vv(ji  ,jj  ,jk,ktlev) )  & 
     156                     &  +      ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) ) * ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) )   & 
     157                     &  +      ( vv(ji-1,jj  ,jk,ktlev) + vv(ji+1,jj  ,jk,ktlev) ) * ( vv(ji-1,jj  ,jk,ktlev) + vv(ji+1,jj  ,jk,ktlev) ) 
    156158                  zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    157159               END DO   
     
    164166      IF (ln_bdy) THEN 
    165167         ! restore velocity masks at points outside boundary 
    166          un(:,:,:) = un(:,:,:) * umask(:,:,:) 
    167          vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
     168         uu(:,:,:,ktlev) = uu(:,:,:,ktlev) * umask(:,:,:) 
     169         vv(:,:,:,ktlev) = vv(:,:,:,ktlev) * vmask(:,:,:) 
    168170      ENDIF       
    169171 
     
    172174         DO jj = 2, jpjm1 
    173175            DO ji = fs_2, fs_jpim1   ! vector opt. 
    174                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    175                va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     176               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     177               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    176178            END DO  
    177179         END DO 
     
    179181      ! 
    180182      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    181          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    182          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     183         ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
     184         ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
    183185         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    184186         DEALLOCATE( ztrdu , ztrdv ) 
Note: See TracChangeset for help on using the changeset viewer.