da_setup_obs_structures_bufr.inc
References to this file elsewhere.
1 subroutine da_setup_obs_structures_bufr(xp, ob, iv)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Define, allocate and read observation structure.
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 type (xpose_type), intent(in) :: xp ! Domain decomposition vars.
10 type (y_type), intent(out) :: ob ! Observation structure.
11 type (ob_type), intent(out) :: iv ! O-B structure.
12
13 character(len=120) :: filename
14 integer :: n
15
16 if (trace_use) call da_trace_entry("da_setup_obs_structures_bufr")
17
18 !--------------------------------------------------------------------------
19 ! [0.0] Initialize the counters.
20 !--------------------------------------------------------------------------
21
22 iv%total_obs = 0
23 iv%num_sound = 0
24 iv%num_synop = 0
25 iv%num_pilot = 0
26 iv%num_geoamv = 0
27 iv%num_polaramv = 0
28 iv%num_satem = 0
29 iv%num_airep = 0
30 iv%num_metar = 0
31 iv%num_ships = 0
32 iv%num_gpspw = 0
33 iv%num_gpsref = 0
34 iv%num_ssmi_retrieval = 0
35 iv%num_ssmi_tb = 0
36 iv%num_ssmt1 = 0
37 iv%num_ssmt2 = 0
38 iv%num_pseudo = 0
39 iv%num_qscat = 0
40 iv%num_profiler = 0
41 iv%num_buoy = 0
42 iv%num_radar = 0
43 iv%num_bogus = 0
44 iv%num_airsr = 0
45
46 do n=0, max_fgat_time
47 iv%ob_numb(n)%total = 0
48 iv%ob_numb(n)%sound = 0
49 iv%ob_numb(n)%synop = 0
50 iv%ob_numb(n)%pilot = 0
51 iv%ob_numb(n)%geoamv = 0
52 iv%ob_numb(n)%polaramv = 0
53 iv%ob_numb(n)%satem = 0
54 iv%ob_numb(n)%airep = 0
55 iv%ob_numb(n)%metar = 0
56 iv%ob_numb(n)%ships = 0
57 iv%ob_numb(n)%gpspw = 0
58 iv%ob_numb(n)%gpsref = 0
59 iv%ob_numb(n)%ssmi_retrieval = 0
60 iv%ob_numb(n)%ssmi_tb = 0
61 iv%ob_numb(n)%ssmt1 = 0
62 iv%ob_numb(n)%ssmt2 = 0
63 iv%ob_numb(n)%pseudo = 0
64 iv%ob_numb(n)%qscat = 0
65 iv%ob_numb(n)%profiler = 0
66 iv%ob_numb(n)%buoy = 0
67 iv%ob_numb(n)%radar = 0
68 iv%ob_numb(n)%bogus = 0
69 iv%ob_numb(n)%airsr = 0
70 end do
71
72 !--------------------------------------------------------------------------
73 ! [1.0] Scan BUFR observation header and get idea of number of obs:
74 !--------------------------------------------------------------------------
75
76 if (num_fgat_time > 1) then
77 filename = ' '
78
79 do n=1, num_fgat_time
80 iv%current_ob_time = n
81
82 write(filename(1:10), fmt='(a, i2.2,a)') 'ob', n,'.bufr'
83
84 ! scan PREPBUFR OBSERVATION FILE
85 call da_scan_bufr_obs (iv, xp, filename)
86
87
88 ! if (Use_RadarObs) then
89 ! ! scan Radar OBSERVATION FILE
90 ! write(filename(1:10), fmt='(a, i2.2,a)') 'radar', n,'.dat'
91 ! call da_scan_bufr_radar(iv, xp, filename)
92 ! end if
93 end do
94 else
95 iv%current_ob_time = 1
96 filename="ob.bufr"
97 call da_scan_bufr_obs(iv, xp, filename)
98
99 ! scan MAin BODY OF Radar OBSERVATION FILE
100 ! if (Use_RadarObs) &
101 ! call da_scan_bufr_radar(iv, xp,'radar.dat')
102 end if
103
104 !-----------------------------------------------------------------
105 ! Safety guard.
106 !-----------------------------------------------------------------
107
108 if (iv%num_sound > max_sound_input) &
109 iv%num_sound = max_sound_input
110 if (iv%num_synop > max_synop_input) &
111 iv%num_synop = max_synop_input
112 if (iv%num_pilot > max_pilot_input) &
113 iv%num_pilot = max_pilot_input
114 if (iv%num_geoamv > max_geoamv_input) &
115 iv%num_geoamv = max_geoamv_input
116 if (iv%num_polaramv > max_polaramv_input) &
117 iv%num_polaramv = max_polaramv_input
118 if (iv%num_satem > max_satem_input) &
119 iv%num_satem = max_satem_input
120 if (iv%num_airep > max_airep_input) &
121 iv%num_airep = max_airep_input
122 if (iv%num_metar > max_metar_input) &
123 iv%num_metar = max_metar_input
124 if (iv%num_ships > max_ships_input) &
125 iv%num_ships = max_ships_input
126 if (iv%num_gpspw > max_gpspw_input) &
127 iv%num_gpspw = max_gpspw_input
128 if (iv%num_gpsref > max_gpsref_input) &
129 iv%num_gpsref = max_gpsref_input
130 if (iv%num_ssmi_retrieval > max_ssmi_ret_input) &
131 iv%num_ssmi_retrieval = max_ssmi_ret_input
132 if (iv%num_ssmi_tb > max_ssmi_tb_input) &
133 iv%num_ssmi_tb = max_ssmi_tb_input
134 if (iv%num_ssmt1 > max_ssmt1_input) &
135 iv%num_ssmt1 = max_ssmt1_input
136 if (iv%num_ssmt2 > max_ssmt2_input) &
137 iv%num_ssmt2 = max_ssmt2_input
138 if (iv%num_profiler > max_profiler_input) &
139 iv%num_profiler = max_profiler_input
140 if (iv%num_buoy > max_buoy_input) &
141 iv%num_buoy = max_buoy_input
142 if (iv%num_radar > max_radar_input) &
143 iv%num_radar = max_radar_input
144 if (iv%num_bogus > max_bogus_input) &
145 iv%num_bogus = max_bogus_input
146 if (iv%num_airsr > max_airsret_input) &
147 iv%num_airsr = max_airsret_input
148
149 !-------------------------------------------------------------------------
150 ! Allocate the ob based on inputed number of obs:
151 !--------------------------------------------------------------------------
152
153 call da_allocate_observations (iv)
154
155 iv%total_obs = 0
156 iv%num_sound = 0
157 iv%num_synop = 0
158 iv%num_pilot = 0
159 iv%num_geoamv = 0
160 iv%num_polaramv = 0
161 iv%num_satem = 0
162 iv%num_airep = 0
163 iv%num_metar = 0
164 iv%num_ships = 0
165 iv%num_gpspw = 0
166 iv%num_gpsref = 0
167 iv%num_ssmi_retrieval = 0
168 iv%num_ssmi_tb = 0
169 iv%num_ssmt1 = 0
170 iv%num_ssmt2 = 0
171 iv%num_pseudo = 0
172 iv%num_qscat = 0
173 iv%num_profiler = 0
174 iv%num_buoy = 0
175 iv%num_radar = 0
176 iv%num_bogus = 0
177 iv%num_airsr = 0
178
179 if (num_fgat_time > 1) then
180 do n=1, num_fgat_time
181 iv%current_ob_time = n
182
183 write(filename(1:10), fmt='(a, i2.2)') 'ob.', n
184
185 ! Read PREPBUFR OBSERVATION FILE
186 call da_read_bufr_obs (iv, xp, filename)
187
188 ! if (Use_RadarObs) then
189 ! ! Read Radar OBSERVATION FILE
190 ! write(filename(1:10), fmt='(a, i2.2)') 'radarob.', n
191 ! call da_read_bufr_radar(iv, xp, filename)
192 ! end if
193 end do
194 else
195
196 iv%current_ob_time = 1
197
198 filename="ob.bufr"
199 call da_read_bufr_obs(iv, xp,filename)
200
201 ! if (Use_RadarObs) then
202 ! !Read Radar OBSERVATION FILE
203 ! call da_read_bufr_radar(iv, xp)
204 ! end if
205 end if
206
207 !--------------------------------------------------------------------------
208 ! [3.0] Calculate innovation vector (O-B) and create (smaller) ob structure:
209 !--------------------------------------------------------------------------
210
211 call da_fill_obs_structures(xp, iv, ob)
212
213 iv%current_ob_time = 1
214
215 if (trace_use) call da_trace_exit("da_setup_obs_structures_bufr")
216
217 end subroutine da_setup_obs_structures_bufr
218
219