model/src/calc_grad_phi_fv.F

3d9080e0a5 Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: CALC_GRAD_PHI_FV
                0005 C     !INTERFACE:
                0006       SUBROUTINE CALC_GRAD_PHI_FV(
                0007      I                       k, bi, bj, iMin,iMax, jMin,jMax,
                0008      I                       phiHydF, phiHydU, pKappaF, pKappaU,
                0009      O                       dPhiHydX, dPhiHydY,
                0010      I                       myTime, myIter, myThid)
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
                0013 C     | S/R CALC_GRAD_PHI_FV
                0014 C     | o Calculate the gradient of Hydrostatic pressure anomaly
                0015 C     |   using Finite-Volume method from S.-J. Lin (QJRMS, 1997)
                0016 C     *==========================================================*
                0017 C     | o used with sigma-coords - might be useful also with r*
                0018 C     *==========================================================*
                0019 C     \ev
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023 C     == Global variables ==
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028 #include "SURFACE.h"
                0029 c#include "DYNVARS.h"
                0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     == Routine Arguments ==
                0033 C     bi,bj      :: tile index
                0034 C     iMin,iMax,jMin,jMax :: Loop counters
                0035 C     phiHydF    :: hydrostatic potential anomaly at interface k
                0036 C                  (atmos: =Geopotential ; ocean-z: =Pressure/rho)
                0037 C     phiHydU    :: hydrostatic potential anomaly at interface k+1 (Upper k)
                0038 C     pKappaF    :: (p/Po)^kappa at interface k
                0039 C     pKappaU    :: (p/Po)^kappa at interface k+1 (Upper k)
                0040 C     dPhiHydX,Y :: Gradient (X & Y directions) of Hyd. Potential
                0041 C     myTime :: Current time
                0042 C     myIter :: Current iteration number
                0043 C     myThid :: Instance number for this call of the routine.
                0044       INTEGER k, bi,bj, iMin,iMax, jMin,jMax
                0045       _RL phiHydF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0046       _RL phiHydU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0047       _RL pKappaF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0048       _RL pKappaU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0049       _RL dPhiHydX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       _RL dPhiHydY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0051       _RL myTime
                0052       INTEGER myIter, myThid
                0053
                0054 #ifdef INCLUDE_PHIHYD_CALCULATION_CODE
                0055
                0056 C     !LOCAL VARIABLES:
                0057 C     == Local variables ==
                0058 C     i,j :: Loop counters
                0059       INTEGER i,j
                0060       _RL dpk_dip, dpk_dim
                0061       _RL dpk_djp, dpk_djm
                0062 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0063 CEOP
                0064
                0065 C--   Zonal & Meridional gradient of potential anomaly
                0066       DO j=1-OLy,sNy+OLy
                0067        DO i=1-OLx,sNx+OLx
                0068         dPhiHydX(i,j)  = 0. _d 0
                0069         dPhiHydY(i,j)  = 0. _d 0
                0070        ENDDO
                0071       ENDDO
                0072       DO j=jMin,jMax
                0073        DO i=iMin+1,iMax
                0074         dpk_dip = pKappaF( i ,j) - pKappaU(i-1,j)
                0075         dpk_dim = pKappaF(i-1,j) - pKappaU( i ,j)
                0076         dPhiHydX(i,j) = ( phi0surf(i,j,bi,bj) - phi0surf(i-1,j,bi,bj) )
                0077      &                + (  dpk_dip*( phiHydU(i,j) - phiHydF(i-1,j) )
                0078      &                   + dpk_dim*( phiHydF(i,j) - phiHydU(i-1,j) )
                0079      &                  )/( dpk_dip + dpk_dim )
                0080         dPhiHydX(i,j) = _recip_dxC(i,j,bi,bj)*dPhiHydX(i,j)
                0081 c    &                * recip_deepFacC(k)*recip_rhoFacC(k)
                0082        ENDDO
                0083       ENDDO
                0084       DO j=jMin+1,jMax
                0085        DO i=iMin,iMax
                0086         dpk_djp = pKappaF(i, j ) - pKappaU(i,j-1)
                0087         dpk_djm = pKappaF(i,j-1) - pKappaU(i, j )
                0088         dPhiHydY(i,j) = ( phi0surf(i,j,bi,bj) - phi0surf(i,j-1,bi,bj) )
                0089      &                + (  dpk_djp*( phiHydU(i,j) - phiHydF(i,j-1) )
                0090      &                   + dpk_djm*( phiHydF(i,j) - phiHydU(i,j-1) )
                0091      &                  )/( dpk_djp + dpk_djm )
                0092         dPhiHydY(i,j) = _recip_dyC(i,j,bi,bj)*dPhiHydY(i,j)
                0093 c    &                * recip_deepFacC(k)*recip_rhoFacC(k)
                0094        ENDDO
                0095       ENDDO
                0096
                0097 C--   Apply mask:
                0098       DO j=1-OLy,sNy+OLy
                0099        DO i=1-OLx,sNx+OLx
                0100          dPhiHydX(i,j) = dPhiHydX(i,j)*_maskW(i,j,k,bi,bj)
                0101          dPhiHydY(i,j) = dPhiHydY(i,j)*_maskS(i,j,k,bi,bj)
                0102        ENDDO
                0103       ENDDO
                0104
                0105 #endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
                0106
                0107       RETURN
                0108       END