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 (ob_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 (use_hirs2obs) then
84 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs2.bufr'
85 filename = ' '
86 write(filename(1:10), fmt='(a)') 'hirs2.bufr'
87 call da_read_bufrtovs ('hirs2', iv, grid%xp, filename)
88 end if
89
90 if (use_msuobs) then
91 filename = ' '
92 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from msu.bufr'
93 write(filename(1:8), fmt='(a)') 'msu.bufr'
94 call da_read_bufrtovs ('msu ', iv, grid%xp, filename)
95 end if
96
97 if (use_hirs3obs) then
98 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs3.bufr'
99 filename = ' '
100 write(filename(1:10), fmt='(a)') 'hirs3.bufr'
101 call da_read_bufrtovs('hirs3', iv, grid%xp, filename)
102 end if
103
104 if (use_amsuaobs) then
105 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsua.bufr'
106 filename = ' '
107 write(filename(1:10), fmt='(a)') 'amsua.bufr'
108 call da_read_bufrtovs ('amsua', iv, grid%xp, filename)
109 end if
110
111 if (use_amsubobs) then
112 write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsub.bufr'
113 filename = ' '
114 write(filename(1:10), fmt='(a)') 'amsub.bufr'
115 call da_read_bufrtovs ('amsub', iv, grid%xp, filename)
116 end if
117
118 if (use_airsobs) then
119 write(unit=stdout,fmt='(a)') 'Reading airs 1b data from airs.bufr'
120 filename = ' '
121 write(filename(1:9), fmt='(a)') 'airs.bufr'
122 call da_read_bufrairs ('airs ',iv, grid%xp, filename)
123 end if
124
125 if (use_eos_amsuaobs) then
126 write(unit=stdout,fmt='(a)') 'Reading eos_amsua 1b data from airs.bufr'
127 filename = ' '
128 write(filename(1:9), fmt='(a)') 'airs.bufr'
129 call da_read_bufrairs ('eos_amsua',iv, grid%xp, filename)
130 end if
131
132 if (use_hsbobs) then
133 write(unit=stdout,fmt='(a)') 'Reading hsb 1b data from airs.bufr'
134 filename = ' '
135 write(filename(1:9), fmt='(a)') 'airs.bufr'
136 call da_read_bufrairs ('hsb ',iv, grid%xp, filename)
137 end if
138
139 if (use_ssmisobs) then
140 write(unit=stdout,fmt='(a)') 'Reading ssmis data from ssmis.bufr'
141 filename = ' '
142 write(filename(1:10), fmt='(a)') 'ssmis.bufr'
143 call da_read_bufrssmis ('ssmis',iv, grid%xp, filename)
144 end if
145
146 if (use_filtered_rad) then
147 call da_read_filtered_rad (grid%xp, iv)
148 end if
149
150 if (use_kma1dvar) then
151 do i=1,rtminit_nsensor
152 filename = ' '
153 filename='kma1dvar-'//trim(iv%instid(i)%rttovid_string)//'.inv'
154 write(unit=stdout,fmt='(a,a)') ' Reading KMA 1dvar innovation from ', filename
155 call da_read_kma1dvar (i,iv, ob, grid%xp, filename)
156 end do
157 end if
158
159 if (thinning) then
160 do n=1,iv%num_inst
161 call destroygrids (n)
162 end do
163 deallocate(thinning_grid)
164 end if
165
166 ! sorting obs into FGAT time bins
167 call da_sort_rad(iv)
168
169 ! allocate cloud_flag in iv structure
170 ! do i = 1, iv % num_inst
171 ! if (iv % instid(i) % num_rad < 1) cycle
172 ! iv%instid(i)%cloud_flag(:,:) = 1 ! no cloud
173 ! end do
174
175 !-----------------------------------------------------------------------------
176 ! [3.0] create (smaller) ob structure:
177 !-----------------------------------------------------------------------------
178
179 if (.not. use_kma1dvar) then
180 do i = 1, ob % num_inst
181 ob % instid(i) % num_rad = iv % instid(i) % num_rad
182 if (ob % instid(i) % num_rad < 1) cycle
183 allocate (ob % instid(i) % tb(ob % instid(i) % nchan,ob % instid(i)%num_rad))
184 ob % instid(i) % tb(:,:) = iv % instid(i) % tb_inv(:,:)
185 end do
186 end if
187
188 if (trace_use) call da_trace_exit("da_setup_bufrtovs_structures")
189
190 end subroutine da_setup_bufrtovs_structures
191