da_sigma_v_tl.inc
References to this file elsewhere.
1 subroutine da_sigma_v_tl(ifreq,p0,wv,hwv,ta,gamma,sigma_v, &
2 TGL_p0,TGL_wv,TGL_hwv,TGL_ta,TGL_gamma,TGL_sigma_v)
3
4 !---------------------------------------------------------------------------
5 ! Purpose : TBD
6 ! Input : TGL_p0, TGL_wv, TGL_hwv, TGL_ta, TGL_gamma
7 ! Output : TGL_sigma_v
8 ! Output base field : sigma_v
9 !---------------------------------------------------------------------------
10
11 implicit none
12
13 integer, intent(in) :: ifreq
14 real, intent(in ):: p0,wv,hwv,ta,gamma ! base field
15 real, intent(in ):: TGL_p0,TGL_wv,TGL_hwv,TGL_ta,TGL_gamma
16 real, intent(out ):: TGL_sigma_v,sigma_v
17
18 real wvc, wvcor(4)
19 real TGL_wvc
20
21 real voh1,otbar1,pbar1
22 real term21,term31,term41,term51,term61
23 real a11,a21,a31,a41,a51,a61
24 real TGL_voh1,TGL_otbar1,TGL_pbar1
25 real TGL_term21,TGL_term31,TGL_term41,TGL_term51,TGL_term61
26
27 real voh2,otbar2,pbar2
28 real term22,term32,term42,term52,term62
29 real a12,a22,a32,a42,a52,a62
30 real TGL_voh2,TGL_otbar2,TGL_pbar2
31 real TGL_term22,TGL_term32,TGL_term42,TGL_term52,TGL_term62
32
33 real voh3,otbar3,pbar3
34 real term23,term33,term43,term53,term63
35 real a13,a23,a33,a43,a53,a63
36 real TGL_voh3,TGL_otbar3,TGL_pbar3
37 real TGL_term23,TGL_term33,TGL_term43,TGL_term53,TGL_term63
38
39 real voh4,otbar4,pbar4
40 real term24,term34,term44,term54,term64
41 real a14,a24,a34,a44,a54,a64
42 real TGL_voh4,TGL_otbar4,TGL_pbar4
43 real TGL_term24,TGL_term34,TGL_term44,TGL_term54,TGL_term64
44
45 real const1,const2,const3,const4
46 real h1,h2,h3,h4
47
48 real sigv, TGL_sigv
49
50 data const1,const2,const3,const4/0.6,2.8,0.2,0.2/
51 data h1,h2,h3,h4/5.0,4.9,6.8,6.4/
52
53 data a11,a21,a31,a41,a51,a61/-.13747e-2,-.43061e-4, .14618e+1, &
54 .25101e-3, .14635e-1,-.18588e+3/
55 data a12,a22,a32,a42,a52,a62/ .22176e-1,-.32367e-4,-.10840e-4, &
56 -.63578e-1, .16988e-7,-.29824e+2/
57 data a13,a23,a33,a43,a53,a63/-.10566e-2,-.12906e-3, .56975e+0, &
58 .10828e-8,-.17551e-7, .48601e-1/
59 data a14,a24,a34,a44,a54,a64/-.60808e-2,-.70936e-3, .28721e+1, &
60 .42636e-8,-.82910e-7, .26166e+0/
61
62 ! data wvcor/1.01,0.95,1.06,0.92/
63 data wvcor/1.02,0.98,1.02,0.88/
64 ! use modified water vapor value to correct for errors in theoretical absorption
65
66 wvc = wv*wvcor(ifreq)
67 TGL_wvc = TGL_wv*wvcor(ifreq)
68
69 if (ifreq.eq.1) then
70 pbar1 = p0/(1.0 + hwv/h1)
71 TGL_pbar1 = TGL_p0/(1.0 + hwv/h1)-pbar1*TGL_hwv/(h1*(1.0 + hwv/h1))
72 voh1 = wv/hwv
73 TGL_voh1 = TGL_wv/hwv-voh1*TGL_hwv/hwv
74 term21 = a21*voh1
75 TGL_term21 = a21*TGL_voh1
76 otbar1 = 1.0/(ta - const1*gamma*hwv)
77 TGL_otbar1 = -otbar1*otbar1*(TGL_ta-const1*gamma*TGL_hwv &
78 -const1*TGL_gamma*hwv)
79 term31 = a31*otbar1
80 TGL_term31 = a31*TGL_otbar1
81 term61 = a61*otbar1*otbar1
82 TGL_term61 = 2.*a61*otbar1*TGL_otbar1
83 term41 = a41*pbar1*otbar1
84 TGL_term41 = a41*(TGL_pbar1*otbar1+pbar1*TGL_otbar1)
85 term51 = a51*voh1*otbar1
86 TGL_term51 = a51*(TGL_voh1*otbar1+voh1*TGL_otbar1)
87 sigv = a11 + term21 + term31 + term41 + term51 + term61
88 TGL_sigv = TGL_term21+TGL_term31+TGL_term41+TGL_term51+TGL_term61
89
90 else if (ifreq.eq.2) then
91 pbar2 = p0/(1.0 + hwv/h2)
92 TGL_pbar2 = TGL_p0/(1.0 + hwv/h2)-pbar2*TGL_hwv/h2/(1.0 + hwv/h2)
93 term22 = a22*pbar2
94 TGL_term22 = a22*TGL_pbar2
95 term52 = a52*pbar2*pbar2
96 TGL_term52 = 2.*a52*pbar2*TGL_pbar2
97 voh2 = wv/hwv
98 TGL_voh2 = TGL_wv/hwv-voh2*TGL_hwv/hwv
99 term32 = a32*voh2
100 TGL_term32 = a32*TGL_voh2
101 otbar2 = 1.0/(ta - const2*gamma*hwv)
102 TGL_otbar2 = -otbar2*otbar2*(TGL_ta-const2*gamma*TGL_hwv &
103 -const2*TGL_gamma*hwv)
104 term42 = a42*otbar2
105 TGL_term42 = a42*TGL_otbar2
106 term62 = a62*otbar2*otbar2
107 TGL_term62 = 2.*a62*otbar2*TGL_otbar2
108 sigv = a12 + term22 + term32 + term42 + term52 + term62
109 TGL_sigv = TGL_term22 + TGL_term32 + TGL_term42 + TGL_term52 + TGL_term62
110
111 else if (ifreq.eq.3) then
112 pbar3 = p0/(1.0 + hwv/h3)
113 TGL_pbar3 = TGL_p0/(1.0 + hwv/h3)-pbar3*TGL_hwv/h3/(1.0 + hwv/h3)
114 term43 = a43*pbar3*pbar3
115 TGL_term43 = 2.*a43*pbar3*TGL_pbar3
116 voh3 = wv/hwv
117 TGL_voh3 = TGL_wv/hwv-voh3*TGL_hwv/hwv
118 term23 = a23*voh3
119 TGL_term23 = a23*TGL_voh3
120 otbar3 = 1.0/(ta - const3*gamma*hwv)
121 TGL_otbar3 = -otbar3*otbar3*(TGL_ta-const3*gamma*TGL_hwv &
122 -const3*TGL_gamma*hwv)
123 term33 = a33*otbar3
124 TGL_term33 = a33*TGL_otbar3
125 term53 = a53*pbar3*voh3
126 TGL_term53 = a53*(TGL_pbar3*voh3+pbar3*TGL_voh3)
127 term63 = a63*otbar3*voh3
128 TGL_term63 = a63*(TGL_otbar3*voh3+otbar3*TGL_voh3)
129 sigv = a13 + term23 + term33 + term43 + term53 + term63
130 TGL_sigv = TGL_term23 + TGL_term33 + TGL_term43 + TGL_term53 + TGL_term63
131
132 else if (ifreq.eq.4) then
133
134 pbar4 = p0/(1.0 + hwv/h4)
135 TGL_pbar4 = TGL_p0/(1.0 + hwv/h4)-pbar4*TGL_hwv/h4/(1.0 + hwv/h4)
136 term44 = a44*pbar4*pbar4
137 TGL_term44 = 2.*a44*pbar4*TGL_pbar4
138 voh4 = wv/hwv
139 TGL_voh4 = TGL_wv/hwv-voh4*TGL_hwv/hwv
140 term24 = a24*voh4
141 TGL_term24 = a24*TGL_voh4
142 otbar4 = 1.0/(ta - const4*gamma*hwv)
143 TGL_otbar4 = -otbar4*otbar4*(TGL_ta-const4*gamma*TGL_hwv &
144 -const4*TGL_gamma*hwv)
145 term34 = a34*otbar4
146 TGL_term34 = a34*TGL_otbar4
147 term54 = a54*pbar4*voh4
148 TGL_term54 = a54*(TGL_pbar4*voh4+pbar4*TGL_voh4)
149 term64 = a64*otbar4*voh4
150 TGL_term64 = a64*(TGL_otbar4*voh4+otbar4*TGL_voh4)
151 sigv = a14 + term24 + term34 + term44 + term54 + term64
152 TGL_sigv = TGL_term24 + TGL_term34 + TGL_term44 + TGL_term54 + TGL_term64
153
154 else
155 sigv = 0.0
156 TGL_sigv = 0.0
157
158 end if
159
160 sigma_v = sigv*wvc
161 TGL_sigma_v = TGL_sigv*wvc+sigv*TGL_wvc
162
163 end subroutine da_sigma_v_tl
164
165