da_sigma_v_adj.inc
References to this file elsewhere.
1 subroutine da_sigma_v_adj(ifreq,p0,wv,hwv,ta,gamma,sigv, &
2 ADJ_p0,ADJ_wv,ADJ_hwv,ADJ_ta,ADJ_gamma,ADJ_sigma_v)
3
4 !-----------------------------------------------------------------------
5 ! Purpose: TBD
6 ! output: ADJ_p0, ADJ_wv, ADJ_hwv, ADJ_ta, ADJ_gamma
7 ! input: ADJ_sigma_v
8 !-----------------------------------------------------------------------
9
10 implicit none
11
12
13 integer, intent(in) :: ifreq
14 real, intent(in) :: p0,wv,hwv,ta,gamma ! base field
15 real, intent(inout) :: ADJ_p0,ADJ_wv,ADJ_hwv,ADJ_ta,ADJ_gamma
16 real, intent(in) :: ADJ_sigma_v
17 real, intent(out) :: sigv
18
19 real wvc, wvcor(4)
20 real ADJ_wvc
21
22 real voh1,otbar1,pbar1
23 real term21,term31,term41,term51,term61
24 real a11,a21,a31,a41,a51,a61
25 real ADJ_voh1,ADJ_otbar1,ADJ_pbar1
26 real ADJ_term21,ADJ_term31,ADJ_term41,ADJ_term51,ADJ_term61
27
28 real voh2,otbar2,pbar2
29 real term22,term32,term42,term52,term62
30 real a12,a22,a32,a42,a52,a62
31 real ADJ_voh2,ADJ_otbar2,ADJ_pbar2
32 real ADJ_term22,ADJ_term32,ADJ_term42,ADJ_term52,ADJ_term62
33
34 real voh3,otbar3,pbar3
35 real term23,term33,term43,term53,term63
36 real a13,a23,a33,a43,a53,a63
37 real ADJ_voh3,ADJ_otbar3,ADJ_pbar3
38 real ADJ_term23,ADJ_term33,ADJ_term43,ADJ_term53,ADJ_term63
39
40 real voh4,otbar4,pbar4
41 real term24,term34,term44,term54,term64
42 real a14,a24,a34,a44,a54,a64
43 real ADJ_voh4,ADJ_otbar4,ADJ_pbar4
44 real ADJ_term24,ADJ_term34,ADJ_term44,ADJ_term54,ADJ_term64
45
46 real const1,const2,const3,const4
47 real h1,h2,h3,h4
48
49 real ADJ_sigv
50
51 data const1,const2,const3,const4/0.6,2.8,0.2,0.2/
52 data h1,h2,h3,h4/5.0,4.9,6.8,6.4/
53
54 data a11,a21,a31,a41,a51,a61/-.13747e-2,-.43061e-4, .14618e+1, &
55 .25101e-3, .14635e-1,-.18588e+3/
56 data a12,a22,a32,a42,a52,a62/ .22176e-1,-.32367e-4,-.10840e-4, &
57 -.63578e-1, .16988e-7,-.29824e+2/
58 data a13,a23,a33,a43,a53,a63/-.10566e-2,-.12906e-3, .56975e+0, &
59 .10828e-8,-.17551e-7, .48601e-1/
60 data a14,a24,a34,a44,a54,a64/-.60808e-2,-.70936e-3, .28721e+1, &
61 .42636e-8,-.82910e-7, .26166e+0/
62
63 ! data wvcor/1.01,0.95,1.06,0.92/
64 data wvcor/1.02,0.98,1.02,0.88/
65 ! use modified water vapor value to correct for errors in theoretical absorption
66
67 wvc=0.0
68 ADJ_wvc=0.0
69 voh1=0.0
70 otbar1=0.0
71 pbar1=0.0
72 term21=0.0
73 term31=0.0
74 term41=0.0
75 term51=0.0
76 term61=0.0
77 ADJ_voh1=0.0
78 ADJ_otbar1=0.0
79 ADJ_pbar1=0.0
80 ADJ_term21=0.0
81 ADJ_term31=0.0
82 ADJ_term41=0.0
83 ADJ_term51=0.0
84 ADJ_term61=0.0
85
86 voh2=0.0
87 otbar2=0.0
88 pbar2=0.0
89 term22=0.0
90 term32=0.0
91 term42=0.0
92 term52=0.0
93 term62=0.0
94 ADJ_voh2=0.0
95 ADJ_otbar2=0.0
96 ADJ_pbar2=0.0
97 ADJ_term22=0.0
98 ADJ_term32=0.0
99 ADJ_term42=0.0
100 ADJ_term52=0.0
101 ADJ_term62=0.0
102
103 voh3=0.0
104 otbar3=0.0
105 pbar3=0.0
106 term23=0.0
107 term33=0.0
108 term43=0.0
109 term53=0.0
110 term63=0.0
111 ADJ_voh3=0.0
112 ADJ_otbar3=0.0
113 ADJ_pbar3=0.0
114 ADJ_term23=0.0
115 ADJ_term33=0.0
116 ADJ_term43=0.0
117 ADJ_term53=0.
118 ADJ_term63=0.0
119
120 voh4=0.0
121 otbar4=0.0
122 pbar4=0.0
123 term24=0.0
124 term34=0.0
125 term44=0.0
126 term54=0.0
127 term64=0.0
128 ADJ_voh4=0.0
129 ADJ_otbar4=0.0
130 ADJ_pbar4=0.0
131 ADJ_term24=0.0
132 ADJ_term34=0.0
133 ADJ_term44=0.0
134 ADJ_term54=0.0
135 ADJ_term64=0.0
136
137 sigv=0.0
138 ADJ_sigv=0.0
139
140 wvc = wv*wvcor(ifreq)
141
142 if (ifreq.eq.1) then
143
144 pbar1 = p0/(1.0 + hwv/h1)
145 voh1 = wv/hwv
146 term21 = a21*voh1
147 otbar1 = 1.0/(ta - const1*gamma*hwv)
148 term31 = a31*otbar1
149 term61 = a61*otbar1*otbar1
150 term41 = a41*pbar1*otbar1
151 term51 = a51*voh1*otbar1
152 sigv = a11 + term21 + term31 + term41 + term51 + term61
153
154 else if (ifreq.eq.2) then
155
156 pbar2 = p0/(1.0 + hwv/h2)
157 term22 = a22*pbar2
158 term52 = a52*pbar2*pbar2
159 voh2 = wv/hwv
160 term32 = a32*voh2
161 otbar2 = 1.0/(ta - const2*gamma*hwv)
162 term42 = a42*otbar2
163 term62 = a62*otbar2*otbar2
164 sigv = a12 + term22 + term32 + term42 + term52 + term62
165
166 else if (ifreq.eq.3) then
167
168 pbar3 = p0/(1.0 + hwv/h3)
169 term43 = a43*pbar3*pbar3
170 voh3 = wv/hwv
171 term23 = a23*voh3
172 otbar3 = 1.0/(ta - const3*gamma*hwv)
173 term33 = a33*otbar3
174 term53 = a53*pbar3*voh3
175 term63 = a63*otbar3*voh3
176 sigv = a13 + term23 + term33 + term43 + term53 + term63
177
178 else if (ifreq.eq.4) then
179
180 pbar4 = p0/(1.0 + hwv/h4)
181 term44 = a44*pbar4*pbar4
182 voh4 = wv/hwv
183 term24 = a24*voh4
184 otbar4 = 1.0/(ta - const4*gamma*hwv)
185 term34 = a34*otbar4
186 term54 = a54*pbar4*voh4
187 term64 = a64*otbar4*voh4
188 sigv = a14 + term24 + term34 + term44 + term54 + term64
189
190 else
191 sigv = 0.0
192
193 end if
194
195
196 ADJ_sigv = ADJ_sigma_v*wvc
197 ADJ_wvc = sigv*ADJ_sigma_v
198
199 if (ifreq.eq.1) then
200
201 ADJ_term21 = ADJ_sigv
202 ADJ_term31 = ADJ_sigv
203 ADJ_term41 = ADJ_sigv
204 ADJ_term51 = ADJ_sigv
205 ADJ_term61 = ADJ_sigv
206
207 ADJ_voh1 = a51*ADJ_term51*otbar1
208 ADJ_otbar1 = a51*voh1*ADJ_term51
209
210 ADJ_pbar1 = a41*ADJ_term41*otbar1
211 ADJ_otbar1 = a41*pbar1*ADJ_term41 + ADJ_otbar1
212 ADJ_otbar1 = 2.*a61*otbar1*ADJ_term61 + ADJ_otbar1
213
214 ADJ_otbar1 = a31*ADJ_term31 + ADJ_otbar1
215
216 ADJ_ta = -otbar1*otbar1*ADJ_otbar1 + ADJ_ta
217 ADJ_hwv = otbar1*otbar1*const1*gamma*ADJ_otbar1 + ADJ_hwv
218 ADJ_gamma = otbar1*otbar1*const1*ADJ_otbar1*hwv + ADJ_gamma
219
220 ADJ_voh1 = a21*ADJ_term21 + ADJ_voh1
221
222 ADJ_wv = ADJ_voh1/hwv + ADJ_wv
223 ADJ_hwv = -voh1*ADJ_voh1/hwv + ADJ_hwv
224
225 ADJ_p0 = ADJ_pbar1/(1.0 + hwv/h1) + ADJ_p0
226 ADJ_hwv = -pbar1*ADJ_pbar1/(h1*(1.0 + hwv/h1)) + ADJ_hwv
227
228 else if (ifreq.eq.2) then
229
230 ADJ_term22 = ADJ_sigv
231 ADJ_term32 = ADJ_sigv
232 ADJ_term42 = ADJ_sigv
233 ADJ_term52 = ADJ_sigv
234 ADJ_term62 = ADJ_sigv
235
236 ADJ_otbar2 = 2.*a62*otbar2*ADJ_term62
237
238 ADJ_otbar2 = a42*ADJ_term42 + ADJ_otbar2
239
240 ADJ_ta = -otbar2*otbar2*ADJ_otbar2 + ADJ_ta
241 ADJ_hwv = otbar2*otbar2*const2*gamma*ADJ_otbar2 + ADJ_hwv
242 ADJ_gamma = otbar2*otbar2*const2*ADJ_otbar2*hwv + ADJ_gamma
243
244 ADJ_voh2 = a32*ADJ_term32
245
246 ADJ_wv = ADJ_voh2/hwv + ADJ_wv
247 ADJ_hwv = -voh2*ADJ_voh2/hwv + ADJ_hwv
248
249 ADJ_pbar2 = 2.*a52*pbar2*ADJ_term52
250
251 ADJ_pbar2 = a22*ADJ_term22 + ADJ_pbar2
252
253 ADJ_p0 = ADJ_pbar2/(1.0 + hwv/h2) + ADJ_p0
254 ADJ_hwv = -pbar2*ADJ_pbar2/h2/(1.0 + hwv/h2) + ADJ_hwv
255
256 else if (ifreq.eq.3) then
257
258 ADJ_term23 = ADJ_sigv
259 ADJ_term33 = ADJ_sigv
260 ADJ_term43 = ADJ_sigv
261 ADJ_term53 = ADJ_sigv
262 ADJ_term63 = ADJ_sigv
263
264 ADJ_otbar3 = a63*ADJ_term63*voh3
265 ADJ_voh3 = a63*otbar3*ADJ_term63
266
267 ADJ_pbar3 = a53*ADJ_term53*voh3
268 ADJ_voh3 = a53*pbar3*ADJ_term53 + ADJ_voh3
269
270 ADJ_otbar3 = a33*ADJ_term33 + ADJ_otbar3
271
272 ADJ_ta = -otbar3*otbar3*ADJ_otbar3 + ADJ_ta
273 ADJ_hwv = otbar3*otbar3*const3*gamma*ADJ_otbar3 + ADJ_hwv
274 ADJ_gamma = otbar3*otbar3*const3*ADJ_otbar3*hwv + ADJ_gamma
275
276 ADJ_voh3 = a23*ADJ_term23 + ADJ_voh3
277
278 ADJ_wv = ADJ_voh3/hwv + ADJ_wv
279 ADJ_hwv =-voh3*ADJ_voh3/hwv + ADJ_hwv
280
281 ADJ_pbar3 = 2.*a43*pbar3*ADJ_term43 + ADJ_pbar3
282
283 ADJ_p0 = ADJ_pbar3/(1.0 + hwv/h3) + ADJ_p0
284 ADJ_hwv = -pbar3*ADJ_pbar3/h3/(1.0 + hwv/h3) + ADJ_hwv
285
286 else if (ifreq.eq.4) then
287
288 ADJ_term24 = ADJ_sigv
289 ADJ_term34 = ADJ_sigv
290 ADJ_term44 = ADJ_sigv
291 ADJ_term54 = ADJ_sigv
292 ADJ_term64 = ADJ_sigv
293
294 ADJ_otbar4 = a64*ADJ_term64*voh4
295 ADJ_voh4 = a64*otbar4*ADJ_term64
296
297 ADJ_pbar4 = a54*ADJ_term54*voh4
298 ADJ_voh4 = a54*pbar4*ADJ_term54 + ADJ_voh4
299
300 ADJ_otbar4 = a34*ADJ_term34 + ADJ_otbar4
301
302 ADJ_ta = -otbar4*otbar4*ADJ_otbar4 + ADJ_ta
303 ADJ_hwv = otbar4*otbar4*const4*gamma*ADJ_otbar4 + ADJ_hwv
304 ADJ_gamma = otbar4*otbar4*const4*ADJ_otbar4*hwv + ADJ_gamma
305
306 ADJ_voh4 = a24*ADJ_term24 + ADJ_voh4
307
308 ADJ_wv = ADJ_voh4/hwv + ADJ_wv
309 ADJ_hwv = -voh4*ADJ_voh4/hwv + ADJ_hwv
310
311 ADJ_pbar4 = 2.*a44*pbar4*ADJ_term44 + ADJ_pbar4
312
313 ADJ_p0 = ADJ_pbar4/(1.0 + hwv/h4) + ADJ_p0
314 ADJ_hwv = -pbar4*ADJ_pbar4/h4/(1.0 + hwv/h4) + ADJ_hwv
315 end if
316
317 ADJ_wv = ADJ_wvc*wvcor(ifreq) + ADJ_wv
318
319 end subroutine da_sigma_v_adj
320
321