da_write_iv_rad_ascii.inc
References to this file elsewhere.
1 subroutine da_write_iv_rad_ascii ( xp, ob, iv )
2
3 !---------------------------------------------------------------------------
4 ! Purpose: write out innovation vector structure for radiance data.
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 type (xpose_type), intent(in) :: xp ! Domain decomposition vars.
10 type (y_type), intent(in) :: ob ! Observation structure.
11 type (ob_type), intent(in) :: iv ! O-B structure.
12
13 integer :: n ! Loop counter.
14 integer :: i, k ! Index dimension.
15 integer :: nlevelss ! Number of obs levels.
16
17 integer :: ios, innov_rad_unit
18 character(len=30) :: filename
19 integer :: ndomain
20 logical :: ssmis
21
22 #ifdef RTTOV
23 if (trace_use) call da_trace_entry("da_write_iv_rad_ascii")
24
25 do i = 1, iv%num_inst
26 if (iv%instid(i)%num_rad < 1) cycle
27
28 ! count number of obs within the loc%proc_domain
29 ! ---------------------------------------------
30 ndomain = 0
31 do n =1,iv%instid(i)%num_rad
32 if (iv%instid(i)%proc_domain(n)) then
33 ndomain = ndomain + 1
34 end if
35 end do
36
37 #ifdef DM_PARALLEL
38 write(unit=filename, fmt='(a,i2.2)') 'inv_'//trim(iv%instid(i)%rttovid_string)//'.', myproc
39 #else
40 write(unit=filename, fmt='(a)') 'inv_'//trim(iv%instid(i)%rttovid_string)
41 #endif
42
43 call da_get_unit(innov_rad_unit)
44 open(unit=innov_rad_unit,file=trim(filename),form='formatted',iostat=ios)
45 if (ios /= 0 ) Then
46 call da_error(__FILE__,__LINE__, &
47 (/"Cannot open innovation radiance file"//filename/))
48 Endif
49 write(unit=innov_rad_unit,fmt='(a,a,i7,a,i5,a)') trim(iv%instid(i)%rttovid_string), &
50 ' number-of-pixels : ', ndomain, &
51 ' channel-number-of-each-pixel : ', iv%instid(i)%nchan, &
52 ' index-of-channels : '
53 write(unit=innov_rad_unit,fmt='(10i5)') iv%instid(i)%ichan
54
55 ssmis= index(iv%instid(i)%rttovid_string,'ssmis') > 0
56 if ( ssmis ) then
57 write(unit=innov_rad_unit,fmt=*) ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi ssmis_subinst'
58 else
59 write(unit=innov_rad_unit,fmt=*) ' pixel-info : i date scanpos landsea_mask elv lat lon satzen satazi '
60 end if
61 write(unit=innov_rad_unit,fmt=*) ' xb-surf-info : i t2m mr2m(ppmv) u10 v10 ps ts smois tslb snowh isflg &
62 & soiltyp vegtyp vegfra elev clwp'
63 ndomain = 0
64 do n =1,iv%instid(i)%num_rad
65 if (iv%instid(i)%proc_domain(n)) then
66 ndomain=ndomain+1
67 if ( ssmis ) then
68 write(unit=innov_rad_unit,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2,i3)') 'INFO : ', ndomain, &
69 iv%instid(i)%info(n)%date_char, &
70 iv%instid(i)%scanpos(n), &
71 iv%instid(i)%landsea_mask(n), &
72 iv%instid(i)%info(n)%elv, &
73 iv%instid(i)%info(n)%lat, &
74 iv%instid(i)%info(n)%lon, &
75 iv%instid(i)%satzen(n), &
76 iv%instid(i)%satazi(n), &
77 iv%instid(i)%ssmis_subinst(n)
78 else
79 write(unit=innov_rad_unit,fmt='(a,i7,2x,a,i6,i3,f6.0,4f8.2)') 'INFO : ', ndomain, &
80 iv%instid(i)%info(n)%date_char, &
81 iv%instid(i)%scanpos(n), &
82 iv%instid(i)%landsea_mask(n), &
83 iv%instid(i)%info(n)%elv, &
84 iv%instid(i)%info(n)%lat, &
85 iv%instid(i)%info(n)%lon, &
86 iv%instid(i)%satzen(n), &
87 iv%instid(i)%satazi(n)
88 end if
89 if (iv%instid(i)%isflg(n)==0) then
90 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') ' SEA : ', n, &
91 iv%instid(i)%t2m(n), &
92 iv%instid(i)%mr2m(n), &
93 iv%instid(i)%u10(n), &
94 iv%instid(i)%v10(n), &
95 iv%instid(i)%ps(n), &
96 iv%instid(i)%ts(n), &
97 iv%instid(i)%smois(n), &
98 iv%instid(i)%tslb(n), &
99 iv%instid(i)%snowh(n), &
100 iv%instid(i)%isflg(n), &
101 nint(iv%instid(i)%soiltyp(n)), &
102 nint(iv%instid(i)%vegtyp(n)), &
103 iv%instid(i)%vegfra(n), &
104 iv%instid(i)%elevation(n), &
105 iv%instid(i)%clwp(n)
106 else if (iv%instid(i)%isflg(n)==1) then
107 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') ' ICE : ', n, &
108 iv%instid(i)%t2m(n), &
109 iv%instid(i)%mr2m(n), &
110 iv%instid(i)%u10(n), &
111 iv%instid(i)%v10(n), &
112 iv%instid(i)%ps(n), &
113 iv%instid(i)%ts(n), &
114 iv%instid(i)%smois(n), &
115 iv%instid(i)%tslb(n), &
116 iv%instid(i)%snowh(n), &
117 iv%instid(i)%isflg(n), &
118 nint(iv%instid(i)%soiltyp(n)), &
119 nint(iv%instid(i)%vegtyp(n)), &
120 iv%instid(i)%vegfra(n), &
121 iv%instid(i)%elevation(n), &
122 iv%instid(i)%clwp(n)
123 else if (iv%instid(i)%isflg(n)==2) then
124 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'LAND : ', n, &
125 iv%instid(i)%t2m(n), &
126 iv%instid(i)%mr2m(n), &
127 iv%instid(i)%u10(n), &
128 iv%instid(i)%v10(n), &
129 iv%instid(i)%ps(n), &
130 iv%instid(i)%ts(n), &
131 iv%instid(i)%smois(n), &
132 iv%instid(i)%tslb(n), &
133 iv%instid(i)%snowh(n), &
134 iv%instid(i)%isflg(n), &
135 nint(iv%instid(i)%soiltyp(n)), &
136 nint(iv%instid(i)%vegtyp(n)), &
137 iv%instid(i)%vegfra(n), &
138 iv%instid(i)%elevation(n), &
139 iv%instid(i)%clwp(n)
140 else if (iv%instid(i)%isflg(n)==3) then
141 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'SNOW : ', n, &
142 iv%instid(i)%t2m(n), &
143 iv%instid(i)%mr2m(n), &
144 iv%instid(i)%u10(n), &
145 iv%instid(i)%v10(n), &
146 iv%instid(i)%ps(n), &
147 iv%instid(i)%ts(n), &
148 iv%instid(i)%smois(n), &
149 iv%instid(i)%tslb(n), &
150 iv%instid(i)%snowh(n), &
151 iv%instid(i)%isflg(n), &
152 nint(iv%instid(i)%soiltyp(n)), &
153 nint(iv%instid(i)%vegtyp(n)), &
154 iv%instid(i)%vegfra(n), &
155 iv%instid(i)%elevation(n), &
156 iv%instid(i)%clwp(n)
157 else if (iv%instid(i)%isflg(n)==4) then
158 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'MSEA : ', n, &
159 iv%instid(i)%t2m(n), &
160 iv%instid(i)%mr2m(n), &
161 iv%instid(i)%u10(n), &
162 iv%instid(i)%v10(n), &
163 iv%instid(i)%ps(n), &
164 iv%instid(i)%ts(n), &
165 iv%instid(i)%smois(n), &
166 iv%instid(i)%tslb(n), &
167 iv%instid(i)%snowh(n), &
168 iv%instid(i)%isflg(n), &
169 nint(iv%instid(i)%soiltyp(n)), &
170 nint(iv%instid(i)%vegtyp(n)), &
171 iv%instid(i)%vegfra(n), &
172 iv%instid(i)%elevation(n), &
173 iv%instid(i)%clwp(n)
174 else if (iv%instid(i)%isflg(n)==5) then
175 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'MICE : ', n, &
176 iv%instid(i)%t2m(n), &
177 iv%instid(i)%mr2m(n), &
178 iv%instid(i)%u10(n), &
179 iv%instid(i)%v10(n), &
180 iv%instid(i)%ps(n), &
181 iv%instid(i)%ts(n), &
182 iv%instid(i)%smois(n), &
183 iv%instid(i)%tslb(n), &
184 iv%instid(i)%snowh(n), &
185 iv%instid(i)%isflg(n), &
186 nint(iv%instid(i)%soiltyp(n)), &
187 nint(iv%instid(i)%vegtyp(n)), &
188 iv%instid(i)%vegfra(n), &
189 iv%instid(i)%elevation(n), &
190 iv%instid(i)%clwp(n)
191 else if (iv%instid(i)%isflg(n)==6) then
192 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'MLND : ', n, &
193 iv%instid(i)%t2m(n), &
194 iv%instid(i)%mr2m(n), &
195 iv%instid(i)%u10(n), &
196 iv%instid(i)%v10(n), &
197 iv%instid(i)%ps(n), &
198 iv%instid(i)%ts(n), &
199 iv%instid(i)%smois(n), &
200 iv%instid(i)%tslb(n), &
201 iv%instid(i)%snowh(n), &
202 iv%instid(i)%isflg(n), &
203 nint(iv%instid(i)%soiltyp(n)), &
204 nint(iv%instid(i)%vegtyp(n)), &
205 iv%instid(i)%vegfra(n), &
206 iv%instid(i)%elevation(n), &
207 iv%instid(i)%clwp(n)
208 else if (iv%instid(i)%isflg(n)==7) then
209 write(unit=innov_rad_unit,fmt='(a,i7,9f10.2,3i3,f8.3,f10.2,f8.3)') 'MSNO : ', n, &
210 iv%instid(i)%t2m(n), &
211 iv%instid(i)%mr2m(n), &
212 iv%instid(i)%u10(n), &
213 iv%instid(i)%v10(n), &
214 iv%instid(i)%ps(n), &
215 iv%instid(i)%ts(n), &
216 iv%instid(i)%smois(n), &
217 iv%instid(i)%tslb(n), &
218 iv%instid(i)%snowh(n), &
219 iv%instid(i)%isflg(n), &
220 nint(iv%instid(i)%soiltyp(n)), &
221 nint(iv%instid(i)%vegtyp(n)), &
222 iv%instid(i)%vegfra(n), &
223 iv%instid(i)%elevation(n), &
224 iv%instid(i)%clwp(n)
225 end if
226
227 write(unit=innov_rad_unit,fmt='(a)') 'OBS : '
228 write(unit=innov_rad_unit,fmt='(10f11.2)') ob%instid(i)%tb(:,n)
229 write(unit=innov_rad_unit,fmt='(a)') 'BAK : '
230 write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_xb(:,n)
231 write(unit=innov_rad_unit,fmt='(a)') 'IVBC : '
232 write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_inv(:,n)
233 write(unit=innov_rad_unit,fmt='(a)') 'EMS : '
234 write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%emiss(1:iv%instid(i)%nchan,n)
235 write(unit=innov_rad_unit,fmt='(a)') 'ERR : '
236 write(unit=innov_rad_unit,fmt='(10f11.2)') iv%instid(i)%tb_error(:,n)
237 write(unit=innov_rad_unit,fmt='(a)') 'QC : '
238 write(unit=innov_rad_unit,fmt='(10i11)') iv%instid(i)%tb_qc(:,n)
239
240 if (write_profile) then
241 nlevelss = iv%instid(i)%nlevels
242 write(unit=innov_rad_unit,fmt=*) &
243 'RTM_level pres(mb) T(k) Q(ppmv) WRF_level pres(mb) T(k) q(g/kg) clw(g/kg) rain(g/kg)'
244 do k=xp%kts,xp%kte
245 if (k <= nlevelss) then
246 write(unit=innov_rad_unit,fmt='(i3,f10.2,f8.2,e11.4,i3,f10.2,f8.2,3e11.4)') &
247 k, & ! RTTOV levels
248 coefs(i) % ref_prfl_p(k) , &
249 iv%instid(i)%t(k,n) , &
250 iv%instid(i)%mr(k,n), &
251 k, & ! WRF model levels
252 iv%instid(i)%pm(k,n) , &
253 iv%instid(i)%tm(k,n) , &
254 iv%instid(i)%qm(k,n)*1000 , &
255 iv%instid(i)%qcw(k,n)*1000.0, &
256 iv%instid(i)%qrn(k,n)*1000.0
257 else
258 write(unit=innov_rad_unit,fmt='(32x,i3,f10.2,f8.2,3e11.4)') k, &
259 iv%instid(i)%pm(k,n) , &
260 iv%instid(i)%tm(k,n) , &
261 iv%instid(i)%qm(k,n)*1000 , &
262 iv%instid(i)%qcw(k,n)*1000.0, &
263 iv%instid(i)%qrn(k,n)*1000.0
264 ! iv%instid(i)%qci(k,n)*1000.0, &
265 ! iv%instid(i)%qsn(k,n)*1000.0, &
266 ! iv%instid(i)%qgr(k,n)*1000.0
267 end if
268 end do ! end loop profile
269 end if ! end if write_profile
270 end if ! end if proc_domain
271 end do ! end do pixels
272 close(unit=innov_rad_unit)
273 call da_free_unit(innov_rad_unit)
274 end do ! end do instruments
275
276 if (trace_use) call da_trace_exit("da_write_iv_rad_ascii")
277
278 #endif
279
280 end subroutine da_write_iv_rad_ascii
281