model/src/diags_phi_rlow.F

C $Header: /u/gcmpack/MITgcm/model/src/diags_phi_rlow.F,v 1.5 2010/01/15 19:25:21 jmc Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: DIAGS_PHI_RLOW
C     !INTERFACE:
      SUBROUTINE DIAGS_PHI_RLOW(
     I                       k, bi, bj, iMin,iMax, jMin,jMax,
     I                       phiHydF, phiHydC, alphRho, tFld, sFld,
     I                       myTime, myIter, myThid)
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R DIAGS_PHI_RLOW
C     | o Diagnose Phi-Hydrostatic at r-lower boundary
C     |   = bottom pressure (ocean in z-coord) ;
C     |   = sea surface elevation (ocean in p-coord) ;
C     |   = height at the top of atmosphere (in p-coord) ;
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"
#include "DYNVARS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     bi,bj      :: tile index
C     iMin,iMax,jMin,jMax :: Loop counters
C     phiHydF    :: hydrostatic potential anomaly at middle between
C                   2 centers k & k+1 (interface k+1)
C     phiHydC    :: hydrostatic potential anomaly at cell center
C                  (atmos: =Geopotential ; ocean-z: =Pressure/rho)
C     alphRho    :: Density (z-coord) or specific volume (p-coord)
C     tFld       :: Potential temp.
C     sFld       :: Salinity
C     myTime     :: Current time
C     myIter     :: Current iteration number
C     myThid     :: my Thread Id number
      INTEGER k, bi,bj, iMin,iMax, jMin,jMax
      _RL phiHydF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL alphRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      _RL myTime
      INTEGER myIter, myThid

#ifdef INCLUDE_PHIHYD_CALCULATION_CODE

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j :: Loop counters
      INTEGER i,j
      _RL zero, one, half
      _RL ddRloc, ratioRm, ratioRp
      PARAMETER ( zero= 0. _d 0 , one= 1. _d 0 , half= .5 _d 0 )
CEOP

      IF ( usingZCoords ) THEN

C----- Compute bottom pressure deviation from gravity*rho0*H
C      Start from phiHyd at the (bottom) tracer point and add Del_h*g*rho'
C      with Del_h = distance from the bottom up to tracer point

C--    Initialise to zero (otherwise phi0surf accumulate over land)
       IF ( k.EQ.1 ) THEN
         DO j=1-Oly,sNy+Oly
          DO i=1-Olx,sNx+Olx
            phiHydLow(i,j,bi,bj) = 0. _d 0
          ENDDO
         ENDDO
       ENDIF

       IF (integr_GeoPot.EQ.1) THEN
C  --  Finite Volume Form

         DO j=jMin,jMax
          DO i=iMin,iMax
           IF ( k .EQ. kLowC(i,j,bi,bj) ) THEN
             ddRloc = rC(k)-R_low(i,j,bi,bj)
             phiHydLow(i,j,bi,bj) = phiHydC(i,j)
     &            + ddRloc*gravity*alphRho(i,j)*recip_rhoConst
           ENDIF
          ENDDO
         ENDDO

       ELSE
C  --  Finite Difference Form

         ratioRm = one
         ratioRp = one
         IF (k.GT.1 ) ratioRm = half*drC(k)/(rF(k)-rC(k))
         IF (k.LT.Nr) ratioRp = half*drC(k+1)/(rC(k)-rF(k+1))

         DO j=jMin,jMax
          DO i=iMin,iMax
           IF ( k .EQ. kLowC(i,j,bi,bj) ) THEN
             ddRloc = rC(k)-R_low(i,j,bi,bj)
             phiHydLow(i,j,bi,bj) = phiHydC(i,j)
     &                  +( MIN(zero,ddRloc)*ratioRm
     &                    +MAX(zero,ddRloc)*ratioRp
     &                   )*gravity*alphRho(i,j)*recip_rhoConst
           ENDIF
          ENDDO
         ENDDO

C  --  end if integr_GeoPot = ...
       ENDIF

C  -- end usingZCoords
      ENDIF

      IF ( k.EQ.Nr ) THEN
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C  --  last level (bottom): rescale (r*) and add surface contribution

       IF ( usingPCoords ) THEN
C  -- P coordinate : Phi(R_low) is simply at the top :
        DO j=jMin,jMax
         DO i=iMin,iMax
           phiHydLow(i,j,bi,bj) = phiHydF(i,j)
         ENDDO
        ENDDO
       ENDIF

#ifdef NONLIN_FRSURF
c      IF ( select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN
       IF ( select_rStar.GT.0 .AND. nonlinFreeSurf.GE.4 ) THEN
        DO j=jMin,jMax
         DO i=iMin,iMax
           phiHydLow(i,j,bi,bj) = phiHydLow(i,j,bi,bj)
     &                          *rStarFacC(i,j,bi,bj)
         ENDDO
        ENDDO
       ENDIF
#endif /* NONLIN_FRSURF */

        DO j=jMin,jMax
         DO i=iMin,iMax
           phiHydLow(i,j,bi,bj) = phiHydLow(i,j,bi,bj)
     &            + Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
     &            + phi0surf(i,j,bi,bj)
         ENDDO
        ENDDO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C  -- end if k=Nr.
      ENDIF

#endif /* INCLUDE_PHIHYD_CALCULATION_CODE */

      RETURN
      END
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/model/src/diags_phi_rlow.F,v 1.5 2010/01/15 19:25:21 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: DIAGS_PHI_RLOW
8			C !INTERFACE:
9	jmc	1.5	SUBROUTINE DIAGS_PHI_RLOW(
10	jmc	1.1	I k, bi, bj, iMin,iMax, jMin,jMax,
11	jmc	1.2	I phiHydF, phiHydC, alphRho, tFld, sFld,
12	jmc	1.1	I myTime, myIter, myThid)
13			C !DESCRIPTION: \bv
14			C ==========================================================
15	jmc	1.5	C \| S/R DIAGS_PHI_RLOW
16	jmc	1.1	C \| o Diagnose Phi-Hydrostatic at r-lower boundary
17	jmc	1.5	C \| = bottom pressure (ocean in z-coord) ;
18	jmc	1.1	C \| = sea surface elevation (ocean in p-coord) ;
19			C \| = height at the top of atmosphere (in p-coord) ;
20			C ==========================================================
21			C \ev
22
23			C !USES:
24			IMPLICIT NONE
25			C == Global variables ==
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "PARAMS.h"
29			#include "GRID.h"
30			#include "SURFACE.h"
31			#include "DYNVARS.h"
32
33			C !INPUT/OUTPUT PARAMETERS:
34			C == Routine Arguments ==
35	jmc	1.5	C bi,bj :: tile index
36	jmc	1.1	C iMin,iMax,jMin,jMax :: Loop counters
37	jmc	1.5	C phiHydF :: hydrostatic potential anomaly at middle between
38	jmc	1.2	C 2 centers k & k+1 (interface k+1)
39			C phiHydC :: hydrostatic potential anomaly at cell center
40	jmc	1.1	C (atmos: =Geopotential ; ocean-z: =Pressure/rho)
41			C alphRho :: Density (z-coord) or specific volume (p-coord)
42			C tFld :: Potential temp.
43	jmc	1.5	C sFld :: Salinity
44			C myTime :: Current time
45			C myIter :: Current iteration number
46			C myThid :: my Thread Id number
47	jmc	1.1	INTEGER k, bi,bj, iMin,iMax, jMin,jMax
48	jmc	1.2	_RL phiHydF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49			_RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50	jmc	1.1	_RL alphRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51			_RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
52			_RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
53			_RL myTime
54			INTEGER myIter, myThid
55
56			#ifdef INCLUDE_PHIHYD_CALCULATION_CODE
57
58			C !LOCAL VARIABLES:
59			C == Local variables ==
60			C i,j :: Loop counters
61			INTEGER i,j
62			_RL zero, one, half
63	jmc	1.2	_RL ddRloc, ratioRm, ratioRp
64	jmc	1.1	PARAMETER ( zero= 0. _d 0 , one= 1. _d 0 , half= .5 _d 0 )
65			CEOP
66
67	jmc	1.6	IF ( usingZCoords ) THEN
68	jmc	1.1
69	jmc	1.2	C----- Compute bottom pressure deviation from gravityrho0H
70	jmc	1.5	C Start from phiHyd at the (bottom) tracer point and add Del_hgrho'
71	jmc	1.2	C with Del_h = distance from the bottom up to tracer point
72	jmc	1.1
73	jmc	1.6	C-- Initialise to zero (otherwise phi0surf accumulate over land)
74			IF ( k.EQ.1 ) THEN
75			DO j=1-Oly,sNy+Oly
76			DO i=1-Olx,sNx+Olx
77			phiHydLow(i,j,bi,bj) = 0. _d 0
78			ENDDO
79			ENDDO
80			ENDIF
81
82	jmc	1.1	IF (integr_GeoPot.EQ.1) THEN
83			C -- Finite Volume Form
84
85			DO j=jMin,jMax
86			DO i=iMin,iMax
87			IF ( k .EQ. kLowC(i,j,bi,bj) ) THEN
88	jmc	1.2	ddRloc = rC(k)-R_low(i,j,bi,bj)
89			phiHydLow(i,j,bi,bj) = phiHydC(i,j)
90			& + ddRlocgravityalphRho(i,j)*recip_rhoConst
91	jmc	1.1	ENDIF
92			ENDDO
93			ENDDO
94
95			ELSE
96			C -- Finite Difference Form
97
98	jmc	1.2	ratioRm = one
99			ratioRp = one
100			IF (k.GT.1 ) ratioRm = half*drC(k)/(rF(k)-rC(k))
101			IF (k.LT.Nr) ratioRp = half*drC(k+1)/(rC(k)-rF(k+1))
102	jmc	1.1
103			DO j=jMin,jMax
104			DO i=iMin,iMax
105	jmc	1.2	IF ( k .EQ. kLowC(i,j,bi,bj) ) THEN
106			ddRloc = rC(k)-R_low(i,j,bi,bj)
107			phiHydLow(i,j,bi,bj) = phiHydC(i,j)
108			& +( MIN(zero,ddRloc)*ratioRm
109			& +MAX(zero,ddRloc)*ratioRp
110			& )gravityalphRho(i,j)*recip_rhoConst
111	jmc	1.1	ENDIF
112			ENDDO
113			ENDDO
114
115			C -- end if integr_GeoPot = ...
116			ENDIF
117	jmc	1.5
118	jmc	1.6	C -- end usingZCoords
119	jmc	1.2	ENDIF
120
121	jmc	1.6	IF ( k.EQ.Nr ) THEN
122	jmc	1.1	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
123	jmc	1.2	C -- last level (bottom): rescale (r*) and add surface contribution
124	jmc	1.1
125	jmc	1.6	IF ( usingPCoords ) THEN
126	jmc	1.2	C -- P coordinate : Phi(R_low) is simply at the top :
127			DO j=jMin,jMax
128			DO i=iMin,iMax
129			phiHydLow(i,j,bi,bj) = phiHydF(i,j)
130	jmc	1.1	ENDDO
131	jmc	1.2	ENDDO
132			ENDIF
133	jmc	1.1
134	jmc	1.5	#ifdef NONLIN_FRSURF
135			c IF ( select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN
136			IF ( select_rStar.GT.0 .AND. nonlinFreeSurf.GE.4 ) THEN
137			DO j=jMin,jMax
138			DO i=iMin,iMax
139			phiHydLow(i,j,bi,bj) = phiHydLow(i,j,bi,bj)
140			& *rStarFacC(i,j,bi,bj)
141			ENDDO
142			ENDDO
143			ENDIF
144			#endif /* NONLIN_FRSURF */
145
146	jmc	1.2	DO j=jMin,jMax
147			DO i=iMin,iMax
148			phiHydLow(i,j,bi,bj) = phiHydLow(i,j,bi,bj)
149			& + Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
150	jmc	1.5	& + phi0surf(i,j,bi,bj)
151	jmc	1.1	ENDDO
152	jmc	1.2	ENDDO
153	jmc	1.1
154			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
155	jmc	1.2	C -- end if k=Nr.
156	jmc	1.1	ENDIF
157
158			#endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
159
160			RETURN
161			END