model/src/diags_phi_hyd.F

b302538c50 Jean*0001 #include "PACKAGES_CONFIG.h"
6ac14281aa Jean*0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
                0005 C     !ROUTINE: DIAGS_PHI_HYD
                0006 C     !INTERFACE:
9a4858a22e Jean*0007       SUBROUTINE DIAGS_PHI_HYD(
6ac14281aa Jean*0008      I                       k, bi, bj, iMin,iMax, jMin,jMax,
                0009      I                       phiHydC,
                0010      I                       myTime, myIter, myThid)
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
9a4858a22e Jean*0013 C     | S/R DIAGS_PHI_HYD
                0014 C     | o Diagnose full hydrostatic Potential at cell center ;
6ac14281aa Jean*0015 C     |   used for output & with EOS funct. of P
                0016 C     *==========================================================*
                0017 C     | NOTE: For now, only contains the (total) Potential anomaly
                0018 C     |  since phiRef (for Atmos) is not available (not in common)
                0019 C     *==========================================================*
                0020 C     \ev
                0021
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 C     == Global variables ==
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "GRID.h"
                0029 #include "SURFACE.h"
                0030 #include "DYNVARS.h"
                0031
                0032 C     !INPUT/OUTPUT PARAMETERS:
                0033 C     == Routine Arguments ==
                0034 C     k, bi,bj      :: level & tile indices
                0035 C     iMin,iMax,jMin,jMax :: Loop counters
                0036 C     phiHydC    :: hydrostatic potential anomaly at cell center
                0037 C                  (atmos: =Geopotential ; ocean-z: =Pressure/rho)
                0038 C     myTime :: Current time
                0039 C     myIter :: Current iteration number
                0040 C     myThid :: Instance number for this call of the routine.
                0041       INTEGER k, bi,bj, iMin,iMax, jMin,jMax
                0042       _RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0043       _RL myTime
                0044       INTEGER myIter, myThid
                0045
                0046 #ifdef INCLUDE_PHIHYD_CALCULATION_CODE
                0047
                0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
c75189e180 Jean*0050 C     i,j        :: Loop counters
                0051 C     phiHydCstR :: total hydrostatic Potential (anomaly, for now),
                0052 C                   at fixed r-position, cell center level location.
6ac14281aa Jean*0053       INTEGER i,j
c75189e180 Jean*0054 #ifdef NONLIN_FRSURF
                0055       _RL facP, dPhiRef
                0056       _RL phiHydCstR(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0057 #endif /* NONLIN_FRSURF */
6ac14281aa Jean*0058 CEOP
9a4858a22e Jean*0059
c75189e180 Jean*0060         DO j=jMin,jMax
                0061          DO i=iMin,iMax
                0062            totPhiHyd(i,j,k,bi,bj) = phiHydC(i,j)
                0063      &            + Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
                0064      &            + phi0surf(i,j,bi,bj)
                0065 #ifdef NONLIN_FRSURF
                0066            phiHydCstR(i,j) = totPhiHyd(i,j,k,bi,bj)
                0067 #endif /* NONLIN_FRSURF */
                0068          ENDDO
                0069         ENDDO
                0070
9a4858a22e Jean*0071 #ifdef NONLIN_FRSURF
                0072 c     IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN
                0073       IF (select_rStar.GE.1 .AND. nonlinFreeSurf.GE.4 ) THEN
                0074 c# ifndef DISABLE_RSTAR_CODE
                0075 C-    Integral of b.dr = rStarFac * Integral of b.dr* :
c75189e180 Jean*0076        IF ( fluidIsAir ) THEN
9a4858a22e Jean*0077 C-     Consistent with Phi'= Integr[ theta'.dPi ] :
                0078         DO j=jMin,jMax
                0079          DO i=iMin,iMax
5332d6319a Jean*0080            facP = pStarFacK(i,j,bi,bj)
c75189e180 Jean*0081            dPhiRef = phiRef(2*k) - gravity*topoZ(i,j,bi,bj)
                0082      &                           - phi0surf(i,j,bi,bj)
9a4858a22e Jean*0083            totPhiHyd(i,j,k,bi,bj) =
c75189e180 Jean*0084      &              phiHydC(i,j)*facP
                0085      &            + MAX( dPhiRef, 0. _d 0 )*( facP - 1. _d 0 )
9a4858a22e Jean*0086      &            + phi0surf(i,j,bi,bj)
c75189e180 Jean*0087 c          phiHydCstR(i,j) = phiHydCstR(i,j)
                0088 c    &            + phiHydC(i,j)*( facP - 1. _d 0 )
9a4858a22e Jean*0089          ENDDO
                0090         ENDDO
c75189e180 Jean*0091        ELSEIF ( usingPCoords ) THEN
9a4858a22e Jean*0092         DO j=jMin,jMax
                0093          DO i=iMin,iMax
c75189e180 Jean*0094 c    &     dPhiRef = phiRef(2*k) - gravity*topoZ(i,j,bi,bj)
                0095 c    &                           - phi0surf(i,j,bi,bj)
                0096 C--    assume PhiRef is just (ps0 - p)/rhoConst :
                0097            dPhiRef =( Ro_surf(i,j,bi,bj)-rC(k) )*recip_rhoConst
9a4858a22e Jean*0098            totPhiHyd(i,j,k,bi,bj) =
                0099      &              phiHydC(i,j)*rStarFacC(i,j,bi,bj)
c75189e180 Jean*0100      &            + MAX( dPhiRef, 0. _d 0 )
                0101      &                *( rStarFacC(i,j,bi,bj) - 1. _d 0 )
9a4858a22e Jean*0102      &            + phi0surf(i,j,bi,bj)
c75189e180 Jean*0103 c          totPhiHyd(i,j,k,bi,bj) = phiHydCstR(i,j)
9a4858a22e Jean*0104          ENDDO
                0105         ENDDO
c75189e180 Jean*0106        ELSE
6ac14281aa Jean*0107         DO j=jMin,jMax
                0108          DO i=iMin,iMax
c75189e180 Jean*0109            dPhiRef =( Ro_surf(i,j,bi,bj)-rC(k) )*gravity
                0110            totPhiHyd(i,j,k,bi,bj) =
                0111      &              phiHydC(i,j)*rStarFacC(i,j,bi,bj)
                0112      &            + MAX( dPhiRef, 0. _d 0 )
                0113      &                *( rStarFacC(i,j,bi,bj) - 1. _d 0 )
9a4858a22e Jean*0114      &            + phi0surf(i,j,bi,bj)
c75189e180 Jean*0115 c          totPhiHyd(i,j,k,bi,bj) = phiHydCstR(i,j)
6ac14281aa Jean*0116          ENDDO
                0117         ENDDO
c75189e180 Jean*0118        ENDIF
b302538c50 Jean*0119 #ifdef ALLOW_DIAGNOSTICS
6dccb19154 Jean*0120 C--    skip diagnostics if called from INI_PRESSURE
                0121        IF ( useDiagnostics .AND. myIter.GE.0 ) THEN
b302538c50 Jean*0122         CALL DIAGNOSTICS_FILL(phiHydCstR,'PHIHYDcR',k,1,2,bi,bj,myThid)
                0123        ENDIF
                0124 #endif /* ALLOW_DIAGNOSTICS */
                0125
c75189e180 Jean*0126 c# endif /* DISABLE_RSTAR_CODE */
9a4858a22e Jean*0127       ENDIF
c75189e180 Jean*0128 #endif /* NONLIN_FRSURF */
6ac14281aa Jean*0129
                0130 #endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
                0131
                0132       RETURN
                0133       END