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