/[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.14 - (hide annotations) (download)
Fri Jul 6 21:47:00 2001 UTC (22 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre6, checkpoint40pre2, checkpoint40pre4, checkpoint40pre5
Changes since 1.13: +184 -55 lines
add several forms of the geopotential integration with partial cell.

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

  ViewVC Help
Powered by ViewVC 1.1.22