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(iv_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
30 do n=1, num_fgat_time
31 iv%time = n
32 iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1
33 iv%info(:)%n2 = iv%info(:)%plocal(iv%time)
34
35 if (num_fgat_time > 1) then
36 write(unit=filename(1:10), fmt='(a, i2.2)') 'fg', n
37 call da_med_initialdata_input (grid , config_flags, filename)
38 call da_setup_firstguess (xbx, grid)
39 end if
40
41 ! Radiosonde:
42 if (iv%info(sound)%nlocal > 0) then
43 call da_get_innov_vector_sound (it, grid, ob, iv)
44 call da_get_innov_vector_sonde_sfc (it, grid, ob, iv)
45 end if
46
47 if (iv%info(synop)%nlocal > 0) call da_get_innov_vector_synop (it, grid, ob, iv)
48 if (iv%info(geoamv)%nlocal > 0) call da_get_innov_vector_geoamv (it, grid, ob, iv)
49 if (iv%info(polaramv)%nlocal > 0) call da_get_innov_vector_polaramv (it, grid, ob, iv)
50 if (iv%info(airep)%nlocal > 0) call da_get_innov_vector_airep (it, grid, ob, iv)
51 if (iv%info(pilot)%nlocal > 0) call da_get_innov_vector_pilot (it, grid, ob, iv)
52 if (iv%info(bogus)%nlocal > 0) call da_get_innov_vector_bogus (it, grid, ob, iv)
53 if (iv%info(metar)%nlocal > 0) call da_get_innov_vector_metar (it, grid, ob, iv)
54 if (iv%info(ships)%nlocal > 0) call da_get_innov_vector_ships (it, grid, ob, iv)
55 if (iv%info(gpspw)%nlocal > 0) call da_get_innov_vector_gpspw (it, grid, ob, iv)
56 if (iv%info(gpsref)%nlocal > 0) call da_get_innov_vector_gpsref (it, grid, ob, iv)
57 if (iv%info(ssmi_tb)%nlocal > 0) call da_get_innov_vector_ssmi_tb (it, grid, ob, iv)
58 if (iv%info(ssmi_rv)%nlocal > 0) call da_get_innov_vector_ssmi_rv (it, grid, ob, iv)
59 if (iv%info(ssmt2)%nlocal > 0) call da_get_innov_vector_ssmt1 (it, grid, ob, iv)
60 if (iv%info(ssmt2)%nlocal > 0) call da_get_innov_vector_ssmt2 (it, grid, ob, iv)
61 if (iv%info(satem)%nlocal > 0) call da_get_innov_vector_satem (grid, it, ob, iv)
62 if (iv%info(radar)%nlocal > 0) call da_get_innov_vector_radar (it, grid, ob, iv)
63 if (iv%info(qscat)%nlocal > 0) call da_get_innov_vector_qscat (it, grid, ob, iv)
64 if (iv%info(profiler)%nlocal > 0) call da_get_innov_vector_profiler (it, grid, ob, iv)
65 if (iv%info(buoy)%nlocal > 0) call da_get_innov_vector_buoy (it, grid, ob, iv)
66
67 if (iv%num_inst > 0) then
68 iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1
69 iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time)
70 if (rtm_option == rtm_option_rttov) then
71 call da_get_innov_vector_rttov( it, grid, ob, iv )
72 elseif (rtm_option == rtm_option_crtm) then
73 #ifdef CRTM
74 !if (use_crtm_kmatrix_fast) then
75 ! call da_get_innov_vector_crtmk( it, grid, ob, iv )
76 !else
77 call da_get_innov_vector_crtm (it, grid, ob, iv )
78 !end if
79 #endif
80 else
81 call da_warning(__FILE__,__LINE__,(/"Unknown Radiative Transfer Model"/))
82 end if
83 end if
84
85 if (num_pseudo > 0) call da_get_innov_vector_pseudo (grid, ob, iv)
86 if (iv%info(airsr)%nlocal > 0) call da_get_innov_vector_airsr (it, grid, ob, iv)
87
88 !----------------------------------------------
89 ! [5] write out iv in ascii format
90 !-----------------------------------------------
91
92 if ( var4d_multi_inc == 1 ) then
93
94 call da_write_iv_for_multi_inc(n, iv)
95
96 elseif ( var4d_multi_inc == 2 ) then
97
98 call da_read_iv_for_multi_inc(n, iv)
99
100 endif
101
102 end do
103
104 if ( var4d_multi_inc == 1 ) then
105 #ifdef DM_PARALLEL
106 call da_system("touch wrf_stop_now")
107 #endif
108 ! call da_wrfvar_finalize
109 call wrf_message("*** WRF-Var multi-increment stage 1 completed successfully ***")
110 call wrfu_finalize
111 call wrf_shutdown
112
113 endif
114
115 iv%time = 1
116 iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1
117 iv%info(:)%n2 = iv%info(:)%plocal(iv%time)
118
119 !-----------------------------------------------------------------------
120 ! [2] Having calculated the real O-Bs, optionally overwrite with scaled,
121 ! random values:
122 !-----------------------------------------------------------------------
123
124 if (omb_set_rand) call da_random_omb_all( iv, ob)
125
126 !------------------------------------------------------------------------
127 ! [3] Optionally rescale observation errors:
128 !------------------------------------------------------------------------
129
130 if (use_obs_errfac) call da_use_obs_errfac( iv)
131
132 !------------------------------------------------------------------------
133 ! [4] Optionally add Gaussian noise to O, O-B:
134 !------------------------------------------------------------------------
135
136 if (omb_add_noise) then
137 call da_add_noise_to_ob( iv, ob)
138 !#ifdef DM_PARALLEL
139 ! if ((num_procs > 1) .and.(.not. use_rad)) call da_write_noise_to_ob(iv)
140 ! if ((.not. use_rad)) call da_write_noise_to_ob(iv)
141 call da_write_noise_to_ob(iv)
142 !#endif
143 end if
144
145 !----------------------------------------------
146 ! [5] write out radiance iv in ascii format
147 !-----------------------------------------------
148 if (write_iv_rad_ascii) then
149 write(unit=stdout,fmt='(A)') 'Writing radiance iv ascii'
150 call da_write_iv_rad_ascii(ob,iv)
151 end if
152
153 !----------------------------------------------------------
154 ! [6] write out filtered radiance obs in binary format
155 !----------------------------------------------------------
156
157 if (write_filtered_rad) then
158 write(unit=stdout,fmt='(A)') 'Writing filtered radiance'
159 call da_write_filtered_rad(ob,iv)
160 end if
161
162 if (num_fgat_time > 1) then
163 call da_med_initialdata_input( grid , config_flags, 'fg01')
164 call da_setup_firstguess(xbx, grid)
165 end if
166
167 if (trace_use) call da_trace_exit("da_get_innov_vector")
168
169 end subroutine da_get_innov_vector
170
171