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

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

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


Revision 1.10 - (show annotations) (download)
Thu Apr 7 16:21:20 2016 UTC (8 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65v, checkpoint65w, HEAD
Changes since 1.9: +3 -3 lines
compute also iteratively pRef4EOS when selectP_inEOS_Zc > 1 (might need
 it for other conversion).

1 C $Header: /u/gcmpack/MITgcm/model/src/set_ref_state.F,v 1.9 2016/04/04 21:29:00 jmc Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SET_REF_STATE
8 C !INTERFACE:
9 SUBROUTINE SET_REF_STATE(
10 I myThid )
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | SUBROUTINE SET_REF_STATE
14 C | o Set reference potential at level center and
15 C | level interface, using tRef,sRef profiles.
16 C | note: use same discretisation as in calc_phi_hyd
17 C | o Set also reference stratification here (for implicit
18 C | Internal Gravity Waves) and units conversion factor
19 C | for vertical velocity (for Non-Hydrostatic in p)
20 C | since both use also the same reference density.
21 C *==========================================================*
22 C \ev
23
24 C !USES:
25 IMPLICIT NONE
26 C == Global variables ==
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29 #include "PARAMS.h"
30 #include "GRID.h"
31 #include "EOS.h"
32
33 C !INPUT/OUTPUT PARAMETERS:
34 C == Routine arguments ==
35 INTEGER myThid
36
37 C !LOCAL VARIABLES:
38 C == Local variables ==
39 C msgBuf :: Informational/error message buffer
40 CHARACTER*(MAX_LEN_MBUF) msgBuf
41 INTEGER k, ks, stdUnit
42 _RL rHalf(2*Nr+1), pRefLocF(Nr+1)
43 _RL rhoRef(Nr), tLoc(Nr)
44 _RL pLoc, rhoUp, rhoDw, rhoLoc
45 _RL ddPI, conv_theta2T, thetaLoc
46 C--
47 _RL maxResid
48 INTEGER maxIterNb, belowCritNb
49 CEOP
50
51 _BEGIN_MASTER( myThid )
52
53 C-- Initialise:
54 DO k=1,2*Nr
55 phiRef(k) = 0.
56 ENDDO
57 stdUnit = standardMessageUnit
58
59 DO k=1,Nr
60 rhoRef(k) = 0.
61 dBdrRef(k) = 0.
62 pRef4EOS(k) = 0.
63 rHalf(2*k-1) = rF(k)
64 rHalf(2*k) = rC(k)
65 ENDDO
66 rHalf(2*Nr+1) = rF(Nr+1)
67
68 DO k=1,Nr+1
69 rVel2wUnit(k) = 1. _d 0
70 wUnit2rVel(k) = 1. _d 0
71 ENDDO
72
73 C- Initialise density factor for anelastic formulation:
74 DO k=1,Nr
75 rhoFacC(k) = 1. _d 0
76 recip_rhoFacC(k) = 1. _d 0
77 ENDDO
78 DO k=1,Nr+1
79 rhoFacF(k) = 1. _d 0
80 recip_rhoFacF(k) = 1. _d 0
81 ENDDO
82
83 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
84 C-- Oceanic: define reference pressure/geo-potential vertical scale:
85 IF ( buoyancyRelation.EQ.'OCEANIC' ) THEN
86 phiRef(1) = top_Pres*recip_rhoConst
87 pRefLocF(1) = top_Pres
88 IF ( gravityFile.EQ.' ' ) THEN
89 DO k=1,Nr
90 phiRef(2*k) = phiRef(1)
91 & + (rC(k) - rF(1))*gravity*gravitySign
92 phiRef(2*k+1) = phiRef(1)
93 & + (rF(k+1)-rF(1))*gravity*gravitySign
94 c pRef4EOS(k) = rhoConst*phiRef(2*k)
95 c pRefLocF(k+1) = rhoConst*phiRef(2*k+1)
96 C note: just to get the same previous machine truncation:
97 pRef4EOS(k) = pRefLocF(1)
98 & + rhoConst*(rC(k) - rF(1))*gravity*gravitySign
99 pRefLocF(k+1) = pRefLocF(1)
100 & + rhoConst*(rF(k+1)-rF(1))*gravity*gravitySign
101 ENDDO
102 ELSEIF ( integr_GeoPot.EQ.1 ) THEN
103 DO k=1,Nr
104 phiRef(2*k) = phiRef(2*k-1)
105 & + halfRL*drF(k)*gravity*gravFacC(k)
106 phiRef(2*k+1) = phiRef(2*k-1) + drF(k)*gravity*gravFacC(k)
107 pRef4EOS(k) = rhoConst*phiRef(2*k)
108 pRefLocF(k+1) = rhoConst*phiRef(2*k+1)
109 ENDDO
110 ELSE
111 phiRef(2) = phiRef(1) + drC(1)*gravity*gravFacF(1)
112 DO k=2,Nr
113 phiRef(2*k-1) = phiRef(2*k-2)
114 & + halfRL*drC(k)*gravity*gravFacF(k)
115 phiRef(2*k) = phiRef(2*k-2) + drC(k)*gravity*gravFacF(k)
116 ENDDO
117 k = Nr
118 phiRef(2*k+1) = phiRef(2*k) + drC(k+1)*gravity*gravFacF(k+1)
119 DO k=1,Nr
120 pRef4EOS(k) = rhoConst*phiRef(2*k)
121 pRefLocF(k+1) = rhoConst*phiRef(2*k+1)
122 ENDDO
123 ENDIF
124 ELSEIF ( buoyancyRelation.EQ.'OCEANICP' ) THEN
125 phiRef(2*Nr+1) = seaLev_Z*gravity
126 DO k=1,Nr
127 phiRef(2*k) = phiRef(2*Nr+1)
128 & - recip_rhoConst*( rC(k) - rF(Nr+1) )
129 phiRef(2*k-1) = phiRef(2*Nr+1)
130 & - recip_rhoConst*( rF(k) - rF(Nr+1) )
131 ENDDO
132 c ELSEIF (buoyancyRelation .EQ. 'ATMOSPHERIC') THEN
133 C phiRef is computed later (see below)
134 ENDIF
135
136 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137 IF ( eosType.EQ.'POLY3' ) THEN
138 IF ( implicitIntGravWave ) THEN
139 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
140 & ' need to compute reference density for Impl.IGW'
141 CALL PRINT_ERROR( msgBuf , myThid )
142 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
143 & ' but FIND_RHO_SCALAR(EOS="POLY3") not (yet) implemented'
144 CALL PRINT_ERROR( msgBuf , myThid )
145 STOP 'ABNORMAL END: S/R SET_REF_STATE'
146 ELSEIF ( nonHydrostatic .AND.
147 & buoyancyRelation.EQ.'OCEANICP' ) THEN
148 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
149 & ' need to compute reference density for Non-Hyd'
150 CALL PRINT_ERROR( msgBuf , myThid )
151 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
152 & ' but FIND_RHO_SCALAR(EOS="POLY3") not (yet) implemented'
153 CALL PRINT_ERROR( msgBuf , myThid )
154 STOP 'ABNORMAL END: S/R SET_REF_STATE'
155 ELSE
156 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
157 & ' Unable to compute reference stratification'
158 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
159 & SQUEEZE_RIGHT , myThid )
160 WRITE(msgBuf,'(2A)') 'SET_REF_STATE:',
161 & ' with EOS="POLY3" ; set dBdrRef(1:Nr) to zeros'
162 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
163 & SQUEEZE_RIGHT , myThid)
164 ENDIF
165 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
166 ELSEIF ( buoyancyRelation.EQ.'OCEANIC' ) THEN
167
168 C-- Compute reference density profile
169 DO k=1,Nr
170 pLoc = pRef4EOS(k)
171 CALL FIND_RHO_SCALAR(
172 I tRef(k), sRef(k), pLoc,
173 O rhoRef(k), myThid )
174 ENDDO
175
176 IF ( selectP_inEOS_Zc.GE.1 ) THEN
177 C-- Find reference pressure in hydrostatic balance with updated ref density
178 maxResid = rhoConst* 1. _d -14
179 belowCritNb = 5
180 maxIterNb = 10*Nr
181 CALL FIND_HYD_PRESS_1D(
182 O pRef4EOS, pRefLocF,
183 U rhoRef,
184 I tRef, sRef, maxResid,
185 I belowCritNb, maxIterNb, myThid )
186 ENDIF
187
188 C-- Compute reference stratification: N^2 = -(g/rho_c) * d.rho/dz @ const. p
189 dBdrRef(1) = 0. _d 0
190 DO k=2,Nr
191 pLoc = pRefLocF(k)
192 CALL FIND_RHO_SCALAR(
193 I tRef(k-1), sRef(k-1), pLoc,
194 O rhoUp, myThid )
195 CALL FIND_RHO_SCALAR(
196 I tRef(k), sRef(k), pLoc,
197 O rhoDw, myThid )
198 dBdrRef(k) = (rhoDw - rhoUp)*recip_drC(k)
199 & *recip_rhoConst*gravity*gravFacF(k)
200 IF ( eosType.EQ.'LINEAR' ) THEN
201 C- get more precise values (differences from above are due to machine round-off)
202 dBdrRef(k) = ( sBeta *(sRef(k)-sRef(k-1))
203 & -tAlpha*(tRef(k)-tRef(k-1))
204 & )*recip_drC(k)
205 & *rhoNil*recip_rhoConst*gravity*gravFacF(k)
206 ENDIF
207 ENDDO
208
209 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
210 ELSEIF ( buoyancyRelation.EQ.'OCEANICP' ) THEN
211
212 C-- Compute reference density profile
213 DO k=1,Nr
214 pLoc = rC(k)
215 CALL FIND_RHO_SCALAR(
216 I tRef(k), sRef(k), pLoc,
217 O rhoRef(k), myThid )
218 ENDDO
219
220 C-- Compute reference stratification: -d.alpha/dp @ constant p
221 dBdrRef(1) = 0. _d 0
222 DO k=1,Nr+1
223 pLoc = rF(k)
224 IF ( k.GE.2 ) CALL FIND_RHO_SCALAR(
225 I tRef(k-1), sRef(k-1), pLoc,
226 O rhoDw, myThid )
227 IF ( k.LE.Nr ) CALL FIND_RHO_SCALAR(
228 I tRef(k), sRef(k), pLoc,
229 O rhoUp, myThid )
230 IF ( k.GE.2 .AND. k.LE.Nr ) THEN
231 dBdrRef(k) = (rhoDw - rhoUp)*recip_drC(k)
232 & / (rhoDw*rhoUp)
233 rhoLoc = ( rhoDw + rhoUp )*0.5 _d 0
234 ELSEIF ( k.EQ.1 ) THEN
235 rhoLoc = rhoUp
236 ELSE
237 rhoLoc = rhoDw
238 ENDIF
239 C-- Units convertion factor for vertical velocity:
240 C wUnit2rVel = gravity*rhoRef : rVel [Pa/s] = wSpeed [m/s] * wUnit2rVel
241 C rVel2wUnit = 1/rVel2wUnit : wSpeed [m/s] = rVel [Pa/s] * rVel2wUnit
242 C note: wUnit2rVel & rVel2wUnit replace horiVertRatio & recip_horiVertRatio
243 wUnit2rVel(k) = gravity*rhoLoc
244 rVel2wUnit(k) = 1. _d 0 / wUnit2rVel(k)
245 ENDDO
246
247 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
248 ELSEIF ( buoyancyRelation.EQ.'ATMOSPHERIC' ) THEN
249
250 C-- Compute reference stratification: -d.alpha/dp @ constant p
251 dBdrRef(1) = 0. _d 0
252 DO k=2,Nr
253 conv_theta2T = (rF(k)/atm_Po)**atm_kappa
254 c dBdrRef(k) = (tRef(k) - tRef(k-1))*recip_drC(k)
255 c & * conv_theta2T*atm_Rd/rF(k)
256 ddPI=atm_Cp*( ((rC(k-1)/atm_Po)**atm_kappa)
257 & -((rC( k )/atm_Po)**atm_kappa) )
258 dBdrRef(k) = (tRef(k) - tRef(k-1))*recip_drC(k)
259 & * ddPI*recip_drC(k)
260 ENDDO
261
262 C-- Units convertion factor for vertical velocity:
263 C wUnit2rVel = gravity/alpha : rVel [Pa/s] = wSpeed [m/s] * wUnit2rVel
264 C rVel2wUnit = alpha/gravity : wSpeed [m/s] = rVel [Pa/s] * rVel2wUnit
265 C with alpha = 1/rhoRef = (R.T/p) (ideal gas)
266 C note: wUnit2rVel & rVel2wUnit replace horiVertRatio & recip_horiVertRatio
267 DO k=1,Nr+1
268 IF ( k.EQ.1 ) THEN
269 thetaLoc = tRef(k)
270 ELSEIF ( k.GT.Nr ) THEN
271 thetaLoc = tRef(k-1)
272 ELSE
273 thetaLoc = (tRef(k) + tRef(k-1))*0.5 _d 0
274 ENDIF
275 IF ( thetaLoc.GT.0. _d 0 .AND. rF(k).GT.0. _d 0 ) THEN
276 conv_theta2T = (rF(k)/atm_Po)**atm_kappa
277 wUnit2rVel(k) = gravity
278 & * rF(k)/(atm_Rd*conv_theta2T*thetaLoc)
279 rVel2wUnit(k) = 1. _d 0 / wUnit2rVel(k)
280 ENDIF
281 ENDDO
282
283 C- Compute Reference Geopotential at Half levels :
284 C Tracer level k: phiRef(2k) ; Interface_W level k: phiRef(2k-1)
285
286 phiRef(1) = seaLev_Z*gravity
287 IF ( select_rStar.GE.1 .OR. selectSigmaCoord.GE.1 ) THEN
288 C- isothermal (theta=const) reference state
289 DO k=1,Nr
290 tLoc(k) = thetaConst
291 ENDDO
292 ELSE
293 C- horizontally uniform (tRef) reference state
294 DO k=1,Nr
295 tLoc(k) = tRef(k)
296 ENDDO
297 ENDIF
298
299 IF (integr_GeoPot.EQ.1) THEN
300 C- Finite Volume Form, linear by half level :
301 DO k=1,2*Nr
302 ks = (k+1)/2
303 ddPI=atm_Cp*( ((rHalf( k )/atm_Po)**atm_kappa)
304 & -((rHalf(k+1)/atm_Po)**atm_kappa) )
305 phiRef(k+1) = phiRef(k)+ddPI*tLoc(ks)
306 ENDDO
307 C------
308 ELSE
309 C- Finite Difference Form, linear between Tracer level :
310 C works with integr_GeoPot = 0, 2 or 3
311 k = 1
312 ddPI=atm_Cp*( ((rF(k)/atm_Po)**atm_kappa)
313 & -((rC(k)/atm_Po)**atm_kappa) )
314 phiRef(2*k) = phiRef(1) + ddPI*tLoc(k)
315 DO k=1,Nr-1
316 ddPI=atm_Cp*( ((rC( k )/atm_Po)**atm_kappa)
317 & -((rC(k+1)/atm_Po)**atm_kappa) )
318 phiRef(2*k+1) = phiRef(2*k) + ddPI*0.5*tLoc(k)
319 phiRef(2*k+2) = phiRef(2*k)
320 & + ddPI*0.5*(tLoc(k)+tLoc(k+1))
321 ENDDO
322 k = Nr
323 ddPI=atm_Cp*( ((rC( k )/atm_Po)**atm_kappa)
324 & -((rF(k+1)/atm_Po)**atm_kappa) )
325 phiRef(2*k+1) = phiRef(2*k) + ddPI*tLoc(k)
326 C------
327 ENDIF
328
329 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
330 ELSE
331 STOP 'SET_REF_STATE: Bad value of buoyancyRelation !'
332 C-- endif buoyancyRelation
333 ENDIF
334
335 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
336
337 IF ( usingZCoords .AND. rhoRefFile .NE. ' ' ) THEN
338 C-- anelastic formulation : set density factor from reference density profile
339 C surface-interface rho-factor has to be 1:
340 rhoFacF(1) = 1. _d 0
341 C rhoFac(k) = density ratio between layer k and top interface
342 DO k=1,Nr
343 rhoFacC(k) = rho1Ref(k)/rhoConst
344 c rhoFacC(k) = rho1Ref(k)*recip_rhoConst
345 ENDDO
346 DO k=2,Nr
347 C since rkSign=-1, recip_drC(k) = 1./(rC(k-1)-rC(k))
348 rhoFacF(k) = ( rhoFacC(k-1)*(rF(k)-rC(k))
349 & + rhoFacC(k)*(rC(k-1)-rF(k)) )*recip_drC(k)
350 ENDDO
351 C extrapolate down to the bottom:
352 rhoFacF(Nr+1) = ( rhoFacC(Nr)*(rF(Nr+1)-rF(Nr))
353 & + rhoFacF(Nr)*(rC(Nr)-rF(Nr+1))
354 & ) / (rC(Nr)-rF(Nr))
355 C- set reciprocal rho-factor:
356 DO k=1,Nr
357 recip_rhoFacC(k) = 1. _d 0/rhoFacC(k)
358 ENDDO
359 DO k=1,Nr+1
360 recip_rhoFacF(k) = 1. _d 0/rhoFacF(k)
361 ENDDO
362 ENDIF
363
364 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
365
366 C-- Write to check :
367 IF ( gravityFile .NE. ' ' ) THEN
368 C- write gravity vertical profile factor to binary file:
369 CALL WRITE_GLVEC_RL( 'GravFacC',' ',gravFacC, Nr, -1, myThid )
370 CALL WRITE_GLVEC_RL( 'GravFacF',' ',gravFacF,Nr+1,-1, myThid )
371 ENDIF
372 IF ( selectP_inEOS_Zc.GE.1 ) THEN
373 C- write (to binary file) Hyd-Pressure used in EOS:
374 CALL WRITE_GLVEC_RL( 'PRef4EOS',' ',pRef4EOS, Nr, -1, myThid )
375 c CALL WRITE_GLVEC_RL( 'PRefLocF',' ',pRefLocF,Nr+1,-1, myThid )
376 ENDIF
377 IF ( buoyancyRelation.EQ.'ATMOSPHERIC' ) THEN
378 WRITE(msgBuf,'(A)') ' '
379 CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
380 WRITE(msgBuf,'(A)')
381 & 'SET_REF_STATE: PhiRef/g [m] at level Center (integer)'
382 CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
383 WRITE(msgBuf,'(A)')
384 & ' and at level Interface (half-int.) :'
385 CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
386 DO k=1,2*Nr+1
387 WRITE(msgBuf,'(A,F5.1,A,F15.1,A,F13.3)')
388 & ' K=',k*0.5,' ; r=',rHalf(k),' ; phiRef/g=',
389 & phiRef(k)*recip_gravity
390 CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid )
391 ENDDO
392 ELSE
393 C- Write reference density to binary file :
394 CALL WRITE_GLVEC_RL( 'RhoRef', ' ', rhoRef, Nr, -1, myThid )
395 ENDIF
396 IF ( usingZCoords .AND. rhoRefFile .NE. ' ' ) THEN
397 C- Write Anelastic density factor to binary file :
398 CALL WRITE_GLVEC_RL( 'RhoFacC',' ',rhoFacC, Nr , -1, myThid )
399 CALL WRITE_GLVEC_RL( 'RhoFacF',' ',rhoFacF, Nr+1, -1, myThid )
400 ENDIF
401
402 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
403
404 _END_MASTER( myThid )
405 _BARRIER
406
407 RETURN
408 END

  ViewVC Help
Powered by ViewVC 1.1.22