/[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.17 - (hide annotations) (download)
Thu Sep 27 18:14:20 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint44e_post, release1_p13_pre, checkpoint44f_post, checkpoint43a-release1mods, release1_p13, chkpt44d_post, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, release1_p11, icebear5, icebear4, icebear3, icebear2, release1-branch_tutorials, checkpoint45d_post, chkpt44a_post, checkpoint44h_pre, chkpt44c_pre, checkpoint45a_post, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, release1_p10, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint44g_post, checkpoint45b_post, release1-branch-end, release1_final_v1, checkpoint46, checkpoint44b_post, checkpoint46a_pre, checkpoint45c_post, ecco_ice2, ecco_ice1, checkpoint44h_post, release1_p12_pre, ecco_c44_e22, ecco_c44_e25, chkpt44a_pre, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint44, checkpoint45, chkpt44c_post, checkpoint44f_pre, release1-branch_branchpoint
Branch point for: c24_e25_ice, release1_final, release1-branch, release1, ecco-branch, release1_50yr, icebear, release1_coupled
Changes since 1.16: +3 -3 lines
Deleted single apostrophy (').

1 adcroft 1.17 C $Header: /u/gcmpack/models/MITgcmUV/model/src/calc_phi_hyd.F,v 1.16 2001/09/26 18:09:14 cnh 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     I theta, salt,
12     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     C | theta,salt are the current thermodynamics quantities|
22     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     C | Integr_GeoPot allows to select one integration method |
38     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 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
49     #include "tamc.h"
50     #include "tamc_keys.h"
51     #endif /* ALLOW_AUTODIFF_TAMC */
52    
53 cnh 1.16 C !INPUT/OUTPUT PARAMETERS:
54 cnh 1.1 C == Routine arguments ==
55     INTEGER bi,bj,iMin,iMax,jMin,jMax,K
56 adcroft 1.9 _RL theta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
57     _RL salt(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
58 cnh 1.2 _RL phiHyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
59 adcroft 1.9 INTEGER myThid
60 jmc 1.14
61 adcroft 1.9 #ifdef INCLUDE_PHIHYD_CALCULATION_CODE
62    
63 cnh 1.16 C !LOCAL VARIABLES:
64 cnh 1.1 C == Local variables ==
65 jmc 1.14 INTEGER i,j, Kp1
66     _RL zero, one, half
67 adcroft 1.9 _RL alphaRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL dRloc,dRlocKp1
69 jmc 1.14 _RL ddPI, ddPIm, ddPIp, ratioRp, ratioRm
70 cnh 1.16 CEOP
71 jmc 1.14
72     zero = 0. _d 0
73     one = 1. _d 0
74     half = .5 _d 0
75    
76     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
77     C Atmosphere:
78     C Integr_GeoPot => select one option for the integration of the Geopotential:
79     C = 0 : Energy Conserving Form, No hFac ;
80     C = 1 : Finite Volume Form, with hFac, linear in P by Half level;
81     C =2,3: Finite Difference Form, with hFac, linear in P between 2 Tracer levels
82     C 2 : case Tracer level at the middle of InterFace_W;
83     C 3 : case InterFace_W at the middle of Tracer levels;
84     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
85 adcroft 1.9
86 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
87     act1 = bi - myBxLo(myThid)
88     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
89    
90     act2 = bj - myByLo(myThid)
91     max2 = myByHi(myThid) - myByLo(myThid) + 1
92    
93     act3 = myThid - 1
94     max3 = nTx*nTy
95    
96     act4 = ikey_dynamics - 1
97    
98     ikey = (act1 + 1) + act2*max1
99     & + act3*max1*max2
100     & + act4*max1*max2*max3
101     #endif /* ALLOW_AUTODIFF_TAMC */
102    
103 adcroft 1.9 IF ( buoyancyRelation .eq. 'OCEANIC' ) THEN
104     C This is the hydrostatic pressure calculation for the Ocean
105     C which uses the FIND_RHO() routine to calculate density
106     C before integrating g*rho over the current layer/interface
107    
108     dRloc=drC(k)
109     IF (k.EQ.1) dRloc=drF(1)
110     IF (k.EQ.Nr) THEN
111     dRlocKp1=0.
112     ELSE
113     dRlocKp1=drC(k+1)
114     ENDIF
115    
116     C-- If this is the top layer we impose the boundary condition
117     C P(z=eta) = P(atmospheric_loading)
118     IF (k.EQ.1) THEN
119     DO j=jMin,jMax
120     DO i=iMin,iMax
121     C *NOTE* The loading should go here but has not been implemented yet
122     phiHyd(i,j,k)=0.
123     ENDDO
124     ENDDO
125     ENDIF
126    
127     C Calculate density
128 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
129     kkey = (ikey-1)*Nr + k
130     CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
131     CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
132     #endif /* ALLOW_AUTODIFF_TAMC */
133 adcroft 1.9 CALL FIND_RHO( bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,
134     & theta, salt,
135     & alphaRho, myThid)
136    
137     C Hydrostatic pressure at cell centers
138     DO j=jMin,jMax
139     DO i=iMin,iMax
140     #ifdef ALLOW_AUTODIFF_TAMC
141 jmc 1.14 c Patrick, is this directive correct or even necessary in
142 heimbach 1.13 c this new code?
143     c Yes, because of phiHyd(i,j,k+1)=phiHyd(i,j,k)+...
144     c within the k-loop.
145 adcroft 1.9 CADJ GENERAL
146     #endif /* ALLOW_AUTODIFF_TAMC */
147    
148     C---------- This discretization is the "finite volume" form
149     C which has not been used to date since it does not
150     C conserve KE+PE exactly even though it is more natural
151     C
152     c IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
153 jmc 1.11 c & drF(K)*gravity*alphaRho(i,j)*recip_rhoConst
154 adcroft 1.9 c phiHyd(i,j,k)=phiHyd(i,j,k)+
155 jmc 1.11 c & 0.5*drF(K)*gravity*alphaRho(i,j)*recip_rhoConst
156 adcroft 1.9 C-----------------------------------------------------------------------
157    
158     C---------- This discretization is the "energy conserving" form
159     C which has been used since at least Adcroft et al., MWR 1997
160     C
161     phiHyd(i,j,k)=phiHyd(i,j,k)+
162 jmc 1.11 & 0.5*dRloc*gravity*alphaRho(i,j)*recip_rhoConst
163 adcroft 1.9 IF (k.LT.Nr) phiHyd(i,j,k+1)=phiHyd(i,j,k)+
164 jmc 1.11 & 0.5*dRlocKp1*gravity*alphaRho(i,j)*recip_rhoConst
165 adcroft 1.9 C-----------------------------------------------------------------------
166     ENDDO
167     ENDDO
168    
169    
170    
171     ELSEIF ( buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN
172 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
173 adcroft 1.9 C This is the hydrostatic geopotential calculation for the Atmosphere
174     C The ideal gas law is used implicitly here rather than calculating
175     C the specific volume, analogous to the oceanic case.
176    
177     C Integrate d Phi / d pi
178    
179 jmc 1.14 IF (Integr_GeoPot.EQ.0) THEN
180     C -- Energy Conserving Form, No hFac --
181     C------------ The integration for the first level phi(k=1) is the same
182     C for both the "finite volume" and energy conserving methods.
183 adcroft 1.17 Ci *NOTE* o Working with geopotential Anomaly, the geopotential boundary
184     C condition is simply Phi-prime(Ro_surf)=0.
185 jmc 1.14 C o convention ddPI > 0 (same as drF & drC)
186     C-----------------------------------------------------------------------
187 adcroft 1.9 IF (K.EQ.1) THEN
188 jmc 1.14 ddPIp=atm_cp*( ((rF(K)/atm_po)**atm_kappa)
189     & -((rC(K)/atm_po)**atm_kappa) )
190 adcroft 1.9 DO j=jMin,jMax
191 jmc 1.14 DO i=iMin,iMax
192     phiHyd(i,j,K)=
193     & ddPIp*maskC(i,j,K,bi,bj)
194     & *(theta(I,J,K,bi,bj)-tRef(K))
195     ENDDO
196     ENDDO
197     ELSE
198     C-------- This discretization is the energy conserving form
199     ddPI=atm_cp*( ((rC(K-1)/atm_po)**atm_kappa)
200     & -((rC( K )/atm_po)**atm_kappa) )*0.5
201     DO j=jMin,jMax
202     DO i=iMin,iMax
203     phiHyd(i,j,K)=phiHyd(i,j,K-1)
204     & +ddPI*maskC(i,j,K-1,bi,bj)
205     & *(theta(I,J,K-1,bi,bj)-tRef(K-1))
206     & +ddPI*maskC(i,j, K ,bi,bj)
207     & *(theta(I,J, K ,bi,bj)-tRef( K ))
208     C Old code (atmos-exact) looked like this
209     Cold phiHyd(i,j,K)=phiHyd(i,j,K-1) - ddPI*
210     Cold & (theta(I,J,K-1,bi,bj)+theta(I,J,K,bi,bj)-2.*tRef(K))
211     ENDDO
212     ENDDO
213     ENDIF
214     C end: Energy Conserving Form, No hFac --
215 adcroft 1.9 C-----------------------------------------------------------------------
216 jmc 1.14
217     ELSEIF (Integr_GeoPot.EQ.1) THEN
218     C -- Finite Volume Form, with hFac, linear in P by Half level --
219     C---------
220     C Finite Volume formulation consistent with Partial Cell, linear in p by piece
221     C Note: a true Finite Volume form should be linear between 2 Interf_W :
222     C phi_C = (phi_W_k+ phi_W_k+1)/2 ; but not accurate in Stratosphere (low p)
223     C also: if Interface_W at the middle between tracer levels, this form
224     C is close to the Energy Cons. form in the Interior, except for the
225     C non-linearity in PI(p)
226     C---------
227     IF (K.EQ.1) THEN
228     ddPIp=atm_cp*( ((rF(K)/atm_po)**atm_kappa)
229     & -((rC(K)/atm_po)**atm_kappa) )
230     DO j=jMin,jMax
231     DO i=iMin,iMax
232     phiHyd(i,j,K) =
233     & ddPIp*hFacC(I,J, K ,bi,bj)
234     & *(theta(I,J, K ,bi,bj)-tRef( K ))
235 adcroft 1.9 ENDDO
236     ENDDO
237     ELSE
238 jmc 1.14 ddPIm=atm_cp*( ((rC(K-1)/atm_po)**atm_kappa)
239     & -((rF( K )/atm_po)**atm_kappa) )
240     ddPIp=atm_cp*( ((rF( K )/atm_po)**atm_kappa)
241     & -((rC( K )/atm_po)**atm_kappa) )
242     DO j=jMin,jMax
243     DO i=iMin,iMax
244     phiHyd(i,j,K) = phiHyd(i,j,K-1)
245     & +ddPIm*hFacC(I,J,K-1,bi,bj)
246     & *(theta(I,J,K-1,bi,bj)-tRef(K-1))
247     & +ddPIp*hFacC(I,J, K ,bi,bj)
248     & *(theta(I,J, K ,bi,bj)-tRef( K ))
249     ENDDO
250     ENDDO
251     ENDIF
252     C end: Finite Volume Form, with hFac, linear in P by Half level --
253 adcroft 1.9 C-----------------------------------------------------------------------
254    
255 jmc 1.14 ELSEIF (Integr_GeoPot.EQ.2) THEN
256     C -- Finite Difference Form, with hFac, Tracer Lev. = middle --
257     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
258     C Finite Difference formulation consistent with Partial Cell,
259     C case Tracer level at the middle of InterFace_W
260     C linear between 2 Tracer levels ; conserve energy in the Interior
261     C---------
262     Kp1 = min(Nr,K+1)
263     IF (K.EQ.1) THEN
264     ddPIm=atm_cp*( ((rF( K )/atm_po)**atm_kappa)
265     & -((rC( K )/atm_po)**atm_kappa) ) * 2. _d 0
266     ddPIp=atm_cp*( ((rC( K )/atm_po)**atm_kappa)
267     & -((rC(Kp1)/atm_po)**atm_kappa) )
268     DO j=jMin,jMax
269     DO i=iMin,iMax
270     phiHyd(i,j,K) =
271     & ( ddPIm*max(zero, hFacC(i,j,K,bi,bj)-half)
272     & +ddPIp*min(zero, hFacC(i,j,K,bi,bj)-half) )
273     & *(theta(i,j, K ,bi,bj)-tRef( K ))
274     & * maskC(i,j, K ,bi,bj)
275     ENDDO
276     ENDDO
277     ELSE
278     ddPIm=atm_cp*( ((rC(K-1)/atm_po)**atm_kappa)
279     & -((rC( K )/atm_po)**atm_kappa) )
280     ddPIp=atm_cp*( ((rC( K )/atm_po)**atm_kappa)
281     & -((rC(Kp1)/atm_po)**atm_kappa) )
282     DO j=jMin,jMax
283     DO i=iMin,iMax
284     phiHyd(i,j,K) = phiHyd(i,j,K-1)
285     & + ddPIm*0.5
286     & *(theta(i,j,K-1,bi,bj)-tRef(K-1))
287     & * maskC(i,j,K-1,bi,bj)
288     & +(ddPIm*max(zero, hFacC(i,j,K,bi,bj)-half)
289     & +ddPIp*min(zero, hFacC(i,j,K,bi,bj)-half) )
290     & *(theta(i,j, K ,bi,bj)-tRef( K ))
291     & * maskC(i,j, K ,bi,bj)
292     ENDDO
293     ENDDO
294     ENDIF
295     C end: Finite Difference Form, with hFac, Tracer Lev. = middle --
296 adcroft 1.9 C-----------------------------------------------------------------------
297    
298 jmc 1.14 ELSEIF (Integr_GeoPot.EQ.3) THEN
299     C -- Finite Difference Form, with hFac, Interface_W = middle --
300     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
301     C Finite Difference formulation consistent with Partial Cell,
302     C Valid & accurate if Interface_W at middle between tracer levels
303     C linear in p between 2 Tracer levels ; conserve energy in the Interior
304     C---------
305     Kp1 = min(Nr,K+1)
306     IF (K.EQ.1) THEN
307     ratioRm=0.5*drF(K)/(rF(k)-rC(K))
308     ratioRp=drF(K)*recip_drC(Kp1)
309     ddPIm=atm_cp*( ((rF( K )/atm_po)**atm_kappa)
310     & -((rC( K )/atm_po)**atm_kappa) ) * 2. _d 0
311     ddPIp=atm_cp*( ((rC( K )/atm_po)**atm_kappa)
312     & -((rC(Kp1)/atm_po)**atm_kappa) )
313     DO j=jMin,jMax
314     DO i=iMin,iMax
315     phiHyd(i,j,K) =
316     & ( ddPIm*max(zero,(hFacC(i,j,K,bi,bj)-one)*ratioRm+half)
317     & +ddPIp*min(zero, hFacC(i,j,K,bi,bj)*ratioRp -half) )
318     & *(theta(i,j, K ,bi,bj)-tRef( K ))
319     & * maskC(i,j, K ,bi,bj)
320     ENDDO
321     ENDDO
322     ELSE
323     ratioRm=drF(K)*recip_drC(K)
324     ratioRp=drF(K)*recip_drC(Kp1)
325     ddPIm=atm_cp*( ((rC(K-1)/atm_po)**atm_kappa)
326     & -((rC( K )/atm_po)**atm_kappa) )
327     ddPIp=atm_cp*( ((rC( K )/atm_po)**atm_kappa)
328     & -((rC(Kp1)/atm_po)**atm_kappa) )
329 adcroft 1.9 DO j=jMin,jMax
330 jmc 1.14 DO i=iMin,iMax
331     phiHyd(i,j,K) = phiHyd(i,j,K-1)
332     & + ddPIm*0.5
333     & *(theta(i,j,K-1,bi,bj)-tRef(K-1))
334     & * maskC(i,j,K-1,bi,bj)
335     & +(ddPIm*max(zero,(hFacC(i,j,K,bi,bj)-one)*ratioRm+half)
336     & +ddPIp*min(zero, hFacC(i,j,K,bi,bj)*ratioRp -half) )
337     & *(theta(i,j, K ,bi,bj)-tRef( K ))
338     & * maskC(i,j, K ,bi,bj)
339     ENDDO
340 adcroft 1.9 ENDDO
341     ENDIF
342 jmc 1.14 C end: Finite Difference Form, with hFac, Interface_W = middle --
343     C-----------------------------------------------------------------------
344 cnh 1.1
345 jmc 1.14 ELSE
346     STOP 'CALC_PHI_HYD: Bad Integr_GeoPot option !'
347     ENDIF
348 cnh 1.6
349 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
350 adcroft 1.9 ELSE
351     STOP 'CALC_PHI_HYD: We should never reach this point!'
352 cnh 1.5 ENDIF
353 cnh 1.1
354 jmc 1.14 #endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
355 cnh 1.6
356 jmc 1.11 RETURN
357     END

  ViewVC Help
Powered by ViewVC 1.1.22