/[MITgcm]/MITgcm/model/src/calc_phi_hyd.F
ViewVC logotype

Annotation of /MITgcm/model/src/calc_phi_hyd.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.24 - (hide annotations) (download)
Tue Dec 10 02:55:47 2002 UTC (21 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint47e_post, checkpoint47c_post, checkpoint48b_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint47i_post, checkpoint47d_post, checkpoint47g_post, checkpoint48a_post, checkpoint47j_post, branch-exfmods-tag, checkpoint48c_post, checkpoint47f_post, checkpoint48, checkpoint47h_post
Branch point for: branch-exfmods-curt
Changes since 1.23: +46 -53 lines
 * allows a more accurate definition of Ro_Surf (selectFindRoSurf=1)
   when using P-coordinate; only implemented for atmospheric config.

1 jmc 1.24 C $Header: /u/gcmpack/MITgcm/model/src/calc_phi_hyd.F,v 1.23 2002/11/15 03:01:21 heimbach Exp $
2 cnh 1.16 C $Name: $
3 cnh 1.1
4 cnh 1.6 #include "CPP_OPTIONS.h"
5 cnh 1.1
6 cnh 1.16 CBOP
7     C !ROUTINE: CALC_PHI_HYD
8     C !INTERFACE:
9 adcroft 1.9 SUBROUTINE CALC_PHI_HYD(
10     I bi, bj, iMin, iMax, jMin, jMax, K,
11 mlosch 1.20 I tFld, sFld,
12 adcroft 1.9 U phiHyd,
13     I myThid)
14 cnh 1.16 C !DESCRIPTION: \bv
15     C *==========================================================*
16 cnh 1.1 C | SUBROUTINE CALC_PHI_HYD |
17 jmc 1.11 C | o Integrate the hydrostatic relation to find the Hydros. |
18 cnh 1.16 C *==========================================================*
19 jmc 1.11 C | Potential (ocean: Pressure/rho ; atmos = geopotential)|
20 adcroft 1.9 C | On entry: |
21 mlosch 1.20 C | tFld,sFld are the current thermodynamics quantities|
22 adcroft 1.9 C | (unchanged on exit) |
23 jmc 1.11 C | phiHyd(i,j,1:k-1) is the hydrostatic Potential |
24 adcroft 1.9 C | at cell centers (tracer points) |
25     C | - 1:k-1 layers are valid |
26     C | - k:Nr layers are invalid |
27 jmc 1.11 C | phiHyd(i,j,k) is the hydrostatic Potential |
28 jmc 1.14 C | (ocean only_^) at cell the interface k (w point above) |
29 adcroft 1.9 C | On exit: |
30 jmc 1.11 C | phiHyd(i,j,1:k) is the hydrostatic Potential |
31 adcroft 1.9 C | at cell centers (tracer points) |
32     C | - 1:k layers are valid |
33     C | - k+1:Nr layers are invalid |
34 jmc 1.11 C | phiHyd(i,j,k+1) is the hydrostatic Potential (P/rho) |
35 jmc 1.14 C | (ocean only-^) at cell the interface k+1 (w point below)|
36     C | Atmosphere: |
37 jmc 1.24 C | integr_GeoPot allows to select one integration method |
38 jmc 1.14 C | (see the list below) |
39 cnh 1.16 C *==========================================================*
40     C \ev
41     C !USES:
42 cnh 1.1 IMPLICIT NONE
43     C == Global variables ==
44     #include "SIZE.h"
45     #include "GRID.h"
46     #include "EEPARAMS.h"
47     #include "PARAMS.h"
48 jmc 1.24 c #include "FFIELDS.h"
49 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
50     #include "tamc.h"
51     #include "tamc_keys.h"
52     #endif /* ALLOW_AUTODIFF_TAMC */
53 adcroft 1.19 #include "SURFACE.h"
54 mlosch 1.20 #include "DYNVARS.h"
55 heimbach 1.13
56 cnh 1.16 C !INPUT/OUTPUT PARAMETERS:
57 cnh 1.1 C == Routine arguments ==
58     INTEGER bi,bj,iMin,iMax,jMin,jMax,K
59 mlosch 1.20 _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
60     _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
61 cnh 1.2 _RL phiHyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
62 adcroft 1.9 INTEGER myThid
63 jmc 1.14
64 adcroft 1.9 #ifdef INCLUDE_PHIHYD_CALCULATION_CODE
65    
66 cnh 1.16 C !LOCAL VARIABLES:
67 cnh 1.1 C == Local variables ==
68 jmc 1.14 INTEGER i,j, Kp1
69     _RL zero, one, half
70 adcroft 1.9 _RL alphaRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71 adcroft 1.19 _RL dRloc,dRlocKp1,locAlpha
72 jmc 1.14 _RL ddPI, ddPIm, ddPIp, ratioRp, ratioRm
73 cnh 1.16 CEOP
74 jmc 1.14
75     zero = 0. _d 0
76     one = 1. _d 0
77     half = .5 _d 0
78    
79     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80     C Atmosphere:
81 jmc 1.24 C integr_GeoPot => select one option for the integration of the Geopotential:
82 jmc 1.14 C = 0 : Energy Conserving Form, No hFac ;
83     C = 1 : Finite Volume Form, with hFac, linear in P by Half level;
84     C =2,3: Finite Difference Form, with hFac, linear in P between 2 Tracer levels
85     C 2 : case Tracer level at the middle of InterFace_W;
86     C 3 : case InterFace_W at the middle of Tracer levels;
87     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
88 adcroft 1.9
89 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
90     act1 = bi - myBxLo(myThid)
91     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
92    
93     act2 = bj - myByLo(myThid)
94     max2 = myByHi(myThid) - myByLo(myThid) + 1
95    
96     act3 = myThid - 1
97     max3 = nTx*nTy
98    
99     act4 = ikey_dynamics - 1
100    
101     ikey = (act1 + 1) + act2*max1
102     & + act3*max1*max2
103     & + act4*max1*max2*max3
104     #endif /* ALLOW_AUTODIFF_TAMC */
105    
106 adcroft 1.9 IF ( buoyancyRelation .eq. 'OCEANIC' ) THEN
107     C This is the hydrostatic pressure calculation for the Ocean
108     C which uses the FIND_RHO() routine to calculate density
109     C before integrating g*rho over the current layer/interface
110    
111     dRloc=drC(k)
112     IF (k.EQ.1) dRloc=drF(1)
113     IF (k.EQ.Nr) THEN
114     dRlocKp1=0.
115     ELSE
116     dRlocKp1=drC(k+1)
117     ENDIF
118    
119     C-- If this is the top layer we impose the boundary condition
120     C P(z=eta) = P(atmospheric_loading)
121     IF (k.EQ.1) THEN
122     DO j=jMin,jMax
123     DO i=iMin,iMax
124 jmc 1.24 phiHyd(i,j,k) = phi0surf(i,j,bi,bj)
125 adcroft 1.9 ENDDO
126     ENDDO
127     ENDIF
128    
129     C Calculate density
130 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
131 heimbach 1.23 kkey = (ikey-1)*Nr + k
132     CADJ STORE tFld (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
133 mlosch 1.20 CADJ STORE sFld (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
134 heimbach 1.13 #endif /* ALLOW_AUTODIFF_TAMC */
135 mlosch 1.20 CALL FIND_RHO( bi, bj, iMin, iMax, jMin, jMax, k, k,
136     & tFld, sFld,
137 adcroft 1.9 & alphaRho, myThid)
138 adcroft 1.22
139     C Quasi-hydrostatic terms are added in as if they modify the buoyancy
140     IF (quasiHydrostatic) THEN
141     CALL QUASIHYDROSTATICTERMS(bi,bj,k,alphaRho,myThid)
142     ENDIF
143 adcroft 1.9
144     C Hydrostatic pressure at cell centers
145     DO j=jMin,jMax
146     DO i=iMin,iMax
147     #ifdef ALLOW_AUTODIFF_TAMC
148 jmc 1.14 c Patrick, is this directive correct or even necessary in
149 heimbach 1.13 c this new code?
150     c Yes, because of phiHyd(i,j,k+1)=phiHyd(i,j,k)+...
151     c within the k-loop.
152 adcroft 1.9 CADJ GENERAL
153     #endif /* ALLOW_AUTODIFF_TAMC */
154    
155 mlosch 1.21 CmlC---------- This discretization is the "finite volume" form
156     CmlC which has not been used to date since it does not
157     CmlC conserve KE+PE exactly even though it is more natural
158     CmlC
159     Cml IF ( K .EQ. kLowC(i,j,bi,bj) ) THEN
160     Cml phiHydLow(i,j,bi,bj) = phiHyd(i,j,k)
161     Cml & + hFacC(i,j,k,bi,bj)
162     Cml & *drF(K)*gravity*alphaRho(i,j)*recip_rhoConst
163     Cml & + gravity*etaN(i,j,bi,bj)
164     Cml ENDIF
165     Cml IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
166     Cml & drF(K)*gravity*alphaRho(i,j)*recip_rhoConst
167     Cml phiHyd(i,j,k)=phiHyd(i,j,k)+
168     Cml & 0.5*drF(K)*gravity*alphaRho(i,j)*recip_rhoConst
169     CmlC-----------------------------------------------------------------------
170 adcroft 1.9
171     C---------- This discretization is the "energy conserving" form
172     C which has been used since at least Adcroft et al., MWR 1997
173     C
174 mlosch 1.20
175 adcroft 1.9 phiHyd(i,j,k)=phiHyd(i,j,k)+
176 jmc 1.11 & 0.5*dRloc*gravity*alphaRho(i,j)*recip_rhoConst
177 adcroft 1.9 IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
178 jmc 1.11 & 0.5*dRlocKp1*gravity*alphaRho(i,j)*recip_rhoConst
179 adcroft 1.9 C-----------------------------------------------------------------------
180 mlosch 1.20
181     C---------- Compute bottom pressure deviation from gravity*rho0*H
182     C This has to be done starting from phiHyd at the current
183     C tracer point and .5 of the cell's thickness has to be
184     C substracted from hFacC
185     IF ( K .EQ. kLowC(i,j,bi,bj) ) THEN
186     phiHydLow(i,j,bi,bj) = phiHyd(i,j,k)
187 mlosch 1.21 & + (hFacC(i,j,k,bi,bj)-.5)*drF(K)
188 mlosch 1.20 & *gravity*alphaRho(i,j)*recip_rhoConst
189     & + gravity*etaN(i,j,bi,bj)
190     ENDIF
191     C-----------------------------------------------------------------------
192    
193 adcroft 1.9 ENDDO
194     ENDDO
195    
196 adcroft 1.19 ELSEIF ( buoyancyRelation .eq. 'OCEANICP' ) THEN
197     C This is the hydrostatic pressure calculation for the Ocean
198     C which uses the FIND_RHO() routine to calculate density
199     C before integrating g*rho over the current layer/interface
200 mlosch 1.21 #ifdef ALLOW_AUTODIFF_TAMC
201     CADJ GENERAL
202     #endif /* ALLOW_AUTODIFF_TAMC */
203 adcroft 1.19
204     dRloc=drC(k)
205     IF (k.EQ.1) dRloc=drF(1)
206     IF (k.EQ.Nr) THEN
207     dRlocKp1=0.
208     ELSE
209     dRlocKp1=drC(k+1)
210     ENDIF
211    
212     IF (k.EQ.1) THEN
213     DO j=jMin,jMax
214     DO i=iMin,iMax
215 jmc 1.24 phiHyd(i,j,k) = phi0surf(i,j,bi,bj)
216 adcroft 1.19 ENDDO
217     ENDDO
218     ENDIF
219    
220     C Calculate density
221     #ifdef ALLOW_AUTODIFF_TAMC
222     kkey = (ikey-1)*Nr + k
223 heimbach 1.23 CADJ STORE tFld (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
224 mlosch 1.20 CADJ STORE sFld (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
225 adcroft 1.19 #endif /* ALLOW_AUTODIFF_TAMC */
226 mlosch 1.20 CALL FIND_RHO( bi, bj, iMin, iMax, jMin, jMax, k, k,
227     & tFld, sFld,
228 adcroft 1.19 & alphaRho, myThid)
229 heimbach 1.23 #ifdef ALLOW_AUTODIFF_TAMC
230     CADJ STORE alphaRho (:,:) = comlev1_bibj_k, key=kkey, byte=isbyte
231     #endif /* ALLOW_AUTODIFF_TAMC */
232    
233 adcroft 1.19
234     C Hydrostatic pressure at cell centers
235     DO j=jMin,jMax
236     DO i=iMin,iMax
237 mlosch 1.21 locAlpha=alphaRho(i,j)+rhoConst
238 adcroft 1.19 IF (locAlpha.NE.0.) locAlpha=maskC(i,j,k,bi,bj)/locAlpha
239    
240 mlosch 1.21 CmlC---------- This discretization is the "finite volume" form
241     CmlC which has not been used to date since it does not
242     CmlC conserve KE+PE exactly even though it is more natural
243     CmlC
244     Cml IF ( K .EQ. kLowC(i,j,bi,bj) ) THEN
245     Cml phiHydLow(i,j,bi,bj) = phiHyd(i,j,k)
246     Cml & + hFacC(i,j,k,bi,bj)*drF(K)*locAlpha
247     Cml & + Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
248     Cml ENDIF
249     Cml IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
250     Cml & drF(K)*locAlpha
251     Cml phiHyd(i,j,k)=phiHyd(i,j,k)+
252     Cml & 0.5*drF(K)*locAlpha
253     CmlC-----------------------------------------------------------------------
254 adcroft 1.9
255 adcroft 1.19 C---------- This discretization is the "energy conserving" form
256     C which has been used since at least Adcroft et al., MWR 1997
257     C
258 mlosch 1.21
259 adcroft 1.19 phiHyd(i,j,k)=phiHyd(i,j,k)+
260     & 0.5*dRloc*locAlpha
261     IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
262     & 0.5*dRlocKp1*locAlpha
263 mlosch 1.21
264 adcroft 1.19 C-----------------------------------------------------------------------
265 mlosch 1.20
266 mlosch 1.21 C---------- Compute gravity*(sea surface elevation) first
267 mlosch 1.20 C This has to be done starting from phiHyd at the current
268     C tracer point and .5 of the cell's thickness has to be
269     C substracted from hFacC
270     IF ( K .EQ. kLowC(i,j,bi,bj) ) THEN
271     phiHydLow(i,j,bi,bj) = phiHyd(i,j,k)
272     & + (hFacC(i,j,k,bi,bj)-0.5)*drF(k)*locAlpha
273     & + Bo_surf(i,j,bi,bj)*etaN(i,j,bi,bj)
274     ENDIF
275     C-----------------------------------------------------------------------
276    
277 adcroft 1.19 ENDDO
278     ENDDO
279 adcroft 1.9
280     ELSEIF ( buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN
281 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
282 adcroft 1.9 C This is the hydrostatic geopotential calculation for the Atmosphere
283     C The ideal gas law is used implicitly here rather than calculating
284     C the specific volume, analogous to the oceanic case.
285    
286     C Integrate d Phi / d pi
287    
288 jmc 1.24 IF (integr_GeoPot.EQ.0) THEN
289 jmc 1.14 C -- Energy Conserving Form, No hFac --
290     C------------ The integration for the first level phi(k=1) is the same
291     C for both the "finite volume" and energy conserving methods.
292 adcroft 1.17 Ci *NOTE* o Working with geopotential Anomaly, the geopotential boundary
293     C condition is simply Phi-prime(Ro_surf)=0.
294 jmc 1.14 C o convention ddPI > 0 (same as drF & drC)
295     C-----------------------------------------------------------------------
296 adcroft 1.9 IF (K.EQ.1) THEN
297 jmc 1.24 ddPIp=atm_Cp*( ((rF(K)/atm_Po)**atm_kappa)
298     & -((rC(K)/atm_Po)**atm_kappa) )
299 adcroft 1.9 DO j=jMin,jMax
300 jmc 1.14 DO i=iMin,iMax
301 jmc 1.24 phiHyd(i,j,K)= phi0surf(i,j,bi,bj)
302     & +ddPIp*maskC(i,j,K,bi,bj)
303 mlosch 1.20 & *(tFld(I,J,K,bi,bj)-tRef(K))
304 jmc 1.14 ENDDO
305     ENDDO
306     ELSE
307     C-------- This discretization is the energy conserving form
308 jmc 1.24 ddPI=atm_Cp*( ((rC(K-1)/atm_Po)**atm_kappa)
309     & -((rC( K )/atm_Po)**atm_kappa) )*0.5
310 jmc 1.14 DO j=jMin,jMax
311     DO i=iMin,iMax
312     phiHyd(i,j,K)=phiHyd(i,j,K-1)
313     & +ddPI*maskC(i,j,K-1,bi,bj)
314 mlosch 1.20 & *(tFld(I,J,K-1,bi,bj)-tRef(K-1))
315 jmc 1.14 & +ddPI*maskC(i,j, K ,bi,bj)
316 mlosch 1.20 & *(tFld(I,J, K ,bi,bj)-tRef( K ))
317 jmc 1.14 C Old code (atmos-exact) looked like this
318     Cold phiHyd(i,j,K)=phiHyd(i,j,K-1) - ddPI*
319 mlosch 1.20 Cold & (tFld(I,J,K-1,bi,bj)+tFld(I,J,K,bi,bj)-2.*tRef(K))
320 jmc 1.14 ENDDO
321     ENDDO
322     ENDIF
323     C end: Energy Conserving Form, No hFac --
324 adcroft 1.9 C-----------------------------------------------------------------------
325 jmc 1.14
326 jmc 1.24 ELSEIF (integr_GeoPot.EQ.1) THEN
327 jmc 1.14 C -- Finite Volume Form, with hFac, linear in P by Half level --
328     C---------
329     C Finite Volume formulation consistent with Partial Cell, linear in p by piece
330     C Note: a true Finite Volume form should be linear between 2 Interf_W :
331     C phi_C = (phi_W_k+ phi_W_k+1)/2 ; but not accurate in Stratosphere (low p)
332     C also: if Interface_W at the middle between tracer levels, this form
333     C is close to the Energy Cons. form in the Interior, except for the
334     C non-linearity in PI(p)
335     C---------
336     IF (K.EQ.1) THEN
337 jmc 1.24 ddPIp=atm_Cp*( ((rF(K)/atm_Po)**atm_kappa)
338     & -((rC(K)/atm_Po)**atm_kappa) )
339 jmc 1.14 DO j=jMin,jMax
340     DO i=iMin,iMax
341 jmc 1.24 phiHyd(i,j,K)= phi0surf(i,j,bi,bj)
342     & +ddPIp*_hFacC(I,J, K ,bi,bj)
343 mlosch 1.20 & *(tFld(I,J, K ,bi,bj)-tRef( K ))
344 adcroft 1.9 ENDDO
345     ENDDO
346     ELSE
347 jmc 1.24 ddPIm=atm_Cp*( ((rC(K-1)/atm_Po)**atm_kappa)
348     & -((rF( K )/atm_Po)**atm_kappa) )
349     ddPIp=atm_Cp*( ((rF( K )/atm_Po)**atm_kappa)
350     & -((rC( K )/atm_Po)**atm_kappa) )
351 jmc 1.14 DO j=jMin,jMax
352     DO i=iMin,iMax
353     phiHyd(i,j,K) = phiHyd(i,j,K-1)
354 mlosch 1.18 & +ddPIm*_hFacC(I,J,K-1,bi,bj)
355 mlosch 1.20 & *(tFld(I,J,K-1,bi,bj)-tRef(K-1))
356 mlosch 1.18 & +ddPIp*_hFacC(I,J, K ,bi,bj)
357 mlosch 1.20 & *(tFld(I,J, K ,bi,bj)-tRef( K ))
358 jmc 1.14 ENDDO
359     ENDDO
360     ENDIF
361     C end: Finite Volume Form, with hFac, linear in P by Half level --
362 adcroft 1.9 C-----------------------------------------------------------------------
363    
364 jmc 1.24 ELSEIF (integr_GeoPot.EQ.2) THEN
365 jmc 1.14 C -- Finite Difference Form, with hFac, Tracer Lev. = middle --
366     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
367     C Finite Difference formulation consistent with Partial Cell,
368     C case Tracer level at the middle of InterFace_W
369     C linear between 2 Tracer levels ; conserve energy in the Interior
370     C---------
371     Kp1 = min(Nr,K+1)
372     IF (K.EQ.1) THEN
373 jmc 1.24 ddPIm=atm_Cp*( ((rF( K )/atm_Po)**atm_kappa)
374     & -((rC( K )/atm_Po)**atm_kappa) ) * 2. _d 0
375     ddPIp=atm_Cp*( ((rC( K )/atm_Po)**atm_kappa)
376     & -((rC(Kp1)/atm_Po)**atm_kappa) )
377 jmc 1.14 DO j=jMin,jMax
378     DO i=iMin,iMax
379 jmc 1.24 phiHyd(i,j,K)= phi0surf(i,j,bi,bj)
380     & +( ddPIm*max(zero, _hFacC(i,j,K,bi,bj)-half)
381 mlosch 1.18 & +ddPIp*min(zero, _hFacC(i,j,K,bi,bj)-half) )
382 mlosch 1.20 & *(tFld(i,j, K ,bi,bj)-tRef( K ))
383 jmc 1.14 & * maskC(i,j, K ,bi,bj)
384     ENDDO
385     ENDDO
386     ELSE
387 jmc 1.24 ddPIm=atm_Cp*( ((rC(K-1)/atm_Po)**atm_kappa)
388     & -((rC( K )/atm_Po)**atm_kappa) )
389     ddPIp=atm_Cp*( ((rC( K )/atm_Po)**atm_kappa)
390     & -((rC(Kp1)/atm_Po)**atm_kappa) )
391 jmc 1.14 DO j=jMin,jMax
392     DO i=iMin,iMax
393     phiHyd(i,j,K) = phiHyd(i,j,K-1)
394     & + ddPIm*0.5
395 mlosch 1.20 & *(tFld(i,j,K-1,bi,bj)-tRef(K-1))
396 jmc 1.14 & * maskC(i,j,K-1,bi,bj)
397 mlosch 1.18 & +(ddPIm*max(zero, _hFacC(i,j,K,bi,bj)-half)
398     & +ddPIp*min(zero, _hFacC(i,j,K,bi,bj)-half) )
399 mlosch 1.20 & *(tFld(i,j, K ,bi,bj)-tRef( K ))
400 jmc 1.14 & * maskC(i,j, K ,bi,bj)
401     ENDDO
402     ENDDO
403     ENDIF
404     C end: Finite Difference Form, with hFac, Tracer Lev. = middle --
405 adcroft 1.9 C-----------------------------------------------------------------------
406    
407 jmc 1.24 ELSEIF (integr_GeoPot.EQ.3) THEN
408 jmc 1.14 C -- Finite Difference Form, with hFac, Interface_W = middle --
409     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
410     C Finite Difference formulation consistent with Partial Cell,
411     C Valid & accurate if Interface_W at middle between tracer levels
412     C linear in p between 2 Tracer levels ; conserve energy in the Interior
413     C---------
414     Kp1 = min(Nr,K+1)
415     IF (K.EQ.1) THEN
416     ratioRm=0.5*drF(K)/(rF(k)-rC(K))
417     ratioRp=drF(K)*recip_drC(Kp1)
418 jmc 1.24 ddPIm=atm_Cp*( ((rF( K )/atm_Po)**atm_kappa)
419     & -((rC( K )/atm_Po)**atm_kappa) ) * 2. _d 0
420     ddPIp=atm_Cp*( ((rC( K )/atm_Po)**atm_kappa)
421     & -((rC(Kp1)/atm_Po)**atm_kappa) )
422 jmc 1.14 DO j=jMin,jMax
423     DO i=iMin,iMax
424 jmc 1.24 phiHyd(i,j,K)= phi0surf(i,j,bi,bj)
425     & +( ddPIm*max(zero,(_hFacC(i,j,K,bi,bj)-one)*ratioRm+half)
426 mlosch 1.18 & +ddPIp*min(zero, _hFacC(i,j,K,bi,bj)*ratioRp -half) )
427 mlosch 1.20 & *(tFld(i,j, K ,bi,bj)-tRef( K ))
428 jmc 1.14 & * maskC(i,j, K ,bi,bj)
429     ENDDO
430     ENDDO
431     ELSE
432     ratioRm=drF(K)*recip_drC(K)
433     ratioRp=drF(K)*recip_drC(Kp1)
434 jmc 1.24 ddPIm=atm_Cp*( ((rC(K-1)/atm_Po)**atm_kappa)
435     & -((rC( K )/atm_Po)**atm_kappa) )
436     ddPIp=atm_Cp*( ((rC( K )/atm_Po)**atm_kappa)
437     & -((rC(Kp1)/atm_Po)**atm_kappa) )
438 adcroft 1.9 DO j=jMin,jMax
439 jmc 1.14 DO i=iMin,iMax
440     phiHyd(i,j,K) = phiHyd(i,j,K-1)
441     & + ddPIm*0.5
442 mlosch 1.20 & *(tFld(i,j,K-1,bi,bj)-tRef(K-1))
443 jmc 1.14 & * maskC(i,j,K-1,bi,bj)
444 mlosch 1.18 & +(ddPIm*max(zero,(_hFacC(i,j,K,bi,bj)-one)*ratioRm+half)
445     & +ddPIp*min(zero, _hFacC(i,j,K,bi,bj)*ratioRp -half) )
446 mlosch 1.20 & *(tFld(i,j, K ,bi,bj)-tRef( K ))
447 jmc 1.14 & * maskC(i,j, K ,bi,bj)
448     ENDDO
449 adcroft 1.9 ENDDO
450     ENDIF
451 jmc 1.14 C end: Finite Difference Form, with hFac, Interface_W = middle --
452     C-----------------------------------------------------------------------
453 cnh 1.1
454 jmc 1.14 ELSE
455 jmc 1.24 STOP 'CALC_PHI_HYD: Bad integr_GeoPot option !'
456 jmc 1.14 ENDIF
457 cnh 1.6
458 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
459 adcroft 1.9 ELSE
460 jmc 1.24 STOP 'CALC_PHI_HYD: Bad value of buoyancyRelation !'
461 cnh 1.5 ENDIF
462 cnh 1.1
463 jmc 1.14 #endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
464 cnh 1.6
465 jmc 1.11 RETURN
466     END

  ViewVC Help
Powered by ViewVC 1.1.22