da_allocate_y.inc
References to this file elsewhere.
1 subroutine da_allocate_y (iv, y)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Allocate arrays used in y and residual obs structures.
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 type (ob_type), intent(in) :: iv ! Ob type input.
10 type (y_type), intent(inout) :: y ! Residual type structure.
11
12 integer :: n, i ! Loop counter.
13 integer :: nlevels ! Number of levels.
14
15 !---------------------------------------------------------------------------
16 ! [1.0] Copy number of observations:
17 !---------------------------------------------------------------------------
18
19 if (trace_use) call da_trace_entry("da_allocate_y")
20
21 y % total_obs = iv % total_obs
22 y % num_synop = iv % num_synop
23 y % num_ships = iv % num_ships
24 y % num_metar = iv % num_metar
25 y % num_sound = iv % num_sound
26 y % num_pilot = iv % num_pilot
27 y % num_bogus = iv % num_bogus
28 y % num_Radar = iv % num_Radar
29 y % num_airep = iv % num_airep
30 y % num_satem = iv % num_satem
31 y % num_geoamv = iv % num_geoamv
32 y % num_polaramv = iv % num_polaramv
33 y % num_gpspw = iv % num_gpspw
34 y % num_gpsref = iv % num_gpsref
35 y % num_ssmi_tb = iv % num_ssmi_tb
36 y % num_ssmi_retrieval = iv % num_ssmi_retrieval
37 y % num_ssmt1 = iv % num_ssmt1
38 y % num_ssmt2 = iv % num_ssmt2
39 y % num_pseudo = num_pseudo
40 y % num_qscat = iv % num_qscat
41 y % num_profiler = iv % num_profiler
42 y % num_buoy = iv % num_buoy
43 y % num_airsr = iv % num_airsr
44 y % num_inst = iv % num_inst
45
46 !---------------------------------------------------------------------------
47 ! [2.0] Allocate:
48 !---------------------------------------------------------------------------
49
50 ! Initialize synops:
51
52 if (y % num_synop > 0) then
53 allocate (y % synop(1:y % num_synop))
54 y % synop(1:y % num_synop) % u = 0.0
55 y % synop(1:y % num_synop) % v = 0.0
56 y % synop(1:y % num_synop) % t = 0.0
57 y % synop(1:y % num_synop) % p = 0.0
58 y % synop(1:y % num_synop) % q = 0.0
59 end if
60
61 ! Initialize ships:
62
63 if (y % num_ships > 0) then
64 allocate (y % ships(1:y % num_ships))
65 y % ships(1:y % num_ships) % u = 0.0
66 y % ships(1:y % num_ships) % v = 0.0
67 y % ships(1:y % num_ships) % t = 0.0
68 y % ships(1:y % num_ships) % p = 0.0
69 y % ships(1:y % num_ships) % q = 0.0
70 end if
71
72 ! Initialize metars:
73
74 if (y % num_metar > 0) then
75 allocate (y % metar(1:y % num_metar))
76 y % metar(1:y % num_metar) % u = 0.0
77 y % metar(1:y % num_metar) % v = 0.0
78 y % metar(1:y % num_metar) % t = 0.0
79 y % metar(1:y % num_metar) % p = 0.0
80 y % metar(1:y % num_metar) % q = 0.0
81 end if
82
83 ! Initialize Geo. CMVs Obs:
84
85 if (y % num_geoamv > 0) then
86 allocate (y % geoamv(1:y % num_geoamv))
87 do n = 1, y % num_geoamv
88 nlevels = iv % geoamv(n) % info % levels
89 allocate (y % geoamv(n)%u(1:nlevels))
90 allocate (y % geoamv(n)%v(1:nlevels))
91 y % geoamv(n) % u(1:nlevels) = 0.0
92 y % geoamv(n) % v(1:nlevels) = 0.0
93 end do
94 end if
95
96 ! Initialize Polar CMVS;
97
98 if (y % num_polaramv > 0) then
99 allocate (y % polaramv(1:y % num_polaramv))
100
101 do n = 1, y % num_polaramv
102 nlevels = iv % polaramv(n) % info % levels
103 allocate (y % polaramv(n)%u(1:nlevels))
104 allocate (y % polaramv(n)%v(1:nlevels))
105 y % polaramv(n) % u(1:nlevels) = 0.0
106 y % polaramv(n) % v(1:nlevels) = 0.0
107 end do
108 end if
109
110 ! Initialize GPS TPW:
111
112 if (y % num_gpspw > 0) then
113 allocate (y % gpspw(1:y % num_gpspw))
114 y % gpspw(1:y % num_gpspw) % tpw = 0.0
115 end if
116
117 ! Initialize GPS Refractivity:
118
119 if (y % num_gpsref > 0) then
120 allocate (y % gpsref(1:y % num_gpsref))
121 do n = 1, y % num_gpsref
122 nlevels = iv % gpsref(n) % info % levels
123 allocate (y % gpsref(n)%ref(1:nlevels))
124 allocate (y % gpsref(n)% p(1:nlevels))
125 allocate (y % gpsref(n)% t(1:nlevels))
126 allocate (y % gpsref(n)% q(1:nlevels))
127
128 y % gpsref(n) % ref(1:nlevels) = 0.0
129 y % gpsref(n) % p(1:nlevels) = 0.0
130 y % gpsref(n) % t(1:nlevels) = 0.0
131 y % gpsref(n) % q(1:nlevels) = 0.0
132 end do
133 end if
134
135 ! Initialize sondes:
136
137 if (y % num_sound > 0) then
138 allocate (y % sound(1:y % num_sound))
139 do n = 1, y % num_sound
140 nlevels = max(1,iv % sound(n) % info % levels)
141 allocate (y % sound(n)%u(1:nlevels))
142 allocate (y % sound(n)%v(1:nlevels))
143 allocate (y % sound(n)%t(1:nlevels))
144 allocate (y % sound(n)%q(1:nlevels))
145
146 y % sound(n) % u(1:nlevels) = 0.0
147 y % sound(n) % v(1:nlevels) = 0.0
148 y % sound(n) % t(1:nlevels) = 0.0
149 y % sound(n) % q(1:nlevels) = 0.0
150 end do
151
152 ! Initialize sonde_sfc
153
154 allocate (y % sonde_sfc(1:y % num_sound))
155
156 y % sonde_sfc(1:y % num_sound) % u = 0.0
157 y % sonde_sfc(1:y % num_sound) % v = 0.0
158 y % sonde_sfc(1:y % num_sound) % t = 0.0
159 y % sonde_sfc(1:y % num_sound) % p = 0.0
160 y % sonde_sfc(1:y % num_sound) % q = 0.0
161 end if
162
163 ! Initialize pilots:
164
165 if (y % num_pilot > 0) then
166 allocate (y % pilot(1:y % num_pilot))
167 do n = 1, y % num_pilot
168 nlevels = iv % pilot(n) % info % levels
169 allocate (y % pilot(n)%u(1:nlevels))
170 allocate (y % pilot(n)%v(1:nlevels))
171
172 y % pilot(n) % u(1:nlevels) = 0.0
173 y % pilot(n) % v(1:nlevels) = 0.0
174 end do
175 end if
176
177 ! Initialize Radar:
178
179 if (y % num_Radar > 0) then
180 allocate (y % Radar(1:y % num_Radar))
181 do n = 1, y % num_Radar
182 nlevels = iv % Radar(n) % info % levels
183 allocate (y % Radar(n)%rv(1:nlevels))
184 allocate (y % Radar(n)%rf(1:nlevels))
185
186 y % Radar(n) % rv(1:nlevels) = 0.0
187 y % Radar(n) % rf(1:nlevels) = 0.0
188 end do
189 end if
190
191 ! Initialize AIREPs:
192
193 if (y % num_airep > 0) then
194 allocate (y % airep(1:y % num_airep))
195 do n = 1, y % num_airep
196 nlevels = iv % airep(n) % info % levels
197 allocate (y % airep(n)%u(1:nlevels))
198 allocate (y % airep(n)%v(1:nlevels))
199 allocate (y % airep(n)%t(1:nlevels))
200
201 y % airep(n) % u(1:nlevels) = 0.0
202 y % airep(n) % v(1:nlevels) = 0.0
203 y % airep(n) % t(1:nlevels) = 0.0
204 end do
205 end if
206
207 ! Initialize Bogus:
208
209 if (y % num_bogus > 0) then
210 allocate (y % bogus(1:y % num_bogus))
211 do n = 1, y % num_bogus
212 nlevels = iv % bogus(n) % info % levels
213 allocate (y % bogus(n)%u(1:nlevels))
214 allocate (y % bogus(n)%v(1:nlevels))
215 allocate (y % bogus(n)%t(1:nlevels))
216 allocate (y % bogus(n)%q(1:nlevels))
217
218 y % bogus(n) % u(1:nlevels) = 0.0
219 y % bogus(n) % v(1:nlevels) = 0.0
220 y % bogus(n) % t(1:nlevels) = 0.0
221 y % bogus(n) % q(1:nlevels) = 0.0
222 end do
223
224 y % bogus(1:y % num_bogus) % slp = 0.0
225 end if
226
227 ! Initialize satem:
228
229 if (y % num_satem > 0) then
230 allocate (y % satem(1:y % num_satem))
231 do n = 1, y % num_satem
232 nlevels = iv % satem(n) % info % levels
233 allocate (y % satem(n) % thickness(1:nlevels))
234
235 y % satem(n) % thickness(1:nlevels) = 0.0
236 end do
237 end if
238
239 if (y % num_ssmi_tb > 0) then
240 allocate (y % ssmi_tb(1:y % num_ssmi_tb))
241 y % ssmi_tb(1:y % num_ssmi_tb) % tb19v = 0.0
242 y % ssmi_tb(1:y % num_ssmi_tb) % tb19h = 0.0
243 y % ssmi_tb(1:y % num_ssmi_tb) % tb22v = 0.0
244 y % ssmi_tb(1:y % num_ssmi_tb) % tb37v = 0.0
245 y % ssmi_tb(1:y % num_ssmi_tb) % tb37h = 0.0
246 y % ssmi_tb(1:y % num_ssmi_tb) % tb85v = 0.0
247 y % ssmi_tb(1:y % num_ssmi_tb) % tb85h = 0.0
248 end if
249
250 if (y % num_ssmi_retrieval > 0) then
251 allocate (y % ssmi_retrieval(1:y % num_ssmi_retrieval))
252 y % ssmi_retrieval(1:y % num_ssmi_retrieval) % tpw = 0.0
253 y % ssmi_retrieval(1:y % num_ssmi_retrieval) % Speed = 0.0
254 end if
255
256 if (y % num_ssmt1 > 0) then
257 allocate (y % ssmt1(1:y % num_ssmt1))
258 do n = 1, y % num_ssmt1
259 nlevels = iv % ssmt1(n) % info % levels
260 allocate (y % ssmt1(n) % t(1:nlevels))
261 y % ssmt1(n) % t(1:nlevels) = 0.0
262 end do
263 end if
264
265 if (y % num_ssmt2 > 0) then
266 allocate (y % ssmt2(1:y % num_ssmt2))
267 do n = 1, y % num_ssmt2
268 nlevels = iv % ssmt2(n) % info % levels
269 allocate (y % ssmt2(n) % rh(1:nlevels))
270 y % ssmt2(n) % rh(1:nlevels) = 0.0
271 end do
272 end if
273
274 if (y % num_pseudo > 0) then
275 allocate (y % pseudo(1:y % num_pseudo))
276 y % pseudo(1:y % num_pseudo) % u = 0.0
277 y % pseudo(1:y % num_pseudo) % v = 0.0
278 y % pseudo(1:y % num_pseudo) % t = 0.0
279 y % pseudo(1:y % num_pseudo) % p = 0.0
280 y % pseudo(1:y % num_pseudo) % q = 0.0
281 end if
282
283 ! Initialize Quikscat:
284
285 if (y % num_qscat > 0) then
286 allocate (y % qscat(1:y % num_qscat))
287 y % qscat(1:y % num_qscat) % u = 0.0
288 y % qscat(1:y % num_qscat) % v = 0.0
289 end if
290
291 ! Initialize profilers:
292
293 if (y % num_profiler > 0) then
294 allocate (y % profiler(1:y % num_profiler))
295 do n = 1, y % num_profiler
296
297 nlevels = iv % profiler(n) % info % levels
298 allocate (y % profiler(n)%u(1:nlevels))
299 allocate (y % profiler(n)%v(1:nlevels))
300
301 y % profiler(n) % u(1:nlevels) = 0.0
302 y % profiler(n) % v(1:nlevels) = 0.0
303
304 end do
305 end if
306
307 ! Initialize buoy:
308
309 if (y % num_buoy > 0) then
310 allocate (y % buoy(1:y % num_buoy))
311 y % buoy(1:y % num_buoy) % u = 0.0
312 y % buoy(1:y % num_buoy) % v = 0.0
313 y % buoy(1:y % num_buoy) % t = 0.0
314 y % buoy(1:y % num_buoy) % p = 0.0
315 y % buoy(1:y % num_buoy) % q = 0.0
316 end if
317
318 ! Initialize radiance:
319
320 if (y % num_inst > 0) then
321 allocate (y % instid(1:y % num_inst))
322 do i = 1, y % num_inst
323 y % instid(i) % num_rad = iv % instid(i) % num_rad
324 y % instid(i) % nchan = iv % instid(i) % nchan
325 ! allocate (y % instid(i) % ichan(1:y % instid(i) % nchan))
326 ! do n = 1, y % instid(i) % nchan
327 ! y % instid(i) % ichan(n) = n
328 ! end do
329 if (y % instid(i) % num_rad < 1) then
330 nullify (y % instid(i) % tb)
331 cycle
332 end if
333 allocate (y % instid(i) % tb(1:y % instid(i) % nchan, y % instid(i) % num_rad))
334 y % instid(i) % tb(:,:) = 0.0
335 end do
336 end if
337 ! Initialize AIRS retrievals:
338
339 if (y % num_airsr > 0) then
340 allocate (y % airsr(1:y % num_airsr))
341 do n = 1, y % num_airsr
342 nlevels = iv % airsr(n) % info % levels
343 allocate (y % airsr(n)%t(1:nlevels))
344 allocate (y % airsr(n)%q(1:nlevels))
345
346 y % airsr(n) % t(1:nlevels) = 0.0
347 y % airsr(n) % q(1:nlevels) = 0.0
348 end do
349 end if
350
351 if (trace_use) call da_trace_exit("da_allocate_y")
352
353 end subroutine da_allocate_y
354
355