UPP (develop)
Loading...
Searching...
No Matches
FRZLVL.f
Go to the documentation of this file.
1
41!-----------------------------------------------------------------------------
48 SUBROUTINE frzlvl(ZFRZ,RHFRZ,PFRZL)
49
50!
51!
52 use vrbls3d, only: pint, t, zmid, q, pmid
53 use vrbls2d, only: fis, tshltr, pshltr, qshltr
54 use masks, only: lmh
55 use params_mod, only: gi, d00, capa, d0065, tfrz, pq0, a2, a3, a4
56 use ctlblk_mod, only: jsta, jend, spval, lm, modelname, im, ista, iend
57 use physcons_post, only: con_rd, con_rv, con_eps, con_epsm1
58 use upp_physics, only: fpvsnew
59
60 implicit none
61!
62! DECLARE VARIABLES.
63!
64 REAL,dimension(ista:iend,jsta:jend) :: RHFRZ, ZFRZ, PFRZL
65 integer I,J,LLMH,L
66 real HTSFC,PSFC,TSFC,QSFC,QSAT,RHSFC,DELZ,DELT,DELQ,DELALP, &
67 delzp,zl,dzabv,qfrz,alpl,alph,alpfrz,pfrz,qsfrz,rhz,zu, &
68 dzfr,es
69!
70!*********************************************************************
71! START FRZLVL.
72!
73!
74!
75! LOOP OVER HORIZONTAL GRID.
76!
77!!$omp parallel do &
78! & private(i,j,alpfrz,alph,alpl,delalp,delq,delt,delz, &
79! & delzp,dzabv,dzfr,htsfc,l,llmh,psfc,qfrz, &
80! & qsat,qsfc,qsfrz,rhsfc,rhz,tsfc, &
81! & zl,zu)
82
83 DO 20 j=jsta,jend
84 DO 20 i=ista,iend
85 htsfc = fis(i,j)*gi
86 llmh = nint(lmh(i,j))
87 rhfrz(i,j) = d00
88 zfrz(i,j) = htsfc
89 psfc = pint(i,j,llmh+1)
90 pfrzl(i,j) = psfc
91!
92! CHECK IF FREEZING LEVEL IS AT THE GROUND.
93!
94! IF(SM(I,J)/=SPVAL .AND. THZ0(I,J)/=SPVAL .AND. &
95! THS(I,J)/=SPVAL)THEN
96! TSFC = (SM(I,J)*THZ0(I,J)+(1.-SM(I,J))*THS(I,J)) &
97! *(PINT(I,J,NINT(LMH(I,J))+1)/P1000)**CAPA
98! Per AWC's request, use 2m T instead of skin T so that freezing level
99! would be above ground more often
100 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)THEN
101 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
102 ELSE
103! GFS analysis does not have flux file to retrieve TSFC from
104 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
105 END IF
106 IF (tsfc<=tfrz) THEN
107! ZFRZ(I,J) = HTSFC+(TSFC-TFRZ)/D0065
108 zfrz(i,j) = htsfc+2.0+(tsfc-tfrz)/d0065
109! IF(SM(I,J)/=SPVAL .AND. QZ0(I,J)/=SPVAL .AND. &
110! QS(I,J)/=SPVAL)THEN
111! QSFC = SM(I,J)*QZ0(I,J)+(1.-SM(I,J))*QS(I,J)
112! GFS does not output QS
113! ELSE IF(QSHLTR(I,J)/=SPVAL)THEN
114 IF(qshltr(i,j)/=spval)THEN
115 psfc=pshltr(i,j)
116 qsfc=qshltr(i,j)
117 ELSE
118 qsfc=q(i,j,lm)
119 psfc=pmid(i,j,lm)
120 END IF
121!
122 IF(modelname == 'GFS' .OR. modelname == 'RAPR')THEN
123 es=fpvsnew(tsfc)
124 es=min(es,psfc)
125 qsat=con_eps*es/(psfc+con_epsm1*es)
126 ELSE
127 qsat=pq0/psfc*exp(a2*(tsfc-a3)/(tsfc-a4))
128 END IF
129!
130 rhsfc = qsfc/qsat
131 rhsfc = amax1(0.01,rhsfc)
132 rhsfc = amin1(rhsfc,1.0)
133 rhfrz(i,j)= rhsfc
134 pfrzl(i,j)= psfc
135 cycle
136 ENDIF
137!
138! OTHERWISE, LOCATE THE FREEZING LEVEL ALOFT.
139!
140 DO 10 l = llmh,1,-1
141 IF (t(i,j,l)<=tfrz) THEN
142 IF (l<llmh) THEN
143 delz = zmid(i,j,l)-zmid(i,j,l+1)
144 zl = zmid(i,j,l+1)
145 delt = t(i,j,l)-t(i,j,l+1)
146 zfrz(i,j) = zl + (tfrz-t(i,j,l+1))/delt*delz
147!
148 dzabv = zfrz(i,j)-zl
149 delq = q(i,j,l)-q(i,j,l+1)
150 qfrz = q(i,j,l+1) + delq/delz*dzabv
151 qfrz = amax1(0.0,qfrz)
152!
153!
154 alpl = alog(pmid(i,j,l+1))
155 alph = alog(pmid(i,j,l))
156 alpfrz = alpl + (alph-alpl)/delz*dzabv
157 pfrz = exp(alpfrz)
158 pfrzl(i,j) = pfrz
159 IF(modelname == 'GFS' .OR.modelname == 'RAPR')THEN
160 es=fpvsnew(tfrz)
161 es=min(es,pfrz)
162 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
163 ELSE
164 qsfrz=pq0/pfrz &
165 *exp(a2*(tfrz-a3)/(tfrz-a4))
166 END IF
167!
168 rhz = qfrz/qsfrz
169 rhz = amax1(0.01,rhz)
170 rhz = amin1(rhz,1.0)
171 rhfrz(i,j) = rhz
172!
173 ELSE
174 zu = zmid(i,j,l)
175 zl = htsfc+2.0
176 delz = zu-zl
177 IF(tshltr(i,j)/=spval .AND. pshltr(i,j)/=spval)THEN
178 tsfc=tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
179 ELSE
180! GFS analysis does not have flux file to retrieve TSFC from
181 tsfc=t(i,j,lm)+d0065*(zmid(i,j,lm)-htsfc-2.0)
182 END IF
183 delt = t(i,j,l)-tsfc
184 zfrz(i,j) = zl + (tfrz-tsfc)/delt*delz
185!
186 dzabv = zfrz(i,j)-zl
187! GFS does not output QS
188 IF(qshltr(i,j)/=spval)THEN
189 qsfc=qshltr(i,j)
190 ELSE
191 qsfc=q(i,j,lm)
192 END IF
193 delq = q(i,j,l)-qsfc
194 qfrz = qsfc + delq/delz*dzabv
195 qfrz = amax1(0.0,qfrz)
196!
197 alph = alog(pmid(i,j,l))
198 alpl = alog(psfc)
199 delalp = alph-alpl
200 alpfrz = alpl + delalp/delz*dzabv
201 pfrz = exp(alpfrz)
202!
203 pfrzl(i,j) = pfrz
204 IF(modelname == 'GFS'.OR.modelname == 'RAPR')THEN
205 es=fpvsnew(tfrz)
206 es=min(es,pfrz)
207 qsfrz=con_eps*es/(pfrz+con_epsm1*es)
208 ELSE
209 qsfrz=pq0/pfrz &
210 *exp(a2*(tfrz-a3)/(tfrz-a4))
211 END IF
212!
213 rhz = qfrz/qsfrz
214 rhz = amax1(0.01,rhz)
215 rhz = amin1(rhz,1.0)
216 rhfrz(i,j)= rhz
217 ENDIF
218!
219! BOUND FREEZING LEVEL RH. FREEZING LEVEL HEIGHT IS
220! MEASURED WITH RESPECT TO MEAN SEA LEVEL.
221!
222! RHFRZ(I,J) = AMAX1(0.01,RHFRZ(I,J))
223! RHFRZ(I,J) = AMIN1(RHFRZ(I,J),1.00)
224 zfrz(i,j) = amax1(0.0,zfrz(i,j))
225 EXIT
226 ENDIF
227 10 CONTINUE
22820 CONTINUE
229!
230! END OF ROUTINE.
231!
232 RETURN
233 END
subroutine frzlvl(zfrz, rhfrz, pfrzl)
FRZLVL() Subroutine that computes FRZING LVL, Z and RH.
Definition FRZLVL.f:49