da_random_omb_all.inc

References to this file elsewhere.
1 subroutine da_random_omb_all(iv, ob)
2 
3    !-------------------------------------------------------------------------
4    ! Purpose: Allocates observation structure and fills it fro iv.
5    !-------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (iv_type), intent(inout) :: iv   ! Obs and header structure.
10    type (y_type), intent(inout)  :: ob   ! (Smaller) observation structure.
11 
12    integer                       :: n, k ! Loop counters.
13 
14    if (trace_use) call da_trace_entry("da_random_omb_all")
15 
16    !----------------------------------------------------------------------
17    ! [1.0] Initialise random number sequence:
18    !----------------------------------------------------------------------
19 
20    call da_random_seed
21    
22    !----------------------------------------------------------------------
23    !  [2.0] Randomize each ob in turn:
24    !----------------------------------------------------------------------
25 
26    ! [2.1] Transfer surface obs:
27 
28    if (iv%info(synop)%nlocal > 0) then
29       do n = 1, iv%info(synop)%nlocal
30          call da_random_omb(iv % synop(n) % u % error, ob % synop(n) % u, &
31                            iv % synop(n) % u % qc, iv % synop(n) % u % inv)
32          call da_random_omb(iv % synop(n) % v % error, ob % synop(n) % v, &
33                            iv % synop(n) % v % qc, iv % synop(n) % v % inv)
34          call da_random_omb(iv % synop(n) % t % error, ob % synop(n) % t, &
35                            iv % synop(n) % t % qc, iv % synop(n) % t % inv )
36          call da_random_omb(iv % synop(n) % p % error, ob % synop(n) % p, &
37                            iv % synop(n) % p % qc, iv % synop(n) % p % inv)
38          call da_random_omb(iv % synop(n) % q % error, ob % synop(n) % q, &
39                            iv % synop(n) % q % qc, iv % synop(n) % q % inv)
40       end do
41    end if
42 
43    ! [2.2] Transfer metar obs:
44 
45    if (iv%info(metar)%nlocal > 0) then
46       do n = 1, iv%info(metar)%nlocal
47          call da_random_omb(iv % metar(n) % u % error, ob % metar(n) % u, &
48                            iv % metar(n) % u % qc, iv % metar(n) % u % inv)
49          call da_random_omb(iv % metar(n) % v % error, ob % metar(n) % v, &
50                            iv % metar(n) % v % qc, iv % metar(n) % v % inv)
51          call da_random_omb(iv % metar(n) % t % error, ob % metar(n) % t, &
52                            iv % metar(n) % t % qc, iv % metar(n) % t % inv)
53          call da_random_omb(iv % metar(n) % p % error, ob % metar(n) % p, &
54                            iv % metar(n) % p % qc, iv % metar(n) % p % inv)
55          call da_random_omb(iv % metar(n) % q % error, ob % metar(n) % q, &
56                            iv % metar(n) % q % qc, iv % metar(n) % q % inv)
57       end do
58    end if
59 
60    ! [2.3] Transfer ships obs:
61 
62    if (iv%info(ships)%nlocal > 0) then
63       do n = 1, iv%info(ships)%nlocal
64          call da_random_omb(iv % ships(n) % u % error, ob % ships(n) % u, &
65                            iv % ships(n) % u % qc, iv % ships(n) % u % inv)
66          call da_random_omb(iv % ships(n) % v % error, ob % ships(n) % v, &
67                            iv % ships(n) % v % qc, iv % ships(n) % v % inv)
68          call da_random_omb(iv % ships(n) % t % error, ob % ships(n) % t, &
69                            iv % ships(n) % t % qc, iv % ships(n) % t % inv)
70          call da_random_omb(iv % ships(n) % p % error, ob % ships(n) % p, &
71                            iv % ships(n) % p % qc, iv % ships(n) % p % inv)
72          call da_random_omb(iv % ships(n) % q % error, ob % ships(n) % q, &
73                            iv % ships(n) % q % qc, iv % ships(n) % q % inv)
74       end do
75    end if
76 
77    ! [2.4.1] Transfer Geo. AMVs Obs:
78 
79    if (iv%info(geoamv)%nlocal > 0) then
80       do n = 1, iv%info(geoamv)%nlocal 
81         do k = 1, iv%info(geoamv)%levels(n)
82          call da_random_omb(iv % geoamv(n) % u(k) % error, ob % geoamv(n) % u(k), &
83                            iv % geoamv(n) % u(k) % qc, iv % geoamv(n) % u(k) % inv)
84          call da_random_omb(iv % geoamv(n) % v(k) % error, ob % geoamv(n) % v(k), &
85                            iv % geoamv(n) % v(k) % qc, iv % geoamv(n) % v(k) % inv)
86         end do
87       end do 
88    end if 
89 
90    ! [2.4.2] Transfer Polar  AMVs Obs:
91 
92    if (iv%info(polaramv)%nlocal > 0) then
93       do n = 1, iv%info(polaramv)%nlocal
94         do k = 1, iv%info(polaramv)%levels(n)
95          call da_random_omb(iv % polaramv(n) % u(k) % error, ob % polaramv(n) % u(k), &
96                            iv % polaramv(n) % u(k) % qc, iv % polaramv(n) % u(k) % inv)
97          call da_random_omb(iv % polaramv(n) % v(k) % error, ob % polaramv(n) % v(k), &
98                            iv % polaramv(n) % v(k) % qc, iv % polaramv(n) % v(k) % inv)
99         end do
100       end do
101    end if
102 
103    ! [2.5] Transfer gpspw obs:
104 
105    if (iv%info(gpspw)%nlocal > 0) then
106       do n = 1, iv%info(gpspw)%nlocal
107          call da_random_omb(iv % gpspw(n) % tpw % error, ob % gpspw(n) % tpw, &
108                            iv % gpspw(n) % tpw % qc, iv % gpspw(n) % tpw % inv)
109       end do
110    end if
111 
112    ! [2.6] Transfer sonde obs:
113 
114    if (iv%info(sound)%nlocal > 0) then
115       do n = 1, iv%info(sound)%nlocal
116          do k = 1, iv%info(sound)%levels(n)
117             call da_random_omb(iv % sound(n) % u(k) % error, ob % sound(n) % u(k), &
118                               iv % sound(n) % u(k) % qc, iv % sound(n) % u(k) % inv)
119             call da_random_omb(iv % sound(n) % v(k) % error, ob % sound(n) % v(k), &
120                               iv % sound(n) % v(k) % qc, iv % sound(n) % v(k) % inv)
121             call da_random_omb(iv % sound(n) % t(k) % error, ob % sound(n) % t(k), &
122                               iv % sound(n) % t(k) % qc, iv % sound(n) % t(k) % inv)
123             call da_random_omb(iv % sound(n) % q(k) % error, ob % sound(n) % q(k), &
124                               iv % sound(n) % q(k) % qc, iv % sound(n) % q(k) % inv)
125          end do
126 
127          call da_random_omb(iv % sonde_sfc(n) % u % error, ob % sonde_sfc(n) % u, &
128                              iv % sonde_sfc(n) % u % qc, iv % sonde_sfc(n) % u % inv)
129          call da_random_omb(iv % sonde_sfc(n) % v % error, ob % sonde_sfc(n) % v, &
130                              iv % sonde_sfc(n) % v % qc, iv % sonde_sfc(n) % v % inv)
131          call da_random_omb(iv % sonde_sfc(n) % t % error, ob % sonde_sfc(n) % t, &
132                              iv % sonde_sfc(n) % t % qc, iv % sonde_sfc(n) % t % inv )
133          call da_random_omb(iv % sonde_sfc(n) % p % error, ob % sonde_sfc(n) % p, &
134                              iv % sonde_sfc(n) % p % qc, iv % sonde_sfc(n) % p % inv)
135          call da_random_omb(iv % sonde_sfc(n) % q % error, ob % sonde_sfc(n) % q, &
136                              iv % sonde_sfc(n) % q % qc, iv % sonde_sfc(n) % q % inv)
137       end do
138    end if
139 
140    ! [2.7] Transfer airep obs:
141 
142    if (iv%info(airep)%nlocal > 0) then
143       do n = 1, iv%info(airep)%nlocal
144          do k = 1, iv%info(airep)%levels(n)
145             call da_random_omb(iv % airep(n) % u(k) % error, ob % airep(n) % u(k), &
146                               iv % airep(n) % u(k) % qc, iv % airep(n) % u(k) % inv)
147             call da_random_omb(iv % airep(n) % v(k) % error, ob % airep(n) % v(k), &
148                               iv % airep(n) % v(k) % qc, iv % airep(n) % v(k) % inv)
149             call da_random_omb(iv % airep(n) % t(k) % error, ob % airep(n) % t(k), &
150                               iv % airep(n) % t(k) % qc, iv % airep(n) % t(k) % inv)
151          end do
152       end do
153    end if
154 
155    ! [2.8] Transfer pilot obs:
156 
157    if (iv%info(pilot)%nlocal > 0) then
158       do n = 1, iv%info(pilot)%nlocal
159          do k = 1, iv%info(pilot)%levels(n)
160             call da_random_omb(iv % pilot(n) % u(k) % error, ob % pilot(n) % u(k), &
161                               iv % pilot(n) % u(k) % qc, iv % pilot(n) % u(k) % inv)
162             call da_random_omb(iv % pilot(n) % v(k) % error, ob % pilot(n) % v(k), &
163                               iv % pilot(n) % v(k) % qc, iv % pilot(n) % v(k) % inv)
164          end do
165       end do
166    end if
167 
168    ! [2.9] Transfer SSM/I obs:SSMI:
169 
170    if (iv%info(ssmi_rv)%nlocal > 0) then
171       do n = 1, iv%info(ssmi_rv)%nlocal
172          call da_random_omb(iv % ssmi_rv(n) % speed % error, &
173                            ob % ssmi_rv(n) % speed, &
174                            iv % ssmi_rv(n) % speed % qc, &
175                            iv % ssmi_rv(n) % speed % inv)
176          call da_random_omb(iv % ssmi_rv(n) % tpw % error, &
177                            ob % ssmi_rv(n) % tpw, &
178                            iv % ssmi_rv(n) % tpw % qc, &
179                            iv % ssmi_rv(n) % tpw % inv)
180       end do
181    end if
182 
183    if (iv%info(ssmi_tb)%nlocal > 0) then
184       do n = 1, iv%info(ssmi_tb)%nlocal
185          call da_random_omb(iv % ssmi_tb(n) % tb19h % error, &
186                            ob % ssmi_tb(n) % tb19h, &
187                            iv % ssmi_tb(n) % tb19h % qc, &
188                            iv % ssmi_tb(n) % tb19h % inv)
189          call da_random_omb(iv % ssmi_tb(n) % tb19v % error, &
190                            ob % ssmi_tb(n) % tb19v, &
191                            iv % ssmi_tb(n) % tb19v % qc, &
192                            iv % ssmi_tb(n) % tb19v % inv)
193          call da_random_omb(iv % ssmi_tb(n) % tb22v % error, &
194                            ob % ssmi_tb(n) % tb22v, &
195                            iv % ssmi_tb(n) % tb22v % qc, &
196                            iv % ssmi_tb(n) % tb22v % inv)
197          call da_random_omb(iv % ssmi_tb(n) % tb37h % error, &
198                            ob % ssmi_tb(n) % tb37h, &
199                            iv % ssmi_tb(n) % tb37h % qc, &
200                            iv % ssmi_tb(n) % tb37h % inv)
201          call da_random_omb(iv % ssmi_tb(n) % tb37v % error, &
202                            ob % ssmi_tb(n) % tb37v, &
203                            iv % ssmi_tb(n) % tb37v % qc, &
204                            iv % ssmi_tb(n) % tb37v % inv)
205          call da_random_omb(iv % ssmi_tb(n) % tb85h % error, &
206                            ob % ssmi_tb(n) % tb85h, &
207                            iv % ssmi_tb(n) % tb85h % qc, &
208                            iv % ssmi_tb(n) % tb85h % inv)
209          call da_random_omb(iv % ssmi_tb(n) % tb85v % error, &
210                            ob % ssmi_tb(n) % tb85v, &
211                            iv % ssmi_tb(n) % tb85v % qc, &
212                            iv % ssmi_tb(n) % tb85v % inv)
213       end do
214    end if
215 
216    ! [2.10] Transfer satem obs:
217 
218    if (iv%info(satem)%nlocal > 0) then
219       do n = 1, iv%info(satem)%nlocal
220          do k = 1, iv%info(satem)%levels(n)
221             call da_random_omb(iv % satem(n) % thickness(k) % error, &
222                               ob % satem(n) % thickness(k), &
223                               iv % satem(n) % thickness(k) % qc, &
224                               iv % satem(n) % thickness(k) % inv)
225          end do
226       end do
227    end if
228    
229    ! [2.11] Transfer ssmt1 obs:
230 
231    if (iv%info(ssmt1)%nlocal > 0) then
232       do n = 1, iv%info(ssmt1)%nlocal
233          do k = 1, iv%info(ssmt1)%levels(n)
234             call da_random_omb(iv % ssmt1(n) % t(k) % error, &
235                               ob % ssmt1(n) % t(k), &
236                               iv % ssmt1(n) % t(k) % qc, &
237                               iv % ssmt1(n) % t(k) % inv)
238          end do
239       end do
240    end if
241 
242    ! [2.12] Transfer ssmt2 obs:
243 
244    if (iv%info(ssmt2)%nlocal > 0) then
245       do n = 1, iv%info(ssmt2)%nlocal
246          do k = 1, iv%info(ssmt2)%levels(n)
247             call da_random_omb(iv % ssmt2(n) % rh(k) % error, &
248                               ob % ssmt2(n) % rh(k), &
249                               iv % ssmt2(n) % rh(k) % qc, &
250                               iv % ssmt2(n) % rh(k) % inv)
251          end do
252       end do
253    end if
254    
255    ! [2.13] Transfer scatterometer obs:
256 
257    if (iv%info(qscat)%nlocal > 0) then
258       do n = 1, iv%info(qscat)%nlocal
259          call da_random_omb(iv % qscat(n) % u % error, ob % qscat(n) % u, &
260                            iv % qscat(n) % u % qc, iv % qscat(n) % u % inv)
261          call da_random_omb(iv % qscat(n) % v % error, ob % qscat(n) % v, &
262                            iv % qscat(n) % v % qc, iv % qscat(n) % v % inv)
263       end do
264    end if
265 
266    ! [2.14] Transfer buoy obs:
267 
268    if (iv%info(buoy)%nlocal > 0) then
269       do n = 1, iv%info(buoy)%nlocal
270          call da_random_omb(iv % buoy(n) % u % error, ob % buoy(n) % u, &
271                            iv % buoy(n) % u % qc, iv % buoy(n) % u % inv)
272          call da_random_omb(iv % buoy(n) % v % error, ob % buoy(n) % v, &
273                            iv % buoy(n) % v % qc, iv % buoy(n) % v % inv)
274          call da_random_omb(iv % buoy(n) % t % error, ob % buoy(n) % t, &
275                            iv % buoy(n) % t % qc, iv % buoy(n) % t % inv)
276          call da_random_omb(iv % buoy(n) % p % error, ob % buoy(n) % p, &
277                            iv % buoy(n) % p % qc, iv % buoy(n) % p % inv)
278          call da_random_omb(iv % buoy(n) % q % error, ob % buoy(n) % q, &
279                            iv % buoy(n) % q % qc, iv % buoy(n) % q % inv)
280       end do
281    end if
282 
283    ! [2.15] Transfer profiler obs:
284 
285    if (iv%info(profiler)%nlocal > 0) then
286       do n = 1, iv%info(profiler)%nlocal
287          do k = 1, iv%info(profiler)%levels(n)
288             call da_random_omb(iv % profiler(n) % u(k) % error, &
289                ob % profiler(n) % u(k), &
290                iv % profiler(n) % u(k) % qc, iv % profiler(n) % u(k) % inv)
291             call da_random_omb(iv % profiler(n) % v(k) % error, &
292                ob % profiler(n) % v(k), &
293                iv % profiler(n) % v(k) % qc, iv % profiler(n) % v(k) % inv)
294          end do
295       end do
296    end if
297 
298    ! [2.16] Transfer TC bogus obs:
299 
300    if (iv%info(bogus)%nlocal > 0) then
301       do n = 1, iv%info(bogus)%nlocal
302          do k = 1, iv%info(bogus)%levels(n)
303             call da_random_omb(iv % bogus(n) % u(k) % error, &
304                ob % bogus(n) % u(k), &
305                iv % bogus(n) % u(k) % qc, iv % bogus(n) % u(k) % inv)
306             call da_random_omb(iv % bogus(n) % v(k) % error, &
307                ob % bogus(n) % v(k), &
308                iv % bogus(n) % v(k) % qc, iv % bogus(n) % v(k) % inv)
309             call da_random_omb(iv % bogus(n) % t(k) % error, &
310                ob % bogus(n) % t(k), &
311                iv % bogus(n) % t(k) % qc, iv % bogus(n) % t(k) % inv)
312             call da_random_omb(iv % bogus(n) % q(k) % error, &
313               ob % bogus(n) % q(k), &
314               iv % bogus(n) % q(k) % qc, iv % bogus(n) % q(k) % inv)
315          end do
316 
317          call da_random_omb(iv % bogus(n) % slp % error, ob % bogus(n) % slp, &
318                             iv % bogus(n) % slp % qc, iv % bogus(n) % slp % inv)
319       end do
320    end if
321 
322    ! Transfer AIRS retrievals:
323 
324    if (iv%info(airsr)%nlocal > 0) then
325       do n = 1, iv%info(airsr)%nlocal
326          do k = 1, iv%info(airsr)%levels(n)
327             call da_random_omb(iv % airsr(n) % t(k) % error, &
328                ob % airsr(n) % t(k), &
329                iv % airsr(n) % t(k) % qc, iv % airsr(n) % t(k) % inv)
330             call da_random_omb(iv % airsr(n) % q(k) % error, &
331                ob % airsr(n) % q(k), &
332                iv % airsr(n) % q(k) % qc, iv % airsr(n) % q(k) % inv)
333          end do
334       end do
335    end if
336 
337    if (trace_use) call da_trace_exit("da_random_omb_all")
338 
339 end subroutine da_random_omb_all
340 
341