pkg/mom_common/mom_calc_ke.F

dcd1f9d5ca Alis*0001 #include "MOM_COMMON_OPTIONS.h"
aea29c8517 Alis*0002
71207ba845 Alis*0003 CBOP
                0004 C !ROUTINE: MOM_CALC_KE
                0005
                0006 C !INTERFACE: ==========================================================
aea29c8517 Alis*0007       SUBROUTINE MOM_CALC_KE(
dcd1f9d5ca Alis*0008      I        bi,bj,k,KEscheme,
aea29c8517 Alis*0009      I        uFld, vFld,
                0010      O        KE,
                0011      I        myThid)
                0012
71207ba845 Alis*0013 C !DESCRIPTION:
                0014 C Calculates the Kinetic energy of horizontal flow
                0015 C \begin{equation*}
                0016 C KE = \frac{1}{2} \left( h_w \overline{u^2}^i + h_s \overline{v^2}^j \right)
                0017 C \end{equation*}
                0018
                0019 C !USES: ===============================================================
                0020       IMPLICIT NONE
aea29c8517 Alis*0021 #include "SIZE.h"
                0022 #include "GRID.h"
                0023
71207ba845 Alis*0024 C !INPUT PARAMETERS: ===================================================
                0025 C  bi,bj                :: tile indices
                0026 C  k                    :: vertical level
3bbb8876e3 Jean*0027 C  KEscheme             :: spacial discretisation scheme for KE
71207ba845 Alis*0028 C  uFld                 :: zonal flow
                0029 C  vFld                 :: meridional flow
3bbb8876e3 Jean*0030 C  KE                   :: Kinetic Energy
71207ba845 Alis*0031 C  myThid               :: thread number
aea29c8517 Alis*0032       INTEGER bi,bj,k
                0033       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0034       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
dcd1f9d5ca Alis*0035       INTEGER KEscheme
aea29c8517 Alis*0036       INTEGER myThid
                0037
71207ba845 Alis*0038 C !OUTPUT PARAMETERS: ==================================================
                0039 C  KE                   :: Kinetic energy
                0040       _RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0041
                0042 C !LOCAL VARIABLES: ====================================================
                0043 C  i,j                  :: loop indices
f6007f3cc5 Jean*0044       INTEGER i,j
71207ba845 Alis*0045 CEOP
aea29c8517 Alis*0046
                0047 C       This defn of KE should not ever be used. Just to let you know.
                0048 C                            2       2
                0049 C                 1  /  ___I    ___J   \
                0050 C           KE = --- |   U    +  V     |
                0051 C                 2  \                 /
                0052 C
14bb46b4fa Jean*0053 #ifdef ALLOW_AUTODIFF
f6007f3cc5 Jean*0054       DO j=1-OLy,sNy+OLy
                0055        DO i=1-OLx,sNx+OLx
                0056          KE(i,j) = 0.
                0057        ENDDO
                0058       ENDDO
                0059 #endif
                0060
f7fdcad707 Jean*0061       IF (KEscheme.EQ.-1) THEN
f6007f3cc5 Jean*0062        DO j=1-OLy,sNy+OLy-1
                0063         DO i=1-OLx,sNx+OLx-1
dcd1f9d5ca Alis*0064          KE(i,j) = 0.125*(
                0065      &             ( uFld(i,j)+uFld(i+1, j ) )**2
                0066      &            +( vFld(i,j)+vFld( i ,j+1) )**2 )
f6007f3cc5 Jean*0067         ENDDO
dcd1f9d5ca Alis*0068        ENDDO
aea29c8517 Alis*0069
f7fdcad707 Jean*0070       ELSEIF (KEscheme.EQ.0) THEN
aea29c8517 Alis*0071 C       This defn of KE should be used for the vector invariant equations.
                0072 C                       _____I  _____J
                0073 C                 1  /     2       2   \
                0074 C           KE = --- |   U    +  V     |
                0075 C                 2  \                 /
                0076 C
f6007f3cc5 Jean*0077        DO j=1-OLy,sNy+OLy-1
                0078         DO i=1-OLx,sNx+OLx-1
dcd1f9d5ca Alis*0079          KE(i,j) = 0.25*(
f7fdcad707 Jean*0080      &           ( uFld( i , j )*uFld( i , j )
                0081      &            +uFld(i+1, j )*uFld(i+1, j ) )
                0082      &         + ( vFld( i , j )*vFld( i , j )
dcd1f9d5ca Alis*0083      &            +vFld( i ,j+1)*vFld( i ,j+1) )
f7fdcad707 Jean*0084      &                  )
dcd1f9d5ca Alis*0085         ENDDO
                0086        ENDDO
aea29c8517 Alis*0087
f7fdcad707 Jean*0088       ELSEIF (KEscheme.EQ.1) THEN
                0089 C       As above but including the area
f6007f3cc5 Jean*0090        DO j=1-OLy,sNy+OLy-1
                0091         DO i=1-OLx,sNx+OLx-1
f7fdcad707 Jean*0092          KE(i,j) = 0.25*(
                0093      &           ( uFld(i, j )*uFld(i, j )*rAw(i ,j, bi,bj)
                0094      &            +uFld(i+1,j)*uFld(i+1,j)*rAw(i+1,j,bi,bj) )
                0095      &         + ( vFld(i, j )*vFld(i, j )*rAs(i ,j, bi,bj)
                0096      &            +vFld(i,j+1)*vFld(i,j+1)*rAs(i,j+1,bi,bj) )
                0097      &                  )*recip_rA(i,j,bi,bj)
                0098         ENDDO
                0099        ENDDO
                0100
                0101       ELSEIF (KEscheme.EQ.2) THEN
                0102 C       As KEscheme=0 but including the lopping factors and should be used
aea29c8517 Alis*0103 C       for the conservative form of the momentum equations.
f6007f3cc5 Jean*0104        DO j=1-OLy,sNy+OLy-1
                0105         DO i=1-OLx,sNx+OLx-1
dcd1f9d5ca Alis*0106          KE(i,j) = 0.25*(
616600b8d2 Patr*0107      &           ( uFld( i , j )*uFld( i , j )*_hFacW(i,j,k,bi,bj)
                0108      &            +uFld(i+1, j )*uFld(i+1, j )*_hFacW(i+1,j,k,bi,bj) )
                0109      &         + ( vFld( i , j )*vFld( i , j )*_hFacS(i,j,k,bi,bj)
                0110      &            +vFld( i ,j+1)*vFld( i ,j+1)*_hFacS(i,j+1,k,bi,bj) )
                0111      &            )*_recip_hFacC(i,j,k,bi,bj)
dcd1f9d5ca Alis*0112         ENDDO
aea29c8517 Alis*0113        ENDDO
dcd1f9d5ca Alis*0114
f7fdcad707 Jean*0115       ELSEIF (KEscheme.EQ.3) THEN
                0116 C       As above but including the area
f6007f3cc5 Jean*0117        DO j=1-OLy,sNy+OLy-1
                0118         DO i=1-OLx,sNx+OLx-1
3bbb8876e3 Jean*0119          KE(i,j) = 0.25*(
f7fdcad707 Jean*0120      &           (
616600b8d2 Patr*0121      &    uFld(i, j )*uFld(i, j )
                0122      &        *_hFacW(i ,j, k,bi,bj)*rAw(i ,j, bi,bj)
                0123      &   +uFld(i+1,j)*uFld(i+1,j)
                0124      &        *_hFacW(i+1,j,k,bi,bj)*rAw(i+1,j,bi,bj)
f6007f3cc5 Jean*0125      &           )
f7fdcad707 Jean*0126      &         + (
616600b8d2 Patr*0127      &    vFld(i, j )*vFld(i, j )
                0128      &        *_hFacS(i, j, k,bi,bj)*rAs(i ,j, bi,bj)
                0129      &   +vFld(i,j+1)*vFld(i,j+1)
                0130      &        *_hFacS(i,j+1,k,bi,bj)*rAs(i,j+1,bi,bj)
                0131      &           )      )*_recip_hFacC(i,j,k,bi,bj)
                0132      &                   * recip_rA(i,j,bi,bj)
3bbb8876e3 Jean*0133         ENDDO
                0134        ENDDO
                0135
dcd1f9d5ca Alis*0136       ELSE
                0137        STOP 'S/R MOM_CALC_KE: We should never reach this point!'
                0138       ENDIF
aea29c8517 Alis*0139
                0140       RETURN
                0141       END