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 (iv_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 % nlocal(:) = iv%info(:)%nlocal
22 y % ntotal(:) = iv%info(:)%ntotal
23
24 y % num_inst = iv % num_inst
25
26 !---------------------------------------------------------------------------
27 ! [2.0] Allocate:
28 !---------------------------------------------------------------------------
29
30 if (y % nlocal(synop) > 0) then
31 allocate (y % synop(1:y % nlocal(synop)))
32 y % synop(1:y % nlocal(synop)) % u = 0.0
33 y % synop(1:y % nlocal(synop)) % v = 0.0
34 y % synop(1:y % nlocal(synop)) % t = 0.0
35 y % synop(1:y % nlocal(synop)) % p = 0.0
36 y % synop(1:y % nlocal(synop)) % q = 0.0
37 end if
38
39 if (y % nlocal(ships) > 0) then
40 allocate (y % ships(1:y % nlocal(ships)))
41 y % ships(1:y % nlocal(ships)) % u = 0.0
42 y % ships(1:y % nlocal(ships)) % v = 0.0
43 y % ships(1:y % nlocal(ships)) % t = 0.0
44 y % ships(1:y % nlocal(ships)) % p = 0.0
45 y % ships(1:y % nlocal(ships)) % q = 0.0
46 end if
47
48 if (y % nlocal(metar) > 0) then
49 allocate (y % metar(1:y % nlocal(metar)))
50 y % metar(1:y % nlocal(metar)) % u = 0.0
51 y % metar(1:y % nlocal(metar)) % v = 0.0
52 y % metar(1:y % nlocal(metar)) % t = 0.0
53 y % metar(1:y % nlocal(metar)) % p = 0.0
54 y % metar(1:y % nlocal(metar)) % q = 0.0
55 end if
56
57 if (y % nlocal(geoamv) > 0) then
58 allocate (y % geoamv(1:y % nlocal(geoamv)))
59 do n = 1, y % nlocal(geoamv)
60 nlevels = iv%info(geoamv)%levels(n)
61 allocate (y % geoamv(n)%u(1:nlevels))
62 allocate (y % geoamv(n)%v(1:nlevels))
63 y % geoamv(n) % u(1:nlevels) = 0.0
64 y % geoamv(n) % v(1:nlevels) = 0.0
65 end do
66 end if
67
68 if (y % nlocal(polaramv) > 0) then
69 allocate (y % polaramv(1:y % nlocal(polaramv)))
70 do n = 1, y % nlocal(polaramv)
71 nlevels = iv%info(polaramv)%levels(n)
72 allocate (y % polaramv(n)%u(1:nlevels))
73 allocate (y % polaramv(n)%v(1:nlevels))
74 y % polaramv(n) % u(1:nlevels) = 0.0
75 y % polaramv(n) % v(1:nlevels) = 0.0
76 end do
77 end if
78
79 if (y % nlocal(gpspw) > 0) then
80 allocate (y % gpspw(1:y % nlocal(gpspw)))
81 y % gpspw(1:y % nlocal(gpspw)) % tpw = 0.0
82 end if
83
84 if (y % nlocal(gpsref) > 0) then
85 allocate (y % gpsref(1:y % nlocal(gpsref)))
86 do n = 1, y % nlocal(gpsref)
87 nlevels = iv%info(gpsref)%levels(n)
88 allocate (y % gpsref(n)%ref(1:nlevels))
89 allocate (y % gpsref(n)% p(1:nlevels))
90 allocate (y % gpsref(n)% t(1:nlevels))
91 allocate (y % gpsref(n)% q(1:nlevels))
92
93 y % gpsref(n) % ref(1:nlevels) = 0.0
94 y % gpsref(n) % p(1:nlevels) = 0.0
95 y % gpsref(n) % t(1:nlevels) = 0.0
96 y % gpsref(n) % q(1:nlevels) = 0.0
97 end do
98 end if
99
100 if (y % nlocal(sound) > 0) then
101 allocate (y % sound(1:y % nlocal(sound)))
102 do n = 1, y % nlocal(sound)
103 nlevels = max(1,iv%info(sound)%levels(n))
104 allocate (y % sound(n)%u(1:nlevels))
105 allocate (y % sound(n)%v(1:nlevels))
106 allocate (y % sound(n)%t(1:nlevels))
107 allocate (y % sound(n)%q(1:nlevels))
108 y % sound(n) % u(1:nlevels) = 0.0
109 y % sound(n) % v(1:nlevels) = 0.0
110 y % sound(n) % t(1:nlevels) = 0.0
111 y % sound(n) % q(1:nlevels) = 0.0
112 end do
113
114 allocate (y % sonde_sfc(1:y % nlocal(sonde_sfc)))
115
116 y % sonde_sfc(1:y % nlocal(sonde_sfc)) % u = 0.0
117 y % sonde_sfc(1:y % nlocal(sonde_sfc)) % v = 0.0
118 y % sonde_sfc(1:y % nlocal(sonde_sfc)) % t = 0.0
119 y % sonde_sfc(1:y % nlocal(sonde_sfc)) % p = 0.0
120 y % sonde_sfc(1:y % nlocal(sonde_sfc)) % q = 0.0
121 end if
122
123 if (y % nlocal(pilot) > 0) then
124 allocate (y % pilot(1:y % nlocal(pilot)))
125 do n = 1, y % nlocal(pilot)
126 nlevels = iv%info(pilot)%levels(n)
127 allocate (y % pilot(n)%u(1:nlevels))
128 allocate (y % pilot(n)%v(1:nlevels))
129 y % pilot(n) % u(1:nlevels) = 0.0
130 y % pilot(n) % v(1:nlevels) = 0.0
131 end do
132 end if
133
134 if (y % nlocal(radar) > 0) then
135 allocate (y % radar(1:y % nlocal(radar)))
136 do n = 1, y % nlocal(radar)
137 nlevels = iv%info(radar)%levels(n)
138 allocate (y % radar(n)%rv(1:nlevels))
139 allocate (y % radar(n)%rf(1:nlevels))
140 y % radar(n) % rv(1:nlevels) = 0.0
141 y % radar(n) % rf(1:nlevels) = 0.0
142 end do
143 end if
144
145 if (y % nlocal(airep) > 0) then
146 allocate (y % airep(1:y % nlocal(airep)))
147 do n = 1, y % nlocal(airep)
148 nlevels = iv%info(airep)%levels(n)
149 allocate (y % airep(n)%u(1:nlevels))
150 allocate (y % airep(n)%v(1:nlevels))
151 allocate (y % airep(n)%t(1:nlevels))
152 y % airep(n) % u(1:nlevels) = 0.0
153 y % airep(n) % v(1:nlevels) = 0.0
154 y % airep(n) % t(1:nlevels) = 0.0
155 end do
156 end if
157
158 if (y % nlocal(bogus) > 0) then
159 allocate (y % bogus(1:y % nlocal(bogus)))
160 do n = 1, y % nlocal(bogus)
161 nlevels = iv%info(bogus)%levels(n)
162 allocate (y % bogus(n)%u(1:nlevels))
163 allocate (y % bogus(n)%v(1:nlevels))
164 allocate (y % bogus(n)%t(1:nlevels))
165 allocate (y % bogus(n)%q(1:nlevels))
166 y % bogus(n) % u(1:nlevels) = 0.0
167 y % bogus(n) % v(1:nlevels) = 0.0
168 y % bogus(n) % t(1:nlevels) = 0.0
169 y % bogus(n) % q(1:nlevels) = 0.0
170 end do
171
172 y % bogus(1:y % nlocal(bogus)) % slp = 0.0
173 end if
174
175 if (y % nlocal(satem) > 0) then
176 allocate (y % satem(1:y % nlocal(satem)))
177 do n = 1, y % nlocal(satem)
178 nlevels = iv%info(satem)%levels(n)
179 allocate (y % satem(n) % thickness(1:nlevels))
180 y % satem(n) % thickness(1:nlevels) = 0.0
181 end do
182 end if
183
184 if (y % nlocal(ssmi_tb) > 0) then
185 allocate (y % ssmi_tb(1:y % nlocal(ssmi_tb)))
186 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb19v = 0.0
187 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb19h = 0.0
188 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb22v = 0.0
189 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb37v = 0.0
190 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb37h = 0.0
191 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb85v = 0.0
192 y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb85h = 0.0
193 end if
194
195 if (y % nlocal(ssmi_rv) > 0) then
196 allocate (y % ssmi_rv(1:y % nlocal(ssmi_rv)))
197 y % ssmi_rv(1:y % nlocal(ssmi_rv)) % tpw = 0.0
198 y % ssmi_rv(1:y % nlocal(ssmi_rv)) % Speed = 0.0
199 end if
200
201 if (y % nlocal(ssmt1) > 0) then
202 allocate (y % ssmt1(1:y % nlocal(ssmt1)))
203 do n = 1, y % nlocal(ssmt1)
204 nlevels = iv%info(ssmt1)%levels(n)
205 allocate (y % ssmt1(n) % t(1:nlevels))
206 y % ssmt1(n) % t(1:nlevels) = 0.0
207 end do
208 end if
209
210 if (y % nlocal(ssmt2) > 0) then
211 allocate (y % ssmt2(1:y % nlocal(ssmt2)))
212 do n = 1, y % nlocal(ssmt2)
213 nlevels=iv%info(ssmt2)%levels(n)
214 allocate (y % ssmt2(n) % rh(1:nlevels))
215 y % ssmt2(n) % rh(1:nlevels) = 0.0
216 end do
217 end if
218
219 if (y % nlocal(pseudo) > 0) then
220 allocate (y % pseudo(1:y % nlocal(pseudo)))
221 y % pseudo(1:y % nlocal(pseudo)) % u = 0.0
222 y % pseudo(1:y % nlocal(pseudo)) % v = 0.0
223 y % pseudo(1:y % nlocal(pseudo)) % t = 0.0
224 y % pseudo(1:y % nlocal(pseudo)) % p = 0.0
225 y % pseudo(1:y % nlocal(pseudo)) % q = 0.0
226 end if
227
228 if (y % nlocal(qscat) > 0) then
229 allocate (y % qscat(1:y % nlocal(qscat)))
230 y % qscat(1:y % nlocal(qscat)) % u = 0.0
231 y % qscat(1:y % nlocal(qscat)) % v = 0.0
232 end if
233
234 if (y % nlocal(profiler) > 0) then
235 allocate (y % profiler(1:y % nlocal(profiler)))
236 do n = 1, y % nlocal(profiler)
237 nlevels = iv%info(profiler)%levels(n)
238 allocate (y % profiler(n)%u(1:nlevels))
239 allocate (y % profiler(n)%v(1:nlevels))
240 y % profiler(n) % u(1:nlevels) = 0.0
241 y % profiler(n) % v(1:nlevels) = 0.0
242 end do
243 end if
244
245 if (y % nlocal(buoy) > 0) then
246 allocate (y % buoy(1:y % nlocal(buoy)))
247 y % buoy(1:y % nlocal(buoy)) % u = 0.0
248 y % buoy(1:y % nlocal(buoy)) % v = 0.0
249 y % buoy(1:y % nlocal(buoy)) % t = 0.0
250 y % buoy(1:y % nlocal(buoy)) % p = 0.0
251 y % buoy(1:y % nlocal(buoy)) % q = 0.0
252 end if
253
254 if (y % num_inst > 0) then
255 allocate (y % instid(1:y % num_inst))
256 do i = 1, y % num_inst
257 y % instid(i) % num_rad = iv % instid(i) % num_rad
258 y % instid(i) % nchan = iv % instid(i) % nchan
259 ! allocate (y % instid(i) % ichan(1:y % instid(i) % nchan))
260 ! do n = 1, y % instid(i) % nchan
261 ! y % instid(i) % ichan(n) = n
262 ! end do
263 if (y % instid(i) % num_rad < 1) then
264 nullify (y % instid(i) % tb)
265 cycle
266 end if
267 allocate (y % instid(i) % tb(1:y % instid(i) % nchan, y % instid(i) % num_rad))
268 y % instid(i) % tb(:,:) = 0.0
269 end do
270 end if
271
272 if (y % nlocal(airsr) > 0) then
273 allocate (y % airsr(1:y % nlocal(airsr)))
274 do n = 1, y % nlocal(airsr)
275 nlevels = iv%info(airsr)%levels(n)
276 allocate (y % airsr(n)%t(1:nlevels))
277 allocate (y % airsr(n)%q(1:nlevels))
278 y % airsr(n) % t(1:nlevels) = 0.0
279 y % airsr(n) % q(1:nlevels) = 0.0
280 end do
281 end if
282
283 if (trace_use) call da_trace_exit("da_allocate_y")
284
285 end subroutine da_allocate_y
286
287