UPP (develop)
Loading...
Searching...
No Matches
MDL2SIGMA2.f
Go to the documentation of this file.
1
2!
45 SUBROUTINE mdl2sigma2
46
47!
48!
49 use vrbls3d, only: pint, pmid, t, zint, q
50! use vrbls2d, only:
51 use masks, only: lmh
52 use params_mod, only: pq0, a2, a3, a4, rgamog
53 use ctlblk_mod, only: pt, jsta_2l, jend_2u, spval, lp1, lm, jsta, jend,&
54 grib, cfld, datapd, fld_info, im, jm, im_jm, &
55 ista, iend, ista_2l, iend_2u
56 use rqstfld_mod, only: iget, lvls, id, iavblfld, lvlsxml
57!
58 implicit none
59!
60 integer,PARAMETER :: LSIG=5
61!
62! DECLARE VARIABLES.
63!
64 LOGICAL READTHK
65! REAL,dimension(im,jm) :: FSL, TSL, QSL, osl, usl, vsl, q2sl, fsl1, &
66 REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: TSL
67 REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: grid1
68 REAL SIGO(LSIG+1),DSIGO(LSIG),ASIGO(LSIG)
69!
70! INTEGER,dimension(im,jm) :: IHOLD,JHOLD,NL1X,NL1XF
71 INTEGER,dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: NL1X
72!
73!
74!--- Definition of the following 2D (horizontal) dummy variables
75!
76! C1D - total condensate
77! QW1 - cloud water mixing ratio
78! QI1 - cloud ice mixing ratio
79! QR1 - rain mixing ratio
80! QS1 - snow mixing ratio
81!
82! REAL,dimension(im,jm) :: C1D,QW1,QI1,QR1,qs1,qg1,akh
83!
84 integer I,J,L,LL,LP,LLMH,NHOLD,II,JJ
85 real PTSIGO,PSIGO,APSIGO,FACT,AI,BI,TMT0,QSAT,TVRL, &
86 tvrblo,tblo,ql,rhl,zl,pl,tl
87!
88!
89!******************************************************************************
90!
91! START MDL2P.
92!
93! SET TOTAL NUMBER OF POINTS ON OUTPUT GRID.
94!
95!---------------------------------------------------------------
96!
97! *** PART I ***
98!
99! VERTICAL INTERPOLATION OF EVERYTHING ELSE. EXECUTE ONLY
100! IF THERE'S SOMETHING WE WANT.
101!
102 IF((iget(296)>0) ) THEN !!Air Quality (Plee Oct2003)
103!
104!---------------------------------------------------------------------
105!
106!--- VERTICAL INTERPOLATION OF GEOPOTENTIAL, SPECIFIC HUMIDITY, TEMPERATURE,
107! OMEGA, TKE, & CLOUD FIELDS. START AT THE UPPERMOST TARGET SIGMA LEVEL.
108!
109 ptsigo=pt
110 readthk=.false.
111 IF(readthk)THEN ! EITHER READ DSG THICKNESS
112 READ(41)dsigo !DSIGO FROM TOP TO BOTTOM
113!
114 sigo(1)=0.0
115 DO l=2,lsig+1
116 sigo(l)=sigo(l-1)+dsigo(lsig-l+2)
117 END DO
118 sigo(lsig+1)=1.0
119 DO l=1,lsig
120 asigo(l)=0.5*(sigo(l)+sigo(l+1))
121 END DO
122 ELSE ! SPECIFY SIGO
123 asigo( 1)= 0.7000
124 asigo( 2)= 0.7500
125 asigo( 3)= 0.8000
126 asigo( 4)= 0.8500
127 asigo( 5)= 0.9000
128 END IF
129!***
130!*** BECAUSE SIGMA LAYERS DO NOT GO UNDERGROUND, DO ALL
131!*** INTERPOLATION ABOVE GROUND NOW.
132!***
133!
134
135 DO 310 lp=1,lsig
136 nhold=0
137!
138 DO j=jsta_2l,jend_2u
139 DO i=ista_2l,iend_2u
140
141!
142 tsl(i,j)=spval
143!
144!*** LOCATE VERTICAL INDEX OF MODEL MIDLAYER JUST BELOW
145!*** THE PRESSURE LEVEL TO WHICH WE ARE INTERPOLATING.
146!
147 nl1x(i,j)=lp1
148 DO l=2,lm
149 llmh = nint(lmh(i,j))
150 psigo=ptsigo+asigo(lp)*(pint(i,j,llmh+1)-ptsigo)
151 IF(nl1x(i,j)==lp1.AND.pmid(i,j,l)>psigo)THEN
152 nl1x(i,j)=l
153 ENDIF
154 ENDDO
155!
156! IF THE PRESSURE LEVEL IS BELOW THE LOWEST MODEL MIDLAYER
157! BUT STILL ABOVE THE LOWEST MODEL BOTTOM INTERFACE,
158! WE WILL NOT CONSIDER IT UNDERGROUND AND THE INTERPOLATION
159! WILL EXTRAPOLATE TO THAT POINT
160!
161 IF(nl1x(i,j)==lp1.AND.pint(i,j,llmh+1)>=psigo)THEN
162 nl1x(i,j)=lm
163 ENDIF
164!
165! if(NL1X(I,J)==LP1)print*,'Debug: NL1X=LP1 AT '
166! 1 ,i,j,lp
167 ENDDO
168 ENDDO
169!
170!mptest IF(NHOLD==0)GO TO 310
171!
172!!$omp parallel do
173!!$omp& private(nn,i,j,ll,fact,qsat,rhl)
174!hc DO 220 NN=1,NHOLD
175!hc I=IHOLD(NN)
176!hc J=JHOLD(NN)
177! DO 220 J=JSTA,JEND
178! DO 220 J=JSTA_2L,JEND_2U
179 DO 220 j=jsta,jend ! Moorthi on Nov 26, 2014
180 DO 220 i=ista,iend
181 ll=nl1x(i,j)
182!---------------------------------------------------------------------
183!*** VERTICAL INTERPOLATION OF GEOPOTENTIAL, TEMPERATURE, SPECIFIC
184!*** HUMIDITY, CLOUD WATER/ICE, OMEGA, WINDS, AND TKE.
185!---------------------------------------------------------------------
186!
187!HC IF(NL1X(I,J)<=LM)THEN
188 llmh = nint(lmh(i,j))
189 psigo=ptsigo+asigo(lp)*(pint(i,j,llmh+1)-ptsigo)
190 apsigo=log(psigo)
191 IF(nl1x(i,j)<=llmh.and. &
192 (pmid(i,j,ll)-pmid(i,j,ll-1))/=0.)THEN
193!
194!---------------------------------------------------------------------
195! INTERPOLATE LINEARLY IN LOG(P)
196!*** EXTRAPOLATE ABOVE THE TOPMOST MIDLAYER OF THE MODEL
197!*** INTERPOLATION BETWEEN NORMAL LOWER AND UPPER BOUNDS
198!*** EXTRAPOLATE BELOW LOWEST MODEL MIDLAYER (BUT STILL ABOVE GROUND)
199!---------------------------------------------------------------------
200!
201
202 fact=(apsigo-log(pmid(i,j,ll)))/ &
203 & (log(pmid(i,j,ll))-log(pmid(i,j,ll-1)))
204 tsl(i,j)=t(i,j,ll)+(t(i,j,ll)-t(i,j,ll-1))*fact
205! FOR UNDERGROUND PRESSURE LEVELS, ASSUME TEMPERATURE TO CHANGE
206! ADIABATICLY, RH TO BE THE SAME AS THE AVERAGE OF THE 2ND AND 3RD
207! LAYERS FROM THE GOUND, WIND TO BE THE SAME AS THE LOWEST LEVEL ABOVE
208! GOUND
209 ELSE
210 ii=91
211 jj=13
212! if(i==ii.and.j==jj) &
213! print*,'Debug: underg extra at i,j,lp',i,j,lp
214 pl = pint(i,j,lm-1)
215 zl = zint(i,j,lm-1)
216 tl = 0.5*(t(i,j,lm-2)+t(i,j,lm-1))
217 ql = 0.5*(q(i,j,lm-2)+q(i,j,lm-1))
218 tmt0 = tl - a3
219 ai = 0.008855
220 bi = 1.
221 IF(tmt0<-20.)THEN
222 ai = 0.007225
223 bi = 0.9674
224 ENDIF
225 qsat = pq0/pl*exp(a2*(tl-a3)/(tl-a4))
226!
227 rhl = ql/qsat
228!
229 IF(rhl>1.)THEN
230 rhl = 1.
231 ql = rhl*qsat
232 ENDIF
233!
234 IF(rhl<0.01)THEN
235 rhl = 0.01
236 ql = rhl*qsat
237 ENDIF
238!
239! print *,' tl=',tl,' ql=',ql,' i=',i,' j=',j,' pl=',pl
240 tvrl = tl*(1.+0.608*ql)
241 tvrblo = tvrl*(psigo/pl)**rgamog
242 tblo = tvrblo/(1.+0.608*ql)
243!
244 tmt0 = tblo-a3
245 ai = 0.008855
246 bi = 1.
247 IF(tmt0<-20.)THEN
248 ai = 0.007225
249 bi = 0.9674
250 ENDIF
251 qsat = pq0/psigo*exp(a2*(tblo-a3)/(tblo-a4))
252!
253 tsl(i,j) = tblo
254 END IF
255 220 CONTINUE
256
257!---------------------------------------------------------------------
258! *** PART II ***
259!---------------------------------------------------------------------
260!---------------------------------------------------------------------
261!
262! OUTPUT SELECTED FIELDS.
263!
264!*** TEMPERATURE
265!
266 IF(iget(296)>0) THEN
267 IF(lvls(lp,iget(296))>0)THEN
268 DO j=jsta,jend
269 DO i=ista,iend
270 grid1(i,j)=tsl(i,j)
271 ENDDO
272 ENDDO
273 if(grib=='grib2')then
274 cfld=cfld+1
275 fld_info(cfld)%ifld=iavblfld(iget(296))
276 fld_info(cfld)%lvl=lvlsxml(lp,iget(296))
277 datapd(1:iend-ista+1,1:jend-jsta+1,cfld)=grid1(ista:iend,jsta:jend)
278 endif
279 ENDIF
280 ENDIF
281!
282!*** END OF MAIN VERTICAL LOOP
283!
284 310 CONTINUE
285!*** ENDIF FOR IF TEST SEEING IF WE WANT ANY OTHER VARIABLES
286!
287 ENDIF
288!
289! END OF ROUTINE.
290!
291 RETURN
292 END
subroutine mdl2sigma2
SUBPROGRAM: MDL2P VERT INTRP OF MODEL LVLS TO PRESSURE PRGRMMR: BLACK ORG: W/NP22 DATE: 99-09-23
Definition MDL2SIGMA2.f:46