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 #ifdef CRTM
122 !if (use_crtm_kmatrix_fast) then
123 ! call da_get_innov_vector_crtmk( it, grid%xb, grid%xp, ob, iv )
124 !else
125 call da_get_innov_vector_crtm( it, grid%xb, grid%xp, ob, iv )
126 !end if
127 #endif
128 else
129 call da_warning(__FILE__,__LINE__,(/"Unknown Radiative Transfer Model"/))
130 endif
131
132 ! Pseudo obs:
133
134 call da_get_innov_vector_pseudo( grid%xb, grid%xp, ob, iv)
135
136 ! AIRS retrievals
137
138 call da_get_innov_vector_airsr( it, grid%xb, grid%xp, ob, iv)
139 end do
140
141 iv%current_ob_time = 1
142
143 !-----------------------------------------------------------------------
144 ! [2] Having calculated the real O-Bs, optionally overwrite with scaled,
145 ! random values:
146 !-----------------------------------------------------------------------
147
148 if (omb_set_rand) call da_random_omb_all( iv, ob)
149
150 !------------------------------------------------------------------------
151 ! [3] Optionally rescale observation errors:
152 !------------------------------------------------------------------------
153
154 if (use_obs_errfac) call da_use_obs_errfac( iv)
155
156 !------------------------------------------------------------------------
157 ! [4] Optionally add Gaussian noise to O, O-B:
158 !------------------------------------------------------------------------
159
160 if (omb_add_noise) then
161 call da_add_noise_to_ob( iv, ob)
162 !#ifdef DM_PARALLEL
163 ! if ((num_procs > 1) .and.(.not. use_rad)) call da_write_noise_to_ob(iv)
164 ! if ((.not. use_rad)) call da_write_noise_to_ob(iv)
165 call da_write_noise_to_ob(iv)
166 !#endif
167 end if
168
169 !----------------------------------------------
170 ! [5] write out radiance iv in ascii format
171 !-----------------------------------------------
172 if (write_iv_rad_ascii) then
173 write(unit=stdout,fmt='(A)') 'Writing radiance iv ascii'
174 call da_write_iv_rad_ascii(grid%xp,ob,iv)
175 end if
176
177 !----------------------------------------------------------
178 ! [6] write out filtered radiance obs in binary format
179 !----------------------------------------------------------
180
181 if (write_filtered_rad) then
182 write(unit=stdout,fmt='(A)') 'Writing filtered radiance'
183 call da_write_filtered_rad(ob,iv)
184 end if
185
186 if (num_fgat_time > 1) then
187 call da_med_initialdata_input( grid , config_flags, 'fg01')
188 call da_setup_firstguess( xbx, grid)
189 end if
190
191 if (trace_use) call da_trace_exit("da_get_innov_vector")
192
193 end subroutine da_get_innov_vector
194
195