UPP (develop)
Loading...
Searching...
No Matches
WETFRZLVL.f
Go to the documentation of this file.
1
5
31 SUBROUTINE wetfrzlvl(TWET,ZWET)
32
33!
34!
35 use vrbls3d, only: pint, zint, t
36 use vrbls2d, only: fis, thz0, ths
37 use masks, only: lmh, sm
38 use params_mod, only: gi, p1000, capa, tfrz, d0065, d50
39 use ctlblk_mod, only: jsta, jend, im, jsta_2l, jend_2u, lm, spval, &
40 ista, iend, ista_2l, iend_2u
41!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42 implicit none
43!
44! DECLARE VARIABLES.
45!
46 REAL,intent(in) :: TWET(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,LM)
47 REAL,intent(out) :: ZWET(ista:iend,jsta:jend)
48!
49 integer I,J,LLMH,L
50 real HTSFC,THSFC,PSFC,TSFC,DELZ,DELT,ZL,ZU
51!*********************************************************************
52! START FRZLVL.
53!
54! LOOP OVER HORIZONTAL GRID.
55!
56!!$omp parallel do
57!!$omp& private(delt,delz,htsfc,l,llmh
58!!$omp& tsfc,zl,zu)
59 DO j=jsta,jend
60 DO i=ista,iend
61 IF(fis(i,j)==spval)THEN
62 zwet(i,j)=spval
63 cycle
64 ENDIF
65 htsfc = fis(i,j)*gi
66 llmh = nint(lmh(i,j))
67 zwet(i,j) = htsfc
68!
69! CHECK IF FREEZING LEVEL IS AT THE GROUND.
70! IF YES, ESTIMATE UNDERGROUND FREEZING LEVEL USING 6.5C/KM LAPSE RATE
71! AND ASSUME RH TO BE EQUAL TO RH AT SFC
72!
73 thsfc = (sm(i,j)*thz0(i,j)+(1.-sm(i,j))*ths(i,j))
74 psfc = pint(i,j,llmh+1)
75 tsfc = thsfc*(psfc/p1000)**capa
76
77 IF (tsfc<=tfrz) THEN
78! ZWET(I,J) = HTSFC
79 zwet(i,j) = htsfc+(tsfc-tfrz)/d0065
80 cycle
81 ENDIF
82!
83! OTHERWISE, LOCATE THE FREEZING LEVEL ALOFT.
84!
85 loopl:DO l = llmh,1,-1
86 IF (twet(i,j,l)<=tfrz) THEN
87 IF (l<llmh-1) THEN
88 delz = d50*(zint(i,j,l)-zint(i,j,l+2))
89 zl = d50*(zint(i,j,l+1)+zint(i,j,l+2))
90 delt = twet(i,j,l)-twet(i,j,l+1)
91 zwet(i,j) = zl + (tfrz-twet(i,j,l+1))/delt*delz
92 ELSE
93 zu = d50*(zint(i,j,l)+zint(i,j,l+1))
94 zl = htsfc
95 delz = zu-zl
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 delt = t(i,j,l)-tsfc
99 IF(delt /= 0.)THEN
100 zwet(i,j) = zl + (tfrz-tsfc)/delt*delz
101 ELSE
102 zwet(i,j) = htsfc+(tsfc-twet(i,j,l))/d0065
103 END IF
104 IF (zwet(i,j) > zu) THEN
105 zwet(i,j)=zu
106 ENDIF
107 IF ((-1*zwet(i,j)) > zu) THEN
108 zwet(i,j)=zu
109 endif
110 ENDIF
111 EXIT loopl
112 ENDIF
113 ENDDO loopl
114
115 ENDDO !end I
116 ENDDO !end J
117!
118! END OF ROUTINE.
119!
120 RETURN
121 END
subroutine wetfrzlvl(twet, zwet)
This routine computes the lowest height with a wet bulb temperature of freezing for each mass point o...
Definition WETFRZLVL.f:32