da_get_innov_vector.inc
References to this file elsewhere.
1 subroutine da_get_innov_vector (it, ob, iv, grid, config_flags)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: it
10 type(y_type), intent(inout) :: ob ! Observations.
11 type(ob_type), intent(inout) :: iv ! Innovation vector(O-B).
12 type(domain) , intent(inout) :: grid
13 type(grid_config_rec_type), intent(inout) :: config_flags
14
15 type(xbx_type) :: xbx ! Header & non-gridded vars.
16
17 character(len=120) :: filename
18
19 integer :: n
20
21 if (trace_use) call da_trace_entry("da_get_innov_vector")
22
23 call da_message((/"Calculate innovation vector(iv)"/))
24
25 iv%ptop = grid%xb%ptop
26
27 filename = ' '
28
29 do n=1, num_fgat_time
30 iv%current_ob_time = n
31
32 if (num_fgat_time > 1) then
33 write(unit=filename(1:10), fmt='(a, i2.2)') 'fg', n
34 call da_med_initialdata_input( grid , config_flags, &
35 filename)
36 call da_setup_firstguess( xbx, grid)
37 end if
38
39 ! Radiosonde:
40
41 call da_get_innov_vector_sound( it, grid%xb, grid%xp, ob, iv)
42 call da_get_innov_vector_sonde_sfc( it, grid%xb, grid%xp, ob, iv)
43
44 ! Surface
45
46 call da_get_innov_vector_synop( it, grid%xb, grid%xp, ob, iv)
47
48 ! Geostationary Satellite AMVs:
49
50 call da_get_innov_vector_geoamv( it, grid%xb, grid%xp, ob, iv)
51
52 ! Polar orbitting Satellite AMVs:
53
54 call da_get_innov_vector_polaramv( it, grid%xb, grid%xp, ob, iv)
55
56 ! Aireps:
57
58 call da_get_innov_vector_airep( it, grid%xb, grid%xp, ob, iv)
59
60 ! Pilot:
61
62 call da_get_innov_vector_pilot( it, grid%xb, grid%xp, ob, iv)
63
64 ! TC bogus
65
66 call da_get_innov_vector_bogus( it, grid%xb, grid%xp, ob, iv)
67
68 ! Metar:
69
70 call da_get_innov_vector_metar( it, grid%xb, grid%xp, ob, iv)
71
72 ! Ships:
73
74 call da_get_innov_vector_ships( it, grid%xb, grid%xp, ob, iv)
75
76 ! GPSPW:
77
78 call da_get_innov_vector_gpspw( it, grid%xb, grid%xp, ob, iv)
79
80 ! GPSRF:
81
82 call da_get_innov_vector_gpsref( it, grid%xb, grid%xp, ob, iv)
83
84 ! SSMI:
85
86 call da_get_innov_vector_ssmi( it, grid%xb, ob, iv)
87
88 ! SSMT1:
89
90 call da_get_innov_vector_ssmt1( it, grid%xb, grid%xp, ob, iv)
91
92 ! SSMT2:
93
94 call da_get_innov_vector_ssmt2( it, grid%xb, grid%xp, ob, iv)
95
96 ! SATEM:
97
98 call da_get_innov_vector_satem( it, grid%xb, grid%xp, ob, iv)
99
100 ! Radar obs:
101
102 call da_get_innov_vector_radar( it, grid%xb, grid%xp, ob, iv)
103
104 ! Scatterometer:
105
106 call da_get_innov_vector_qscat( it, grid%xb, grid%xp, ob, iv)
107
108 ! Profiler:
109
110 call da_get_innov_vector_profiler( it, grid%xb, grid%xp, ob, iv)
111
112 ! Buoy:
113
114 call da_get_innov_vector_buoy( it, grid%xb, grid%xp, ob, iv)
115
116 ! Radiance:
117
118 if (rtm_option == rtm_option_rttov) then
119 call da_get_innov_vector_rttov( it, grid%xb, grid%xp, ob, iv )
120 elseif (rtm_option == rtm_option_crtm) then
121 if (use_crtm_kmatrix_fast) then
122 call da_get_innov_vector_crtmk( it, grid%xb, grid%xp, ob, iv )
123 else
124 call da_get_innov_vector_crtm( it, grid%xb, grid%xp, ob, iv )
125 end if
126 else
127 call da_warning(__FILE__,__LINE__,(/"Unknown Radiative Transfer Model"/))
128 endif
129
130 ! Pseudo obs:
131
132 call da_get_innov_vector_pseudo( grid%xb, grid%xp, ob, iv)
133
134 ! AIRS retrievals
135
136 call da_get_innov_vector_airsr( it, grid%xb, grid%xp, ob, iv)
137 end do
138
139 iv%current_ob_time = 1
140
141 !-----------------------------------------------------------------------
142 ! [2] Having calculated the real O-Bs, optionally overwrite with scaled,
143 ! random values:
144 !-----------------------------------------------------------------------
145
146 if (omb_set_rand) call da_random_omb_all( iv, ob)
147
148 !------------------------------------------------------------------------
149 ! [3] Optionally rescale observation errors:
150 !------------------------------------------------------------------------
151
152 if (use_obs_errfac) call da_use_obs_errfac( iv)
153
154 !------------------------------------------------------------------------
155 ! [4] Optionally add Gaussian noise to O, O-B:
156 !------------------------------------------------------------------------
157
158 if (omb_add_noise) then
159 call da_add_noise_to_ob( iv, ob)
160 !#ifdef DM_PARALLEL
161 ! if ((num_procs > 1) .and.(.not. use_radiance)) call da_write_noise_to_ob(iv)
162 ! if ((.not. use_radiance)) call da_write_noise_to_ob(iv)
163 call da_write_noise_to_ob(iv)
164 !#endif
165 end if
166
167 !----------------------------------------------
168 ! [5] write out radiance iv in ascii format
169 !-----------------------------------------------
170 if (write_iv_rad_ascii) then
171 write(unit=stdout,fmt='(A)') 'Writing radiance iv ascii'
172 call da_write_iv_rad_ascii(grid%xp,ob,iv)
173 end if
174
175 !----------------------------------------------------------
176 ! [6] write out filtered radiance obs in binary format
177 !----------------------------------------------------------
178
179 if (write_filtered_rad) then
180 write(unit=stdout,fmt='(A)') 'Writing filtered radiance'
181 call da_write_filtered_rad(ob,iv)
182 end if
183
184 if (num_fgat_time > 1) then
185 call da_med_initialdata_input( grid , config_flags, 'fg01')
186 call da_setup_firstguess( xbx, grid)
187 end if
188
189 if (trace_use) call da_trace_exit("da_get_innov_vector")
190
191 end subroutine da_get_innov_vector
192
193