da_setup_obs_structures_ascii.inc
References to this file elsewhere.
1 subroutine da_setup_obs_structures_ascii( xp, ob, iv, xb )
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Define, allocate and read of 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 type (xb_type), intent(inout) :: xb ! First guess structure
13
14 character(len=120) :: filename
15 integer :: n
16 integer :: i, j, k
17
18 if (trace_use) call da_trace_entry("da_setup_obs_structures_ascii")
19
20 !--------------------------------------------------------------------------
21 ! [0.0] Initialize the counters.
22 !--------------------------------------------------------------------------
23
24 iv%total_obs = 0
25 iv%num_sound = 0
26 iv%num_synop = 0
27 iv%num_pilot = 0
28 iv%num_geoamv = 0
29 iv%num_polaramv = 0
30 iv%num_satem = 0
31 iv%num_airep = 0
32 iv%num_metar = 0
33 iv%num_ships = 0
34 iv%num_gpspw = 0
35 iv%num_gpsref = 0
36 iv%num_ssmi_retrieval = 0
37 iv%num_ssmi_tb = 0
38 iv%num_ssmt1 = 0
39 iv%num_ssmt2 = 0
40 iv%num_pseudo = 0
41 iv%num_qscat = 0
42 iv%num_profiler = 0
43 iv%num_buoy = 0
44 iv%num_radar = 0
45 iv%num_bogus = 0
46 iv%num_airsr = 0
47
48 do n=0, max_fgat_time
49 iv%ob_numb(n)%total = 0
50 iv%ob_numb(n)%sound = 0
51 iv%ob_numb(n)%synop = 0
52 iv%ob_numb(n)%pilot = 0
53 iv%ob_numb(n)%geoamv = 0
54 iv%ob_numb(n)%polaramv = 0
55 iv%ob_numb(n)%satem = 0
56 iv%ob_numb(n)%airep = 0
57 iv%ob_numb(n)%metar = 0
58 iv%ob_numb(n)%ships = 0
59 iv%ob_numb(n)%gpspw = 0
60 iv%ob_numb(n)%gpsref = 0
61 iv%ob_numb(n)%ssmi_retrieval = 0
62 iv%ob_numb(n)%ssmi_tb = 0
63 iv%ob_numb(n)%ssmt1 = 0
64 iv%ob_numb(n)%ssmt2 = 0
65 iv%ob_numb(n)%pseudo = 0
66 iv%ob_numb(n)%qscat = 0
67 iv%ob_numb(n)%profiler = 0
68 iv%ob_numb(n)%buoy = 0
69 iv%ob_numb(n)%radar = 0
70 iv%ob_numb(n)%bogus = 0
71 iv%ob_numb(n)%airsr = 0
72 end do
73
74 !--------------------------------------------------------------------------
75 ! [1.0] Scan GTS observation header and get idea of number of obs:
76 !--------------------------------------------------------------------------
77
78 if (num_fgat_time > 1) then
79 filename = ' '
80
81 do n=1, num_fgat_time
82 iv%current_ob_time = n
83
84 write(filename(1:10), fmt='(a, i2.2,a)') 'ob', n,'.ascii'
85
86 ! scan main body of gts observation file
87 call da_scan_obs (iv, xp, filename)
88
89 if (Use_SsmiRetrievalObs .or. Use_SsmiTbObs) then
90 ! scan SSMI observation file
91 write(filename(1:10), fmt='(a, i2.2,a)') 'ob', n,'.ssmi'
92 call da_scan_ssmi (iv, xp, filename)
93 end if
94
95 if (Use_RadarObs) then
96 ! scan radar observation file
97 write(filename(1:10), fmt='(a, i2.2,a)') 'ob', n,'.radar'
98 call da_scan_radar(iv, xp, filename)
99 end if
100 end do
101 else
102 iv%current_ob_time = 1
103
104 call da_scan_obs(iv, xp,'ob01.ascii')
105
106 !-----------------------------------------------------------------------
107 ! read header of ssmi observation file
108 !-----------------------------------------------------------------------
109 if (Use_SsmiRetrievalObs .or. Use_SsmiTbObs) then
110 call da_scan_ssmi(iv, xp,'ob01.ssmi')
111 end if
112
113 ! scan main body of radar observation file
114 if (Use_RadarObs) then
115 call da_scan_radar(iv, xp,'ob01.radar')
116 end if
117 end if
118
119 !--------------------------------------------------------------------
120 ! Safety guard.
121 !--------------------------------------------------------------------
122
123 if (iv%num_sound > max_sound_input) &
124 iv%num_sound = max_sound_input
125
126 if (iv%num_synop > max_synop_input) &
127 iv%num_synop = max_synop_input
128 if (iv%num_pilot > max_pilot_input) &
129 iv%num_pilot = max_pilot_input
130 if (iv%num_geoamv > max_geoamv_input) &
131 iv%num_geoamv = max_geoamv_input
132 if (iv%num_polaramv > max_polaramv_input) &
133 iv%num_polaramv = max_polaramv_input
134 if (iv%num_satem > max_satem_input) &
135 iv%num_satem = max_satem_input
136 if (iv%num_airep > max_airep_input) &
137 iv%num_airep = max_airep_input
138 if (iv%num_metar > max_metar_input) &
139 iv%num_metar = max_metar_input
140 if (iv%num_ships > max_ships_input) &
141 iv%num_ships = max_ships_input
142 if (iv%num_gpspw > max_gpspw_input) &
143 iv%num_gpspw = max_gpspw_input
144 if (iv%num_gpsref > max_gpsref_input) &
145 iv%num_gpsref = max_gpsref_input
146 if (iv%num_ssmi_retrieval > max_ssmi_ret_input) &
147 iv%num_ssmi_retrieval = max_ssmi_ret_input
148 if (iv%num_ssmi_tb > max_ssmi_tb_input) &
149 iv%num_ssmi_tb = max_ssmi_tb_input
150 if (iv%num_ssmt1 > max_ssmt1_input) &
151 iv%num_ssmt1 = max_ssmt1_input
152 if (iv%num_ssmt2 > max_ssmt2_input) &
153 iv%num_ssmt2 = max_ssmt2_input
154 if (iv%num_profiler > max_profiler_input) &
155 iv%num_profiler = max_profiler_input
156 if (iv%num_buoy > max_buoy_input) &
157 iv%num_buoy = max_buoy_input
158 if (iv%num_radar > max_radar_input) &
159 iv%num_radar = max_radar_input
160 if (iv%num_bogus > max_bogus_input) &
161 iv%num_bogus = max_bogus_input
162 if (iv%num_airsr > max_airsret_input) &
163 iv%num_airsr = max_airsret_input
164
165
166 !--------------------------------------------------------------------------
167 ! Allocate the ob based on inputed number of obs:
168 !--------------------------------------------------------------------------
169
170 call da_allocate_observations (iv)
171
172 iv%total_obs = 0
173 iv%num_sound = 0
174 iv%num_synop = 0
175 iv%num_pilot = 0
176 iv%num_geoamv = 0
177 iv%num_polaramv = 0
178 iv%num_satem = 0
179 iv%num_airep = 0
180 iv%num_metar = 0
181 iv%num_ships = 0
182 iv%num_gpspw = 0
183 iv%num_gpsref = 0
184 iv%num_ssmi_retrieval = 0
185 iv%num_ssmi_tb = 0
186 iv%num_ssmt1 = 0
187 iv%num_ssmt2 = 0
188 iv%num_pseudo = 0
189 iv%num_qscat = 0
190 iv%num_profiler = 0
191 iv%num_buoy = 0
192 iv%num_radar = 0
193 iv%num_bogus = 0
194 iv%num_airsr = 0
195
196 iv%num_sound_glo=0
197 iv%num_synop_glo=0
198 iv%num_pilot_glo=0
199 iv%num_geoamv_glo=0
200 iv%num_polaramv_glo=0
201 iv%num_satem_glo=0
202 iv%num_airep_glo=0
203 iv%num_metar_glo=0
204 iv%num_ships_glo=0
205 iv%num_gpspw_glo=0
206 iv%num_gpsref_glo=0
207 iv%num_ssmi_retrieval_glo=0
208 iv%num_ssmi_tb_glo=0
209 iv%num_ssmt1_glo=0
210 iv%num_ssmt2_glo=0
211 iv%num_pseudo_glo=0
212 iv%num_qscat_glo=0
213 iv%num_profiler_glo=0
214 iv%num_buoy_glo=0
215 iv%num_Radar_glo=0
216 iv%num_bogus_glo=0
217 iv%num_airsr_glo=0
218
219 if (num_fgat_time > 1) then
220 do n=1, num_fgat_time
221 iv%current_ob_time = n
222
223 write(filename(1:10), fmt='(a, i2.2,a)') 'ob', n,'.ascii'
224
225 ! Read gts observation file
226 call da_read_obs (iv, xp, filename)
227
228 if (Use_SsmiRetrievalObs .or. Use_SsmiTbObs) then
229 ! read ssmi observation file
230 write(filename(1:10), fmt='(a, i2.2)') 'ssmi', n,'.dat'
231 call da_read_ssmi (iv, xp, filename)
232 end if
233
234 if (Use_RadarObs) then
235 ! read radar observation file
236 write(filename(1:11), fmt='(a, i2.2)') 'radar', n,'.dat'
237 call da_read_radar(iv, xp, filename)
238 end if
239 end do
240 else
241 iv%current_ob_time = 1
242
243 call da_read_obs(iv, xp, 'ob01.ascii')
244
245 if (Use_SsmiRetrievalObs .or. Use_SsmiTbObs) then
246 ! read ssmi observation file
247 call da_read_ssmi (iv, xp,'ob01.ssmi')
248 end if
249
250 if (Use_RadarObs) then
251 ! read radar observation file
252 call da_read_radar(iv, xp,'ob01.radar')
253 end if
254 end if
255
256 ! Calculate DT for RF DA
257
258 if (use_radarobs .and. use_radar_rf) then
259 if (.not. DT_cloud_model) then
260 do j = xp%jts, xp%jte
261 do i = xp%its, xp%ite
262 do k = xp%kts, xp%kte
263 xb%delt(i,j,k) = 0.0
264 end do
265 end do
266 end do
267
268 do n = 1, iv % num_Radar
269 do i=int(iv%Radar(n)%loc%i), int(iv%Radar(n)%loc%i)+1
270 do j=int(iv%Radar(n)%loc%j), int(iv%Radar(n)%loc%j)+1
271 do k=xp%kts, xp%kte
272 xb%delt(i,j,k) = 1800.0
273 xb%qrn(i,j,k) = amax1(5.E-5, xb%qrn(i,j,k))
274 xb%qcw(i,j,k) = amax1(5.E-12, xb%qcw(i,j,k))
275 end do
276 ! do k=xp%kts, xp%kte
277 ! v_h(k)=xb%h(i,j ,k)
278 ! end do
279 ! do k = 1, iv % Radar(n) % info % levels
280 ! call zk(iv%Radar(n)%height(k), v_h, xp, zkk)
281 ! xb%delt(i,j,int(zkk))=1800.
282 ! xb%delt(i,j,int(zkk)+1)=1800.
283 ! end do
284 end do
285 end do
286 end do
287 end if
288 end if
289
290 !--------------------------------------------------------------------------
291 ! [3.0] Calculate innovation vector (O-B) and create (smaller) ob structure:
292 !--------------------------------------------------------------------------
293
294 call da_fill_obs_structures(xp, iv, ob)
295
296 iv%current_ob_time = 1
297
298 if (trace_use) call da_trace_exit("da_setup_obs_structures_ascii")
299
300 end subroutine da_setup_obs_structures_ascii
301
302