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

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

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


Revision 1.19 - (show annotations) (download)
Thu Aug 15 17:25:31 2002 UTC (21 years, 9 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint46g_pre, checkpoint46f_post, checkpoint46d_pre, checkpoint46e_pre, checkpoint46c_post, checkpoint46e_post, checkpoint46d_post
Changes since 1.18: +63 -2 lines
Changes necessary for ocean in p-coordinates
 -  Added new buoyancy relation = 'OCEANICP'
 -  Added new parameters = gravitySign (this used to be contained inside
    the factor dRdZ which I added when we first switched to R coordinates).
 X GM/Redi is not compatible (yet)
 X bottom drag and no-slip need to be debugged.

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

  ViewVC Help
Powered by ViewVC 1.1.22