da_setup_bufrtovs_structures.inc
References to this file elsewhere.
1 subroutine da_setup_bufrtovs_structures( grid, ob, iv )
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Define, allocate and read of tovs raidance observation structure.
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 type (domain) , intent (in) :: grid ! model data
10 type ( y_type), intent(inout) :: ob ! Observation structure.
11 type (iv_type), intent(inout) :: iv ! O-B structure.
12
13 character(len=200) :: filename
14 integer :: i, j, n, ios
15 logical :: lprinttovs
16
17 ! thinning variables
18 integer :: istart,iend,jstart,jend
19
20 if (trace_use) call da_trace_entry("da_setup_bufrtovs_structures")
21
22 !-------------------------------------------------------------------
23 ! [1.0] Initialize RTTOV coefs and innovations vector for radiance
24 !-------------------------------------------------------------------
25
26 if (rtm_option == rtm_option_rttov) then
27 call da_rttov_init(iv,ob)
28 end if
29
30 if (rtm_option == rtm_option_crtm) then
31 #ifdef CRTM
32 call da_crtm_init(iv,ob)
33 #endif
34 end if
35
36 do n = 1, rtminit_nsensor
37 iv%instid(n)%rad_monitoring = rad_monitoring(n)
38 enddo
39
40 !-------------------------------
41 ! 1.1 Make thinning grids
42 !------------------------------
43 call init_constants_derived
44
45 if (thinning) then
46 rlat_min = r999
47 rlat_max = -r999
48 rlon_min = r999
49 rlon_max = -r999
50
51 istart=grid%i_start(1)
52 iend =grid%i_end (1)
53 jstart=grid%j_start(1)
54 jend =grid%j_end (1)
55
56 do i = istart, iend
57 do j = jstart, jend
58 rlat_min=min(rlat_min, grid%xb%lat(i,j))
59 rlat_max=max(rlat_max, grid%xb%lat(i,j))
60 if( grid%xb%lon(i,j) < zero) then
61 rlon_min=min(rlon_min, (r360+grid%xb%lon(i,j)))
62 rlon_max=max(rlon_max, (r360+grid%xb%lon(i,j)))
63 else
64 rlon_min=min(rlon_min, grid%xb%lon(i,j))
65 rlon_max=max(rlon_max, grid%xb%lon(i,j))
66 endif
67 enddo
68 enddo
69
70 dlat_grid = rlat_max - rlat_min
71 dlon_grid = rlon_max - rlon_min
72
73 allocate(thinning_grid(iv%num_inst))
74 do n=1,iv%num_inst
75 call makegrids (n,thinning_mesh(n))
76 end do
77 end if
78
79 !-------------------------------------------------------------------
80 ! [2.0] Read NCEP bufr tovs data in radiance innovations vector
81 !-------------------------------------------------------------------
82
83 if (.not. use_filtered_rad) then
84
85 if (use_hirs2obs) then
86 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs2.bufr'
87 filename = ' '
88 write(filename(1:10), fmt='(a)') 'hirs2.bufr'
89 call da_read_obs_bufrtovs ('hirs2', iv, filename)
90 end if
91
92 if (use_msuobs) then
93 filename = ' '
94 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from msu.bufr'
95 write(filename(1:8), fmt='(a)') 'msu.bufr'
96 call da_read_obs_bufrtovs ('msu ', iv, filename)
97 end if
98
99 if (use_hirs3obs) then
100 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs3.bufr'
101 filename = ' '
102 write(filename(1:10), fmt='(a)') 'hirs3.bufr'
103 call da_read_obs_bufrtovs('hirs3', iv, filename)
104 end if
105
106 if (use_amsuaobs) then
107 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsua.bufr'
108 filename = ' '
109 write(filename(1:10), fmt='(a)') 'amsua.bufr'
110 call da_read_obs_bufrtovs ('amsua', iv, filename)
111 end if
112
113 if (use_amsubobs) then
114 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsub.bufr'
115 filename = ' '
116 write(filename(1:10), fmt='(a)') 'amsub.bufr'
117 call da_read_obs_bufrtovs ('amsub', iv, filename)
118 end if
119
120 if (use_hirs4obs) then
121 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs4.bufr'
122 filename = ' '
123 write(filename(1:10), fmt='(a)') 'hirs4.bufr'
124 call da_read_obs_bufrtovs('hirs4', iv, filename)
125 end if
126
127 if (use_mhsobs) then
128 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from mhs.bufr'
129 filename = ' '
130 write(filename(1:8), fmt='(a)') 'mhs.bufr'
131 call da_read_obs_bufrtovs('mhs ', iv, filename)
132 end if
133
134 if (use_airsobs) then
135 write(unit=stdout,fmt='(a)') 'Reading airs 1b data from airs.bufr'
136 filename = ' '
137 write(filename(1:9), fmt='(a)') 'airs.bufr'
138 call da_read_obs_bufrairs ('airs ',iv, filename)
139 end if
140
141 if (use_eos_amsuaobs) then
142 write(unit=stdout,fmt='(a)') 'Reading eos_amsua 1b data from airs.bufr'
143 filename = ' '
144 write(filename(1:9), fmt='(a)') 'airs.bufr'
145 call da_read_obs_bufrairs ('eos_amsua',iv, filename)
146 end if
147
148 if (use_hsbobs) then
149 write(unit=stdout,fmt='(a)') 'Reading hsb 1b data from airs.bufr'
150 filename = ' '
151 write(filename(1:9), fmt='(a)') 'airs.bufr'
152 call da_read_obs_bufrairs ('hsb ',iv, filename)
153 end if
154
155 if (use_ssmisobs) then
156 write(unit=stdout,fmt='(a)') 'Reading ssmis data from ssmis.bufr'
157 filename = ' '
158 write(filename(1:10), fmt='(a)') 'ssmis.bufr'
159 call da_read_obs_bufrssmis ('ssmis',iv, filename)
160 end if
161
162 else
163
164 call da_read_filtered_rad (iv)
165
166 end if
167
168 if (use_kma1dvar) then
169 do i=1,rtminit_nsensor
170 filename = ' '
171 filename='kma1dvar-'//trim(iv%instid(i)%rttovid_string)//'.inv'
172 write(unit=stdout,fmt='(a,a)') ' Reading KMA 1dvar innovation from ', filename
173 call da_read_kma1dvar (i,iv, ob, filename)
174 end do
175 end if
176
177 if (thinning) then
178 do n=1,iv%num_inst
179 call destroygrids (n)
180 end do
181 deallocate(thinning_grid)
182 end if
183
184 ! sorting obs into FGAT time bins
185 call da_sort_rad(iv)
186
187 ! allocate cloud_flag in iv structure
188 ! do i = 1, iv % num_inst
189 ! if (iv % instid(i) % num_rad < 1) cycle
190 ! iv%instid(i)%cloud_flag(:,:) = 1 ! no cloud
191 ! end do
192
193 !-----------------------------------------------------------------------------
194 ! [3.0] create (smaller) ob structure:
195 !-----------------------------------------------------------------------------
196
197 if (.not. use_kma1dvar) then
198 do i = 1, ob % num_inst
199 ob % instid(i) % num_rad = iv % instid(i) % num_rad
200 if (ob % instid(i) % num_rad < 1) cycle
201 allocate (ob % instid(i) % tb(ob % instid(i) % nchan,ob % instid(i)%num_rad))
202 ob % instid(i) % tb(:,:) = iv % instid(i) % tb_inv(:,:)
203 end do
204 end if
205
206 if (trace_use) call da_trace_exit("da_setup_bufrtovs_structures")
207
208 end subroutine da_setup_bufrtovs_structures
209