da_condens_adj.inc
References to this file elsewhere.
1 subroutine da_condens_adj(DT,SCR31,SCR42,SCR71,DUM31,PRD, &
2 QVT,QCT,QRT,TTT,P_B,T_B,QV_B,QCW_B,QRN_B, &
3 SCR319,SCR429,SCR719,DUM319,PRD9, &
4 QVT9,QCT9,QRT9,TTT9,P_A,T_A,QV_A,QCW_A,QRN_A,kts,kte)
5
6 !-----------------------------------------------------------------------
7 ! Purpose: Condensation
8 !-----------------------------------------------------------------------
9
10 implicit none
11
12 integer, intent(in) :: kts, kte
13 real, dimension(kts:kte), intent(in) :: DT,SCR31,SCR42,SCR71,PRD,DUM31
14 real, dimension(kts:kte), intent(in) :: P_B,T_B,QV_B,QCW_B,QRN_B
15 real, dimension(kts:kte), intent(inout) :: SCR319,SCR429,SCR719,PRD9
16 real, dimension(kts:kte), intent(inout) :: P_A,T_A,QV_A,QCW_A,QRN_A,DUM319
17
18 real, dimension(kts:kte), intent(in) :: QVT,QCT,QRT,TTT
19 real, dimension(kts:kte), intent(inout) :: QRT9,QCT9,QVT9,TTT9
20
21
22 real, dimension(kts:kte) :: DUM2139
23 real, dimension(kts:kte) :: TMP,DUM114,DUM2129,SCR89,DUM212,DUM115
24 real, dimension(kts:kte) :: PRC5,PRC59,DUM1149,SCR61,SCR8,DUM213
25 real, dimension(kts:kte) :: SCR619
26 integer :: k
27
28 ! initilization
29
30 do K=kts,kte
31 DUM2129(K) = 0.0
32 SCR89 (K) = 0.0
33 PRC59 (K) = 0.0
34 end do
35
36 do K=kts, kte
37
38 if (DT(k) <= 0.0) cycle
39
40 DUM114(K)=1.0e3*SVP1*EXP(SVP2*(SCR71(K)-SVPT0)/(SCR71(K)-SVP3))
41
42 if(SCR71(K) > TO) then
43 DUM212(K)=DUM31(K)*DUM31(K)/(gas_constant_v*PRD(K))
44 else
45 DUM212(K)=XLS*DUM31(K)/(gas_constant_v*PRD(K))
46 end if
47 PRC5(K)=.622*DUM114(K)/(P_B(K)-DUM114(K))
48
49 if(SCR42(K) < PRC5(K) .AND. SCR71(K) < TO) then
50 SCR61(K)=0.0
51 else
52 SCR8(K)=(SCR42(K)-PRC5(K))/(1.0+DUM212(K)*PRC5(K)/ &
53 (SCR71(K)*SCR71(K)))
54
55 DUM115(K)=SCR31(K)+SCR8(K)
56 if (DUM115(K) >= 0.0)then
57 SCR61(K)=SCR8(K)/DT(k)
58 else
59 SCR61(K)=-SCR31(K)/DT(k)
60 end if
61 end if
62 if(SCR71(K) > TO)then
63 DUM213(K)=DUM31(K)/PRD(K)
64 else
65 DUM213(K)=XLS/PRD(K)
66 end if
67
68 TTT9(K)=DT(K)*T_A(K)
69 SCR619(K)=DT(K)*DUM213(K)*T_A(K)
70 DUM2139(K)=DT(K)*SCR61(K)*T_A(K)
71 if(QRN_B(K) < 1.0e-25) QRN_A(K)=0.0
72 QRT9(K)=DT(K)*QRN_A(K)
73
74 DUM319(K)=0.0
75 if(SCR71(K) > TO)then
76 DUM319(K)=DUM2139(K)/PRD(K)
77 PRD9(K)=-DUM31(K)/(PRD(K)*PRD(K))*DUM2139(K)
78 else
79 PRD9(K)=-XLS/(PRD(K)*PRD(K))*DUM2139(K)
80 end if
81 if(QCW_B(K) < 1.0e-25) QCW_A(K)=0.0
82 QCT9(K)=DT(K)*QCW_A(K)
83 SCR619(K)=SCR619(K)+DT(K)*QCW_A(K)
84 if(QV_B(K) < 1.0e-25) QV_A(K)=0.0
85 QVT9(K)=DT(K)*QV_A(K)
86 SCR619(K)=SCR619(K)-DT(K)*QV_A(K)
87
88 SCR319(K)=0.0
89 SCR429(K)=0.0
90 SCR719(K)=0.0
91 if(SCR42(K) >= PRC5(K) .OR. SCR71(K) >= TO) then
92 if(DUM115(K) >= 0.0)then
93 SCR89(K)=SCR89(K)+SCR619(K)/DT(k)
94 else
95 SCR319(K)=-SCR619(K)/DT(k)
96 end if
97
98 TMP(K)=1.0/(1.0+DUM212(K)*PRC5(K)/(SCR71(K)*SCR71(K)))
99 SCR719(K)=TMP(K)*TMP(K)*2.0*DUM212(K)*PRC5(K) &
100 *(SCR42(K)-PRC5(K))/(SCR71(K)*SCR71(K)*SCR71(K))*SCR89(K)
101 DUM2129(K)=DUM2129(K)-TMP(K)*TMP(K)*(SCR42(K)-PRC5(K))*PRC5(K)/ &
102 (SCR71(K)*SCR71(K))*SCR89(K)
103 PRC59(K)=PRC59(K)-TMP(K)*(1.0+(SCR42(K)-PRC5(K))*DUM212(K)/ &
104 (SCR71(K)*SCR71(K))*TMP(K))*SCR89(K)
105 SCR429(K)=TMP(K)*SCR89(K)
106 end if
107
108 TMP(K)=.622/(P_B(K)-DUM114(K))**2
109 DUM1149(K)=TMP(K)*P_B(K)*PRC59(K)
110 P_A(K)=P_A(K)-TMP(K)*DUM114(K)*PRC59(K)
111 if(SCR71(K) > TO) then
112 PRD9(K)=PRD9(K)-DUM31(K)*DUM31(K)/ &
113 (gas_constant_v*PRD(K)*PRD(K))*DUM2129(K)
114 DUM319(K)=DUM319(K)+2.0*DUM31(K)/(gas_constant_v*PRD(K))*DUM2129(K)
115 else
116 PRD9(K)=PRD9(K)-XLS*DUM31(K)/(gas_constant_v*PRD(K)*PRD(K))*DUM2129(K)
117 DUM319(K)=DUM319(K)+XLS/(gas_constant_v*PRD(K))*DUM2129(K)
118 end if
119 DUM114(K)=1.0e3*SVP1*EXP(SVP2*(SCR71(K)-SVPT0)/(SCR71(K)-SVP3))
120 SCR719(K)=SCR719(K)+DUM114(K)*SVP2*(SVPT0-SVP3)/ &
121 (SCR71(K)-SVP3)**2*DUM1149(K)
122
123 end do
124
125 end subroutine da_condens_adj