1 | ! $Id: ropp2bufr_mod.f90 4452 2015-01-29 14:42:02Z idculv $
|
---|
2 |
|
---|
3 | MODULE ropp2bufr
|
---|
4 |
|
---|
5 | !****m* ropp2bufr/ropp2bufr *
|
---|
6 | !
|
---|
7 | ! NAME
|
---|
8 | ! ropp2bufr (ropp2bufr_mod.f90)
|
---|
9 | !
|
---|
10 | ! SYNOPSIS
|
---|
11 | ! Module defining fixed values & subroutines/functions for the
|
---|
12 | ! ropp2bufr main program (ECMWF or MetDB versions)
|
---|
13 | !
|
---|
14 | ! USE ropp2bufr
|
---|
15 | !
|
---|
16 | ! USED BY
|
---|
17 | ! ropp2bufr (ropp2bufr_ec or ropp2bufr_mo)
|
---|
18 | !
|
---|
19 | ! AUTHOR
|
---|
20 | ! Met Office, Exeter, UK.
|
---|
21 | ! Any comments on this software should be given via the ROM SAF
|
---|
22 | ! Helpdesk at http://www.romsaf.org
|
---|
23 | !
|
---|
24 | ! COPYRIGHT
|
---|
25 | ! (c) EUMETSAT. All rights reserved.
|
---|
26 | ! For further details please refer to the file COPYRIGHT
|
---|
27 | ! which you should have received as part of this distribution.
|
---|
28 | !
|
---|
29 | !****
|
---|
30 |
|
---|
31 | ! Modules
|
---|
32 |
|
---|
33 | USE typesizes, dp => EightByteReal
|
---|
34 | USE messages
|
---|
35 |
|
---|
36 | ! Public fixed values for array sizes, etc
|
---|
37 |
|
---|
38 | ! GPSRO-specific GTS/RMDCN routing header elements
|
---|
39 |
|
---|
40 | CHARACTER (LEN=6), PARAMETER :: TTAAII = "IUT?14" ! Binary/UAir/Satellite/GPSRO
|
---|
41 |
|
---|
42 | INTEGER, PARAMETER :: NOhdrs = 0 ! No GTS routings headers
|
---|
43 | INTEGER, PARAMETER :: ARhdrs = 1 ! GTS Abbreviated Routing headers only
|
---|
44 | INTEGER, PARAMETER :: IPhdrs = 2 ! ARH plus IP support
|
---|
45 |
|
---|
46 | ! GPSRO-specific BUFR details
|
---|
47 |
|
---|
48 | INTEGER, PARAMETER :: RODescr = 310026 ! Table D master descriptor for RO
|
---|
49 |
|
---|
50 | INTEGER, PARAMETER :: Edition = 4 ! BUFR Edition (4)
|
---|
51 | INTEGER, PARAMETER :: MasterTable = 0 ! BUFR Master Table (Meteorology)
|
---|
52 | INTEGER, PARAMETER :: DataType = 3 ! Table A (Sounding - satellite)
|
---|
53 | INTEGER, PARAMETER :: IntlSubType = 50 ! International data sub-type (GPSRO)
|
---|
54 | INTEGER, PARAMETER :: LoclSubType = 14 ! Local data sub-type
|
---|
55 | INTEGER, PARAMETER :: VerMasTable = 12 ! Table version number (12)
|
---|
56 | INTEGER, PARAMETER :: VerLocTable = 0 ! Local Table version (not used)
|
---|
57 | INTEGER, PARAMETER :: Sec3Type_mo = 1 ! Observed data, uncompressed (MetDB)
|
---|
58 | INTEGER, PARAMETER :: Sec3Type_ec = 128 ! Observed data, uncompressed (ECMWF)
|
---|
59 |
|
---|
60 | ! Default (missing) data values
|
---|
61 |
|
---|
62 | INTEGER, PARAMETER :: NMDFV = -9999999 ! Integer missing data flag value (MetDB)
|
---|
63 | INTEGER, PARAMETER :: NVIND = 2147483647 ! Integer missing data flag value (ECMWF)
|
---|
64 | REAL, PARAMETER :: RMDFV = -9999999.0 ! Real missing data flag value (MetDB)
|
---|
65 | REAL(dp), PARAMETER :: RVIND = 1.7E38_dp ! Real missing data flag value (ECMWF)
|
---|
66 |
|
---|
67 | ! MetDB I/O interface
|
---|
68 |
|
---|
69 | INTEGER, PARAMETER :: Output = 2 ! I/O output mode (r+w, new)
|
---|
70 |
|
---|
71 | ! ECMWF SBYTE() packing & I/O interfaces
|
---|
72 |
|
---|
73 | INTEGER, PARAMETER :: nbpc = 8 ! bits per character (or byte)
|
---|
74 | INTEGER, PARAMETER :: nbpw = KIND(nbpc) * nbpc ! bits per word (default INTEGER)
|
---|
75 | INTEGER, PARAMETER :: nbsk = 0 ! no. bits to skip when packing
|
---|
76 |
|
---|
77 | CONTAINS
|
---|
78 | !--------------------------------------------------------------------
|
---|
79 |
|
---|
80 | SUBROUTINE Usage()
|
---|
81 |
|
---|
82 | !****s* ropp2bufr/Usage *
|
---|
83 | !
|
---|
84 | ! NAME
|
---|
85 | ! Usage
|
---|
86 | !
|
---|
87 | ! SYNOPIS
|
---|
88 | ! USE ropp2bufr
|
---|
89 | ! CALL Usage()
|
---|
90 | !
|
---|
91 | ! INPUTS
|
---|
92 | ! None
|
---|
93 | !
|
---|
94 | ! OUTPUTS
|
---|
95 | ! Summary usage text to stdout
|
---|
96 | !
|
---|
97 | ! CALLED BY
|
---|
98 | ! GetOptions
|
---|
99 | !
|
---|
100 | ! DESCRIPTION
|
---|
101 | ! Prints a summary of program usage (help) to stdout.
|
---|
102 | !
|
---|
103 | ! AUTHOR
|
---|
104 | ! Met Office, Exeter, UK.
|
---|
105 | ! Any comments on this software should be given via the ROM SAF
|
---|
106 | ! Helpdesk at http://www.romsaf.org
|
---|
107 | !
|
---|
108 | ! COPYRIGHT
|
---|
109 | ! (c) EUMETSAT. All rights reserved.
|
---|
110 | ! For further details please refer to the file COPYRIGHT
|
---|
111 | ! which you should have received as part of this distribution.
|
---|
112 | !
|
---|
113 | !****
|
---|
114 |
|
---|
115 | PRINT *, 'Purpose:'
|
---|
116 | PRINT *, ' Encode one or more ROPP-format netCDF files to WMO BUFR.'
|
---|
117 | PRINT *, 'Usage:'
|
---|
118 | PRINT *, ' > ropp2bufr ropp_file [ropp_file...] [-o bufr_file]'
|
---|
119 | PRINT *, ' [-g[i]] [-s csn_file]'
|
---|
120 | PRINT *, ' [-p thin_file|maxsamp] [-t time]'
|
---|
121 | PRINT *, ' [-u] [-l] [-d] [-m] [-h] [-v]'
|
---|
122 | PRINT *, 'Input:'
|
---|
123 | PRINT *, ' One or more files in ROPP netCDF format.'
|
---|
124 | PRINT *, 'Output:'
|
---|
125 | PRINT *, ' BUFR file, one message or bulletin per input RO profile'
|
---|
126 | PRINT *, 'Options:'
|
---|
127 | PRINT *, ' -o BUFR output file name'
|
---|
128 | PRINT *, ' -g GTS routing headers/trailers required'
|
---|
129 | PRINT *, ' -gi GTS headers preceded by 10-byte leading'
|
---|
130 | PRINT *, ' size/type for GTS IP (FTP) transmission'
|
---|
131 | PRINT *, ' -s file containing last used channel sequence number'
|
---|
132 | PRINT *, ' (updated on completion)'
|
---|
133 | PRINT *, ' -p thinning control file name or max. no. samples'
|
---|
134 | PRINT *, ' -t don''t encode data older than ''time'' ago (hh:mm)'
|
---|
135 | PRINT *, ' -u leave profiles unordered (i.e. in original height order)'
|
---|
136 | PRINT *, ' -l L1+L2 data (Level 1b) are not to be encoded,'
|
---|
137 | PRINT *, ' only the ionospheric-corrected profile.'
|
---|
138 | PRINT *, ' -m met. data (Level 2c/d) are not to be encoded'
|
---|
139 | PRINT *, ' -d outputs additonal diagnostics to stdout'
|
---|
140 | PRINT *, ' -h this help'
|
---|
141 | PRINT *, ' -v version information'
|
---|
142 | PRINT *, 'Defaults:'
|
---|
143 | PRINT *, ' Input file name : none - at least one required'
|
---|
144 | PRINT *, ' Output file name : from (first) occultation ID <occid>.bufr'
|
---|
145 | PRINT *, ' GTS routing headers : not generated'
|
---|
146 | PRINT *, ' Channel sequence nos. : starts at 001'
|
---|
147 | PRINT *, ' Reject time difference : 00:00 (no rejection on time)'
|
---|
148 | PRINT *, ' unless -g* option, when: 23:50 (assuming NRT on GTS)'
|
---|
149 | PRINT *, ' Thinning : sample to <= 375 levels'
|
---|
150 | PRINT *, ' Re-ordering : descending profiles re-ordered to ascending '
|
---|
151 | PRINT *, 'See ropp2bufr(1) for details.'
|
---|
152 | PRINT *, ''
|
---|
153 | END SUBROUTINE Usage
|
---|
154 | !--------------------------------------------------------------------
|
---|
155 |
|
---|
156 | SUBROUTINE Usage_eum()
|
---|
157 |
|
---|
158 | !****s* ropp2bufr/Usage_eum *
|
---|
159 | !
|
---|
160 | ! NAME
|
---|
161 | ! Usage_eum
|
---|
162 | !
|
---|
163 | ! SYNOPIS
|
---|
164 | ! USE ropp2bufr
|
---|
165 | ! CALL Usage_eum()
|
---|
166 | !
|
---|
167 | ! INPUTS
|
---|
168 | ! None
|
---|
169 | !
|
---|
170 | ! OUTPUTS
|
---|
171 | ! Summary usage text to stdout
|
---|
172 | !
|
---|
173 | ! CALLED BY
|
---|
174 | ! GetOptions
|
---|
175 | !
|
---|
176 | ! DESCRIPTION
|
---|
177 | ! Prints a summary of eum2bufr program usage (help) to stdout.
|
---|
178 | !
|
---|
179 | ! AUTHOR
|
---|
180 | ! Met Office, Exeter, UK.
|
---|
181 | ! Any comments on this software should be given via the ROM SAF
|
---|
182 | ! Helpdesk at http://www.romsaf.org
|
---|
183 | !
|
---|
184 | ! COPYRIGHT
|
---|
185 | ! (c) EUMETSAT. All rights reserved.
|
---|
186 | ! For further details please refer to the file COPYRIGHT
|
---|
187 | ! which you should have received as part of this distribution.
|
---|
188 | !
|
---|
189 | !****
|
---|
190 |
|
---|
191 | PRINT *, 'Purpose:'
|
---|
192 | PRINT *, ' Encode one or more EUMETSAT netCDF files to WMO BUFR.'
|
---|
193 | PRINT *, 'Usage:'
|
---|
194 | PRINT *, ' > eum2bufr eum_file [eum_file...] [-o bufr_file]'
|
---|
195 | PRINT *, ' [-g[i]] [-s csn_file]'
|
---|
196 | PRINT *, ' [-p thin_file|maxsamp] [-t time] [-r resn]'
|
---|
197 | PRINT *, ' [-u] [-l] [-d] [-m] [-h] [-v]'
|
---|
198 | PRINT *, 'Input:'
|
---|
199 | PRINT *, ' One or more files in EUMETSAT netCDF-4 format.'
|
---|
200 | PRINT *, 'Output:'
|
---|
201 | PRINT *, ' BUFR file, one message or bulletin per input RO profile'
|
---|
202 | PRINT *, 'Options:'
|
---|
203 | PRINT *, ' -o BUFR output file name'
|
---|
204 | PRINT *, ' -g GTS routing headers/trailers required'
|
---|
205 | PRINT *, ' -gi GTS headers preceded by 10-byte leading'
|
---|
206 | PRINT *, ' size/type for GTS IP (FTP) transmission'
|
---|
207 | PRINT *, ' -s file containing last used channel sequence number'
|
---|
208 | PRINT *, ' (updated on completion)'
|
---|
209 | PRINT *, ' -p thinning control file name or max. no. samples'
|
---|
210 | PRINT *, ' -t don''t encode data older than ''time'' ago (hh:mm)'
|
---|
211 | PRINT *, ' -u leave profiles unordered (i.e. in original height order)'
|
---|
212 | PRINT *, ' -l L1+L2 data (Level 1b) are not to be encoded,'
|
---|
213 | PRINT *, ' only the ionospheric-corrected profile.'
|
---|
214 | PRINT *, ' -m met. data (Level 2c/d) are not to be encoded'
|
---|
215 | PRINT *, ' -r resolution group of netCDF-4 EUM file'
|
---|
216 | PRINT *, ' -d outputs additonal diagnostics to stdout'
|
---|
217 | PRINT *, ' -h this help'
|
---|
218 | PRINT *, ' -v version information'
|
---|
219 | PRINT *, 'Defaults:'
|
---|
220 | PRINT *, ' Input file name : none - at least one required'
|
---|
221 | PRINT *, ' Output file name : from (first) occultation ID <occid>.bufr'
|
---|
222 | PRINT *, ' GTS routing headers : not generated'
|
---|
223 | PRINT *, ' Channel sequence nos. : starts at 001'
|
---|
224 | PRINT *, ' Reject time difference : 00:00 (no rejection on time)'
|
---|
225 | PRINT *, ' unless -g* option, when: 23:50 (assuming NRT on GTS)'
|
---|
226 | PRINT *, ' Thinning : sample to <= 375 levels'
|
---|
227 | PRINT *, ' Re-ordering : descending profiles re-ordered to ascending '
|
---|
228 | PRINT *, ' Resolution : ''thinned'' '
|
---|
229 | PRINT *, 'See eum2bufr(1) for details.'
|
---|
230 | PRINT *, ''
|
---|
231 | END SUBROUTINE Usage_eum
|
---|
232 |
|
---|
233 | !-------------------------------------------------------------------------
|
---|
234 |
|
---|
235 | SUBROUTINE GetOptions ( centre, & ! (in)
|
---|
236 | NCDFdsn, & ! (out)
|
---|
237 | nfiles, & ! (out)
|
---|
238 | BUFRdsn, & ! (out)
|
---|
239 | CSNdsn, & ! (out)
|
---|
240 | Thindsn, & ! (out)
|
---|
241 | GTShdrType, & ! (out)
|
---|
242 | RejTimeDiff, & ! (out)
|
---|
243 | CorrOnly, & ! (out)
|
---|
244 | nomet, & ! (out)
|
---|
245 | unordered, & ! (out)
|
---|
246 | resolution ) ! (out)
|
---|
247 |
|
---|
248 | !****s* ropp2bufr/GetOptions *
|
---|
249 | !
|
---|
250 | ! NAME
|
---|
251 | ! GetOptions
|
---|
252 | !
|
---|
253 | ! SYNOPSIS
|
---|
254 | ! Get command line information & options or set defaults
|
---|
255 | !
|
---|
256 | ! USE ropp2bufr
|
---|
257 | ! CHARACTER (LEN=4) :: centre
|
---|
258 | ! CHARACTER (LEN=100) :: NCDFdsn(100), bufrdsn, csndsn
|
---|
259 | ! INTEGER :: nfiles, gtshdrtype, rejtimediff
|
---|
260 | ! LOGICAL :: corronly, nomet, unordered
|
---|
261 | ! CALL getOptions ( centre, NCDFdsn, nfiles, bufrdsn, csndsn, thindsn, &
|
---|
262 | ! gtshdrtype, rejtimediff, &
|
---|
263 | ! corronly, nomet, unordered, resolution )
|
---|
264 | ! On command line:
|
---|
265 | ! > ropp2bufr ropp_file [ropp_file...] [-o bufr_file]
|
---|
266 | ! [-g[n]] [-s seq_file]
|
---|
267 | ! [-p thin_file] [-t time]
|
---|
268 | ! [-u] [-l] [-m] [-h|?] [-v] [-d]
|
---|
269 | ! > eum2bufr eum_file [eum_file...] [-o bufr_file]
|
---|
270 | ! [-g[n]] [-s seq_file]
|
---|
271 | ! [-p thin_file] [-t time] [-r resol]
|
---|
272 | ! [-u] [-l] [-m] [-h|?] [-v] [-d]
|
---|
273 | !
|
---|
274 | ! INPUTS
|
---|
275 | ! centre chr 'EUM' when called from eum2bufr to encode EUMETSAT netCDF
|
---|
276 | ! files; anyhting else to encode ROPP netCDF files.
|
---|
277 | !
|
---|
278 | ! OUTPUTS
|
---|
279 | ! NCDFdsn chr ROPP/EUM netCDF input file name(s)
|
---|
280 | ! nfiles int No. of ROPP input files
|
---|
281 | ! BUFRdsn chr BUFR output file name
|
---|
282 | ! CSNdsn chr Channel sequence number file name
|
---|
283 | ! Thindsn chr Thinning control file name
|
---|
284 | ! GTShdrType int GTS header type code
|
---|
285 | ! RejTimeDiff int Rejection time threshold (minutes)
|
---|
286 | ! CorrOnly log L1+L2 skip flag
|
---|
287 | ! nomet log Met data skip flag
|
---|
288 | ! unordered log Disable profile ordering flag
|
---|
289 | ! resolution chr resolution group to use in EUM netCDF-4 files
|
---|
290 | !
|
---|
291 | ! CALLS
|
---|
292 | ! Usage
|
---|
293 | ! message
|
---|
294 | ! IARGC
|
---|
295 | ! GETARG
|
---|
296 | !
|
---|
297 | ! CALLED BY
|
---|
298 | ! ropp2bufr
|
---|
299 | ! eum2bufr
|
---|
300 | !
|
---|
301 | ! MODULES
|
---|
302 | ! DateTimeTypes - Date & Time conversion definitions
|
---|
303 | ! GTShdrs - GTS bulletin routing header support definitions
|
---|
304 | !
|
---|
305 | ! DESCRIPTION
|
---|
306 | ! Provides a command line interface for the ROPP-to-BUFR and EUM-to-BUFR
|
---|
307 | ! encoder applications. See comments for main program ropp2bufr & eum2bufr
|
---|
308 | ! for the command line details.
|
---|
309 | !
|
---|
310 | ! SEE ALSO
|
---|
311 | ! ropp2bufr(1), eum2bufr(1)
|
---|
312 | !
|
---|
313 | ! AUTHOR
|
---|
314 | ! Met Office, Exeter, UK.
|
---|
315 | ! Any comments on this software should be given via the ROM SAF
|
---|
316 | ! Helpdesk at http://www.romsaf.org
|
---|
317 | !
|
---|
318 | ! COPYRIGHT
|
---|
319 | ! (c) EUMETSAT. All rights reserved.
|
---|
320 | ! For further details please refer to the file COPYRIGHT
|
---|
321 | ! which you should have received as part of this distribution.
|
---|
322 | !
|
---|
323 | !****
|
---|
324 |
|
---|
325 | ! Modules
|
---|
326 |
|
---|
327 | USE DateTimeTypes, ONLY: nMinPerHour
|
---|
328 | USE GTShdrs, ONLY: GTSHDR_DEBUG
|
---|
329 |
|
---|
330 | IMPLICIT NONE
|
---|
331 |
|
---|
332 | ! Fixed parameters
|
---|
333 |
|
---|
334 | INTEGER, PARAMETER :: DefRejTimeDiff = 1430 ! 23h50m in minutes
|
---|
335 |
|
---|
336 | ! Argument list parameters
|
---|
337 |
|
---|
338 | CHARACTER (LEN=*), INTENT(IN) :: centre ! Centre (e.g. 'EUM')
|
---|
339 | CHARACTER (LEN=*), INTENT(OUT) :: NCDFdsn(:) ! input netCDF file name(s)
|
---|
340 | CHARACTER (LEN=*), INTENT(OUT) :: BUFRdsn ! output BUFR file name
|
---|
341 | CHARACTER (LEN=*), INTENT(OUT) :: CSNdsn ! Channel sequence number file name
|
---|
342 | CHARACTER (LEN=*), INTENT(OUT) :: Thindsn ! thinning control file name
|
---|
343 | INTEGER, INTENT(OUT) :: nfiles ! No. of ROPP input files
|
---|
344 | INTEGER, INTENT(OUT) :: GTShdrType ! code for GTS header generation
|
---|
345 | INTEGER, INTENT(OUT) :: RejTimeDiff ! reject obs older than this
|
---|
346 | LOGICAL, INTENT(OUT) :: CorrOnly ! .F. for L1+L2+C, .T. for C only
|
---|
347 | LOGICAL, INTENT(OUT) :: nomet ! .F. for met data, .T. to skip
|
---|
348 | LOGICAL, INTENT(OUT) :: unordered ! .T. to disable re-ordering of profiles
|
---|
349 | CHARACTER(LEN=20), INTENT(OUT) :: resolution ! resolution group of EUM netCDF 4 files
|
---|
350 |
|
---|
351 | ! Local variables
|
---|
352 |
|
---|
353 | CHARACTER (LEN=256) :: carg ! command line argument
|
---|
354 | INTEGER :: narg ! number of command line arguments
|
---|
355 | INTEGER :: ia ! loop counter
|
---|
356 | INTEGER :: ierr ! error status
|
---|
357 | INTEGER :: hh, mm ! hours & minutes
|
---|
358 |
|
---|
359 | ! Some compilers may need the following declaration to be commented out
|
---|
360 | INTEGER :: IARGC
|
---|
361 |
|
---|
362 | !-------------------------------------------------------------
|
---|
363 | ! 1. Initialise
|
---|
364 | !-------------------------------------------------------------
|
---|
365 |
|
---|
366 | NCDFdsn(:) = " "
|
---|
367 | nfiles = 0
|
---|
368 | BUFRdsn = " "
|
---|
369 | CSNdsn = " "
|
---|
370 | Thindsn = "375" ! to be interpreted as 'sample to no more than'
|
---|
371 | GTShdrType = NOhdrs
|
---|
372 | RejTimeDiff = 0
|
---|
373 | CorrOnly = .FALSE.
|
---|
374 | nomet = .FALSE.
|
---|
375 | unordered = .FALSE.
|
---|
376 | resolution = 'thinned'
|
---|
377 |
|
---|
378 | !-------------------------------------------------------------
|
---|
379 | ! 2. Loop over all command line options.
|
---|
380 | ! If a switch has a trailing blank, then we need to get
|
---|
381 | ! the next string as it's argument.
|
---|
382 | !-------------------------------------------------------------
|
---|
383 |
|
---|
384 | ia = 1
|
---|
385 | narg = IARGC()
|
---|
386 |
|
---|
387 | DO WHILE ( ia <= narg )
|
---|
388 |
|
---|
389 | CALL GETARG ( ia, carg )
|
---|
390 | IF ( carg(1:1) == "?" .OR. &
|
---|
391 | carg(1:6) == "--help" ) carg = "-h"
|
---|
392 | IF ( carg(1:9) == "--version" ) carg = "-v"
|
---|
393 |
|
---|
394 | IF ( carg(1:1) == "-" ) THEN ! is this an option introducer?
|
---|
395 | ! If so, which one?
|
---|
396 | SELECT CASE (carg(2:2))
|
---|
397 |
|
---|
398 | CASE ("d","D") ! debug/diagnostics wanted
|
---|
399 | msg_MODE = VerboseMode
|
---|
400 | GTSHDR_DEBUG = .TRUE.
|
---|
401 |
|
---|
402 | CASE ("g","G") ! GTS headers wanted - any extra IP?
|
---|
403 | SELECT CASE (carg(3:3))
|
---|
404 | CASE ("i","I")
|
---|
405 | GTShdrType = IPhdrs ! headers + IP
|
---|
406 | CASE DEFAULT
|
---|
407 | GTShdrType = ARhdrs ! headers only
|
---|
408 | END SELECT
|
---|
409 |
|
---|
410 | CASE ("h","H") ! Help wanted
|
---|
411 | narg = -1
|
---|
412 |
|
---|
413 | CASE ("l","L") ! no L1/L2 (Corrected only)
|
---|
414 | CorrOnly = .TRUE.
|
---|
415 |
|
---|
416 | CASE ("m","M") ! no Met. (geophysical) data
|
---|
417 | nomet = .TRUE.
|
---|
418 |
|
---|
419 | CASE ("o","O") ! Output file name
|
---|
420 | carg(1:2) = " "
|
---|
421 | IF ( carg(3:) == " " ) THEN
|
---|
422 | ia = ia + 1
|
---|
423 | CALL GETARG ( ia, carg )
|
---|
424 | END IF
|
---|
425 | BUFRdsn = ADJUSTL(carg)
|
---|
426 |
|
---|
427 | CASE ("p","P") ! thinning control file name
|
---|
428 | carg(1:2) = " "
|
---|
429 | IF ( carg(3:) == " " ) THEN
|
---|
430 | ia = ia + 1
|
---|
431 | CALL GETARG ( ia, carg )
|
---|
432 | END IF
|
---|
433 | Thindsn = ADJUSTL(carg)
|
---|
434 |
|
---|
435 | CASE ("r","R") ! resolution group to use (EUM only)
|
---|
436 | carg(1:2) = " "
|
---|
437 | IF ( carg(3:) == " " ) THEN
|
---|
438 | ia = ia + 1
|
---|
439 | CALL GETARG ( ia, carg )
|
---|
440 | END IF
|
---|
441 | IF ( centre == "EUM" ) resolution = ADJUSTL(carg)
|
---|
442 |
|
---|
443 | CASE ("s","S") ! Channel sequence No. file name
|
---|
444 | carg(1:2) = " "
|
---|
445 | IF ( carg(3:) == " " ) THEN
|
---|
446 | ia = ia + 1
|
---|
447 | CALL GETARG ( ia, carg )
|
---|
448 | END IF
|
---|
449 | CSNdsn = ADJUSTL(carg)
|
---|
450 |
|
---|
451 | CASE ("t","T") ! Reject time difference (hh:mm)
|
---|
452 | carg(1:2) = " "
|
---|
453 | IF ( carg(3:) == " " ) THEN
|
---|
454 | ia = ia + 1
|
---|
455 | CALL GETARG ( ia, carg )
|
---|
456 | END IF
|
---|
457 | carg = ADJUSTL(carg)
|
---|
458 | READ ( carg, "(BN,I2,1X,I2)", IOSTAT=ierr ) hh, mm
|
---|
459 | IF ( ierr == 0 ) RejTimeDiff = hh * nMinPerHour + mm
|
---|
460 |
|
---|
461 | CASE ("u","U") ! Profile ordering
|
---|
462 | unordered = .TRUE.
|
---|
463 |
|
---|
464 | CASE ("v","V") ! Only program version ID wanted
|
---|
465 | CALL version_info()
|
---|
466 | CALL EXIT(msg_exit_ok)
|
---|
467 |
|
---|
468 | CASE DEFAULT ! unknown option
|
---|
469 | END SELECT
|
---|
470 |
|
---|
471 | ELSE ! not an option - must be an input name
|
---|
472 | nfiles = nfiles + 1
|
---|
473 | NCDFdsn(nfiles) = carg
|
---|
474 | END IF
|
---|
475 |
|
---|
476 | ia = ia + 1
|
---|
477 | END DO ! argument loop
|
---|
478 |
|
---|
479 | IF ( nfiles == 0 .AND. narg /= -1 ) THEN
|
---|
480 | CALL message ( msg_error, "No input file(s) specified" )
|
---|
481 | narg = 0
|
---|
482 | END IF
|
---|
483 |
|
---|
484 | IF ( narg <= 0 ) THEN
|
---|
485 | IF ( centre == "EUM" ) THEN
|
---|
486 | CALL Usage_eum()
|
---|
487 | ELSE
|
---|
488 | CALL Usage()
|
---|
489 | END IF
|
---|
490 | CALL EXIT(msg_exit_status)
|
---|
491 | END IF
|
---|
492 |
|
---|
493 | !-------------------------------------------------------------
|
---|
494 | ! 3. Set default time rejection if GTS routing headers to be
|
---|
495 | ! generated, on the assumption that the output is for NRT
|
---|
496 | ! GTS distribution.
|
---|
497 | !-------------------------------------------------------------
|
---|
498 |
|
---|
499 | IF ( GTShdrType /= NOhdrs .AND. &
|
---|
500 | RejTimeDiff == 0 ) RejTimeDiff = DefRejTimeDiff
|
---|
501 |
|
---|
502 | END SUBROUTINE GetOptions
|
---|
503 | !----------------------------------------------------------------------------
|
---|
504 |
|
---|
505 | SUBROUTINE ConvertROPPtoBUFR ( ROdata, & ! (in)
|
---|
506 | CorrOnly, & ! (in)
|
---|
507 | OrigICAO, & ! (out)
|
---|
508 | OrigCentre, & ! (out)
|
---|
509 | SubCentre, & ! (out)
|
---|
510 | Values, & ! (out)
|
---|
511 | nValues, & ! (out)
|
---|
512 | RepFac, & ! (out)
|
---|
513 | nRepFac ) ! (out)
|
---|
514 | !
|
---|
515 | !****s* ropp2bufr/ConvertROPPtoBUFR *
|
---|
516 | !
|
---|
517 | ! NAME
|
---|
518 | ! ConvertROPPtoBUFR
|
---|
519 | !
|
---|
520 | ! SYNOPSIS
|
---|
521 | ! Convert ROPP data to BUFR specification
|
---|
522 | !
|
---|
523 | ! USE ropp_io_types
|
---|
524 | ! USE ropp2bufr
|
---|
525 | ! TYPE (ROprof) rodata
|
---|
526 | ! CHARACTER (LEN=4) :: origicao
|
---|
527 | ! INTEGER :: origcentre, subcentre, nvalues, nrepfac, repfac(nr)
|
---|
528 | ! REAL(dp):: values(ne)
|
---|
529 | ! LOGICAL :: corronly
|
---|
530 | ! CALL convertropptobufr ( rodata, corronly, &
|
---|
531 | ! origicao, origcentre, subcentre, &
|
---|
532 | ! values, nvalues, repfac, nrepfac )
|
---|
533 | ! where
|
---|
534 | ! ne is the max. number of elements (data items for BUFR)
|
---|
535 | ! nr is the max. number of delayed replication factors
|
---|
536 | !
|
---|
537 | ! INPUTS
|
---|
538 | ! ROdata dtyp RO data - derived type
|
---|
539 | ! CorrOnly log Flag for corrected Level 1b profile only
|
---|
540 | !
|
---|
541 | ! OUTPUTS
|
---|
542 | ! ROdata dtyp RO data - derived type (potentially modified)
|
---|
543 | ! OrigICAO chr 4-chr ICAO code associated with Orig.Centre
|
---|
544 | ! OrigCentre int Originating Centre code value
|
---|
545 | ! SubCentre int Originating subcentre (processing centre) code value
|
---|
546 | ! Values dflt Array(ne) of converted values for BUFR encoder
|
---|
547 | ! nValues int Total no. of values converted
|
---|
548 | ! RepFac int Array of Replication Factors
|
---|
549 | ! nRepFac int Total no. of Replication Factors
|
---|
550 | !
|
---|
551 | ! MODULES
|
---|
552 | ! ropp_io_types - ROPP file I/O support
|
---|
553 | ! ropp_utils - ROPP utility functions & parameters
|
---|
554 | !
|
---|
555 | ! CALLS
|
---|
556 | ! ConvertCodes
|
---|
557 | ! message
|
---|
558 | ! message_get_routine
|
---|
559 | ! message_set_routine
|
---|
560 | !
|
---|
561 | ! CALLED BY
|
---|
562 | ! ropp2bufr
|
---|
563 | !
|
---|
564 | ! DESCRIPTION
|
---|
565 | ! Converts RO data to BUFR units, etc, and returns converted data as a plain
|
---|
566 | ! 1-D array. This procedure is mostly scaling and/or range changing (e.g
|
---|
567 | ! longitude from 0-360 to +/-180deg, hPa to Pa).
|
---|
568 | ! This routine also performs gross error checking, so that if data is not
|
---|
569 | ! valid (not within nominal range of BUFR bit width) that data value is set
|
---|
570 | ! "missing" in the output array.
|
---|
571 | ! The delayed replication factor counts are also returned for use with
|
---|
572 | ! the ECMWF BUFEN() encoder (not used with the MetDB ENBUFV4() encoder).
|
---|
573 | ! The processing (originating) centre's code & sub-centre code are
|
---|
574 | ! returned for insertion in BUFR Section 1, plus the ICAO Location
|
---|
575 | ! Indicator code for optonal use in a GTS routing header.
|
---|
576 | !
|
---|
577 | ! REFERENCES
|
---|
578 | ! 1) ROPP User Guide - Part I
|
---|
579 | ! SAF/ROM/METO/UG/ROPP/002
|
---|
580 | ! 2) WMO FM94 (BUFR) Specification for ROM SAF Processed Radio
|
---|
581 | ! Occultation Data. SAF/ROM/METO/FMT/BUFR/001
|
---|
582 | !
|
---|
583 | ! AUTHOR
|
---|
584 | ! Met Office, Exeter, UK.
|
---|
585 | ! Any comments on this software should be given via the ROM SAF
|
---|
586 | ! Helpdesk at http://www.romsaf.org
|
---|
587 | !
|
---|
588 | ! COPYRIGHT
|
---|
589 | ! (c) EUMETSAT. All rights reserved.
|
---|
590 | ! For further details please refer to the file COPYRIGHT
|
---|
591 | ! which you should have received as part of this distribution.
|
---|
592 | !
|
---|
593 | !****
|
---|
594 |
|
---|
595 | ! Modules
|
---|
596 |
|
---|
597 | USE ropp_io_types, ONLY: ROprof, &
|
---|
598 | PCD_occultation
|
---|
599 |
|
---|
600 | IMPLICIT NONE
|
---|
601 |
|
---|
602 | ! Fixed parameters
|
---|
603 |
|
---|
604 | REAL(dp), PARAMETER :: MISSING = RVIND ! Missing data flag value
|
---|
605 |
|
---|
606 | INTEGER, PARAMETER :: ProdType = 2 ! Product type (limb sounding)
|
---|
607 | INTEGER, PARAMETER :: TimeSig = 17 ! Time significance (start)
|
---|
608 | INTEGER, PARAMETER :: FOstats = 13 ! First-order statistics (rms)
|
---|
609 |
|
---|
610 | REAL, PARAMETER :: FreqL1 = 1.5E9 ! L1 frequency: 1.5GHz
|
---|
611 | REAL, PARAMETER :: FreqL2 = 1.2E9 ! L1 frequency: 1.2GHz
|
---|
612 | REAL, PARAMETER :: FreqLc = 0.0 ! Corrected frequency (dummy)
|
---|
613 |
|
---|
614 | CHARACTER (LEN=*), PARAMETER :: numeric = "0123456789." ! valid for numerics
|
---|
615 |
|
---|
616 | ! Argument list parameters
|
---|
617 |
|
---|
618 | TYPE (ROprof), INTENT(INOUT) :: ROdata
|
---|
619 | LOGICAL, INTENT(IN) :: CorrOnly
|
---|
620 | CHARACTER (LEN=4), INTENT(OUT) :: OrigICAO
|
---|
621 | INTEGER, INTENT(OUT) :: OrigCentre
|
---|
622 | INTEGER, INTENT(OUT) :: SubCentre
|
---|
623 | REAL(dp), INTENT(OUT) :: Values(:)
|
---|
624 | INTEGER, INTENT(OUT) :: nValues
|
---|
625 | INTEGER, INTENT(OUT) :: RepFac(:)
|
---|
626 | INTEGER, INTENT(OUT) :: nRepFac
|
---|
627 |
|
---|
628 | ! Local parameters
|
---|
629 |
|
---|
630 | CHARACTER (LEN=10) :: number ! temporary strings for numeric values
|
---|
631 | CHARACTER (LEN=256) :: routine ! temporary previously set message routine
|
---|
632 | CHARACTER (LEN=4) :: Ccode ! ICAO code associated with Ocode
|
---|
633 | INTEGER :: Gclass ! GNSS class value
|
---|
634 | INTEGER :: Gcode ! GNSS PRN
|
---|
635 | INTEGER :: Lcode ! LEO code value
|
---|
636 | INTEGER :: Icode ! Instrument code value
|
---|
637 | INTEGER :: Ocode ! Origin. centre code value
|
---|
638 | INTEGER :: Scode ! Sub-centre code value
|
---|
639 | INTEGER :: Bcode ! B/G generator code value
|
---|
640 | INTEGER :: PCD ! PCD bit flags (16-bit)
|
---|
641 | INTEGER :: in ! loop counter for profile arrays
|
---|
642 | INTEGER :: IE ! index offset to Values element
|
---|
643 | INTEGER :: ierr ! I/O error code
|
---|
644 | REAL :: SWver ! Software version number
|
---|
645 |
|
---|
646 | !-------------------------------------------------------------
|
---|
647 | ! 1. Initialise
|
---|
648 | !------------------------------------------------------------
|
---|
649 |
|
---|
650 | CALL message_get_routine ( routine )
|
---|
651 | CALL message_set_routine ( "ConvertROPPtoBUFR" )
|
---|
652 |
|
---|
653 | Values(:) = MISSING
|
---|
654 | nValues = 0
|
---|
655 |
|
---|
656 | RepFac(:) = 0
|
---|
657 | nRepFac = 0
|
---|
658 |
|
---|
659 | !-------------------------------------------------------------
|
---|
660 | ! 2. Convert ROPP character codes to BUFR numeric codes.
|
---|
661 | !-------------------------------------------------------------
|
---|
662 | ! Possible Originating Centre & associated ICAO codes for GPSRO include:
|
---|
663 | ! 007/KWBC - Washington (US) [UCAR/CDAAC]
|
---|
664 | ! 074/EGRR - Exeter (GB) [Met Office]
|
---|
665 | ! 078/EDZW - Offenbach (DE) [GFZ]
|
---|
666 | ! 094/EKMI - Copenhagen (DK) [DMI/ROM SAF]
|
---|
667 | ! 160/KNES - Washington (US) [NESDIS]
|
---|
668 | ! 254/EUMS - Darmstadt (DE) [EUMETSAT]
|
---|
669 | ! See WMO BUFR code table 001033 (Common Code Table C-1 or C-11)
|
---|
670 | ! for the full list of Originating Centres.
|
---|
671 | !-------------------------------------------------------------
|
---|
672 |
|
---|
673 | CALL ConvertCodes ( ROdata, &
|
---|
674 | Gclass, Gcode, &
|
---|
675 | Lcode, Icode, &
|
---|
676 | Ocode, Scode, &
|
---|
677 | Ccode, Bcode, &
|
---|
678 | 1 )
|
---|
679 | OrigICAO = Ccode
|
---|
680 | OrigCentre = Ocode
|
---|
681 | SubCentre = Scode
|
---|
682 |
|
---|
683 | !-------------------------------------------------------------
|
---|
684 | ! 3. Satellite data introducer
|
---|
685 | !-------------------------------------------------------------
|
---|
686 |
|
---|
687 | Values(1) = Lcode ! [001007] LEO ID
|
---|
688 | IF ( Values(1) < 0.0 .OR. &
|
---|
689 | Values(1) > 1022.0 ) &
|
---|
690 | Values(1) = MISSING
|
---|
691 |
|
---|
692 | Values(2) = Icode ! [002019] RO Instrument
|
---|
693 | IF ( Values(2) < 0.0 .OR. &
|
---|
694 | Values(2) > 2046.0 ) &
|
---|
695 | Values(2) = MISSING
|
---|
696 |
|
---|
697 | IF ( BTEST(ROdata%PCD,PCD_occultation) ) THEN
|
---|
698 | Values(3) = Bcode ! [001033] B/g gen.centre
|
---|
699 | ELSE
|
---|
700 | Values(3) = Ocode ! [001033] Proc.centre
|
---|
701 | END IF
|
---|
702 | IF ( Values(3) < 0.0 .OR. &
|
---|
703 | Values(3) > 254.0 ) &
|
---|
704 | Values(3) = MISSING
|
---|
705 |
|
---|
706 | Values(4) = ProdType ! [002172] Product type
|
---|
707 | ! (limb sounding)
|
---|
708 | number = ROdata%Software_Version(1:10)
|
---|
709 | DO in = 1, LEN_TRIM(number)
|
---|
710 | IF ( INDEX ( numeric, number(in:in) ) == 0 ) number(in:in) = " "
|
---|
711 | END DO
|
---|
712 | READ ( number, FMT=*, IOSTAT=ierr) SWver
|
---|
713 | IF ( ierr /= 0 ) SWver = -9.999
|
---|
714 | Values(5) = SWver * 1E3 ! [025060] Software version
|
---|
715 | IF ( Values(5) < 0.0 .OR. &
|
---|
716 | Values(5) > 16382.0 ) &
|
---|
717 | Values(5) = MISSING
|
---|
718 |
|
---|
719 | ! Date/time of start of occultation (or background profile)
|
---|
720 |
|
---|
721 | Values(6) = TimeSig ! [008021] Time.sig (start)
|
---|
722 | Values(7) = ROdata%DTocc%Year ! [004001] Year
|
---|
723 | Values(8) = ROdata%DTocc%Month ! [004002] Month
|
---|
724 | Values(9) = ROdata%DTocc%Day ! [004003] Day
|
---|
725 | Values(10) = ROdata%DTocc%Hour ! [004004] Hour
|
---|
726 | Values(11) = ROdata%DTocc%Minute ! [004005] Minute
|
---|
727 | Values(12) = ROdata%DTocc%Second & ! [004006] Seconds & MSecs
|
---|
728 | + ROdata%DTocc%MSec * 1E-3
|
---|
729 | IF ( Values(12) < 0.000 .OR. &
|
---|
730 | Values(12) > 59.999 ) &
|
---|
731 | Values(12) = MISSING
|
---|
732 |
|
---|
733 | ! Summary quality information
|
---|
734 |
|
---|
735 | PCD = 0
|
---|
736 | DO in = 0, 15
|
---|
737 | IF ( BTEST(ROdata%PCD, in) ) PCD = IBSET(PCD, 15-in) ! only use 1st 16 bits in swapped bit order
|
---|
738 | END DO
|
---|
739 | Values(13) = REAL(PCD) ! [033039] PCD
|
---|
740 | IF ( Values(13) < 0.0 .OR. &
|
---|
741 | Values(13) > 65534.0 ) &
|
---|
742 | Values(13) = MISSING
|
---|
743 |
|
---|
744 | Values(14) = REAL(ROdata%Overall_Qual) ! [033007] Percent confidence
|
---|
745 | IF ( Values(14) < 0.0 .OR. &
|
---|
746 | Values(14) > 100.0 ) &
|
---|
747 | Values(14) = MISSING
|
---|
748 |
|
---|
749 | ! LEO & GNSS POD
|
---|
750 |
|
---|
751 | IF ( .NOT. ROdata%Lev1a%Missing ) THEN
|
---|
752 | Values(15) = REAL(ROdata%Lev1a%R_LEO(1,1)) ! [027031] LEO X posn (m)
|
---|
753 | IF ( ABS(Values(15)) > 10737418.23_dp ) &
|
---|
754 | Values(15) = MISSING
|
---|
755 | Values(16) = REAL(ROdata%Lev1a%R_LEO(1,2)) ! [028031] LEO Y posn (m)
|
---|
756 | IF ( ABS(Values(16)) > 10737418.23_dp ) &
|
---|
757 | Values(16) = MISSING
|
---|
758 | Values(17) = REAL(ROdata%Lev1a%R_LEO(1,3)) ! [010031] LEO Z posn (m)
|
---|
759 | IF ( ABS(Values(17)) > 10737418.23_dp ) &
|
---|
760 | Values(17) = MISSING
|
---|
761 | IF ( ABS(Values(15)) < 1.0 .AND. &
|
---|
762 | ABS(Values(16)) < 1.0 .AND. &
|
---|
763 | ABS(Values(17)) < 1.0 ) &
|
---|
764 | Values(15:17) = MISSING
|
---|
765 | Values(18) = REAL(ROdata%Lev1a%V_LEO(1,1)) ! [001041] LEO X vely (m/s)
|
---|
766 | IF ( ABS(Values(18)) > 10737.41823_dp ) &
|
---|
767 | Values(18) = MISSING
|
---|
768 | Values(19) = REAL(ROdata%Lev1a%V_LEO(1,2)) ! [001042] LEO Y vely (m/s)
|
---|
769 | IF ( ABS(Values(19)) > 10737.41823_dp ) &
|
---|
770 | Values(19) = MISSING
|
---|
771 | Values(20) = REAL(ROdata%Lev1a%V_LEO(1,3)) ! [001043] LEO Z vely (m/s)
|
---|
772 | IF ( ABS(Values(20)) > 10737.41823_dp ) &
|
---|
773 | Values(20) = MISSING
|
---|
774 | IF ( ABS(Values(18)) < 1.0 .AND. &
|
---|
775 | ABS(Values(19)) < 1.0 .AND. &
|
---|
776 | ABS(Values(20)) < 1.0 ) &
|
---|
777 | Values(18:20) = MISSING
|
---|
778 | END IF
|
---|
779 |
|
---|
780 | Values(21) = Gclass ! [002020] GNSS class
|
---|
781 | IF ( Values(21) < 0 .OR. &
|
---|
782 | Values(21) > 510 ) Values(21) = MISSING
|
---|
783 | Values(22) = Gcode ! [001050] GNSS PRN
|
---|
784 | IF ( Values(22) < 0 .OR. &
|
---|
785 | Values(22) > 131070 ) Values(22) = MISSING
|
---|
786 |
|
---|
787 | IF ( .NOT. ROdata%Lev1a%Missing ) THEN
|
---|
788 | Values(23) = REAL(ROdata%Lev1a%R_GNS(1,1)) ! [027031] GNSS X posn (m)
|
---|
789 | IF ( ABS(Values(23)) > 107374182.4_dp ) &
|
---|
790 | Values(23) = MISSING
|
---|
791 | Values(24) = REAL(ROdata%Lev1a%R_GNS(1,2)) ! [028031] GNSS Y posn (m)
|
---|
792 | IF ( ABS(Values(24)) > 107374182.4_dp ) &
|
---|
793 | Values(24) = MISSING
|
---|
794 | Values(25) = REAL(ROdata%Lev1a%R_GNS(1,3)) ! [010031] GNSS Z posn (m)
|
---|
795 | IF ( ABS(Values(25)) > 107374182.4_dp ) &
|
---|
796 | Values(25) = MISSING
|
---|
797 | IF ( ABS(Values(23)) < 1.0 .AND. &
|
---|
798 | ABS(Values(24)) < 1.0 .AND. &
|
---|
799 | ABS(Values(25)) < 1.0 ) &
|
---|
800 | Values(23:25) = MISSING
|
---|
801 |
|
---|
802 | Values(26) = REAL(ROdata%Lev1a%V_GNS(1,1)) ! [001041] GNSS X vely (m/s)
|
---|
803 | IF ( ABS(Values(26)) > 10737.41824_dp ) &
|
---|
804 | Values(26) = MISSING
|
---|
805 | Values(27) = REAL(ROdata%Lev1a%V_GNS(1,2)) ! [001042] GNSS Y vely (m/s)
|
---|
806 | IF ( ABS(Values(27)) > 10737.41824_dp ) &
|
---|
807 | Values(27) = MISSING
|
---|
808 | Values(28) = REAL(ROdata%Lev1a%V_GNS(1,3)) ! [001043] GNSS Z vely (m/s)
|
---|
809 | IF ( ABS(Values(28)) > 10737.41824_dp ) &
|
---|
810 | Values(28) = MISSING
|
---|
811 | IF ( ABS(Values(26)) < 1.0 .AND. &
|
---|
812 | ABS(Values(27)) < 1.0 .AND. &
|
---|
813 | ABS(Values(28)) < 1.0 ) &
|
---|
814 | Values(26:28) = MISSING
|
---|
815 | END IF
|
---|
816 |
|
---|
817 | ! Local Earth parameters
|
---|
818 |
|
---|
819 | Values(29) = REAL(ROdata%GeoRef%Time_Offset) ! [004016] Time/start (s)
|
---|
820 | IF ( Values(29) < 0.0 .OR. &
|
---|
821 | Values(29) > 240.0 ) &
|
---|
822 | Values(29) = MISSING
|
---|
823 |
|
---|
824 | Values(30) = REAL(ROdata%GeoRef%Lat) ! [005001] Latitude (deg)
|
---|
825 | IF ( ABS(Values(30)) > 90.0 ) &
|
---|
826 | Values(30) = MISSING
|
---|
827 |
|
---|
828 | Values(31) = REAL(ROdata%GeoRef%Lon) ! [006001] Longitude (deg)
|
---|
829 | IF ( Values(31) > 180.0 ) &
|
---|
830 | Values(31) = Values(31) - 360.0
|
---|
831 | IF ( ABS(Values(31)) > 180.0 ) &
|
---|
832 | Values(31) = MISSING
|
---|
833 |
|
---|
834 | Values(32) = REAL(ROdata%GeoRef%r_CoC(1)) ! [027031] CofC X (m)
|
---|
835 | IF ( ABS(Values(32)) > 1000000.0_dp ) &
|
---|
836 | Values(32) = MISSING
|
---|
837 |
|
---|
838 | Values(33) = REAL(ROdata%GeoRef%r_CoC(2)) ! [028031] CofC Y (m)
|
---|
839 | IF ( ABS(Values(33)) > 1000000.0_dp ) &
|
---|
840 | Values(33) = MISSING
|
---|
841 |
|
---|
842 | Values(34) = REAL(ROdata%GeoRef%r_CoC(3)) ! [010031] CofC Z (m)
|
---|
843 | IF ( ABS(Values(34)) > 1000000.0_dp ) &
|
---|
844 | Values(34) = MISSING
|
---|
845 |
|
---|
846 | Values(35) = REAL(ROdata%GeoRef%RoC) ! [010035] Radius value (m)
|
---|
847 | IF ( Values(35) < 6200000.0_dp .OR. &
|
---|
848 | Values(35) > 6600000.0_dp ) &
|
---|
849 | Values(35) = MISSING
|
---|
850 |
|
---|
851 | Values(36) = REAL(ROdata%GeoRef%Azimuth) ! [005021] Line of sight bearing (degT)
|
---|
852 | IF ( Values(36) < 0.0 .OR. &
|
---|
853 | Values(36) >= 360.0 ) &
|
---|
854 | Values(36) = MISSING
|
---|
855 |
|
---|
856 | Values(37) = REAL(ROdata%GeoRef%Undulation) ! [010036] Geoid undulation (m)
|
---|
857 | IF ( ABS(Values(37)) > 163.82 ) &
|
---|
858 | Values(37) = MISSING
|
---|
859 |
|
---|
860 | IE = 37
|
---|
861 |
|
---|
862 | !-------------------------------------------------------------
|
---|
863 | ! 4. Level 1b data (bending angle profile)
|
---|
864 | !-------------------------------------------------------------
|
---|
865 |
|
---|
866 | ! Interpolation thinning may generate a set of fixed impact height
|
---|
867 | ! levels but no valid Level 1b profile data if no input L1b - reject such
|
---|
868 | ! empty BA-profiles
|
---|
869 |
|
---|
870 | IF ( ROdata%Lev1b%Missing ) THEN
|
---|
871 | CALL message(msg_diag, "Rejecting empty Level 1b (BA) profile")
|
---|
872 | ROdata%Lev1b%Npoints = 0
|
---|
873 | END IF
|
---|
874 |
|
---|
875 | Values(IE+1) = ROdata%Lev1b%Npoints ! [031002] Replication factor
|
---|
876 | nRepFac = nRepFac + 1
|
---|
877 | RepFac(nRepFac) = NINT(Values(IE+1))
|
---|
878 |
|
---|
879 | DO in = 1, ROdata%Lev1b%Npoints
|
---|
880 |
|
---|
881 | ! Coordinates
|
---|
882 |
|
---|
883 | Values(IE+2) = REAL(ROdata%Lev1b%Lat_tp(in)) ! [005001] Latitude (deg)
|
---|
884 | IF ( ABS(Values(IE+2)) > 90.0 ) &
|
---|
885 | Values(IE+2) = MISSING
|
---|
886 |
|
---|
887 | Values(IE+3) = REAL(ROdata%Lev1b%Lon_tp(in)) ! [006001] Longitude (deg)
|
---|
888 | IF ( Values(IE+3) > 180.0 ) &
|
---|
889 | Values(IE+3) = Values(IE+3) - 360.0
|
---|
890 | IF ( ABS(Values(IE+3)) > 180.0 ) &
|
---|
891 | Values(IE+3) = MISSING
|
---|
892 |
|
---|
893 | Values(IE+4) = REAL(ROdata%Lev1b%Azimuth_tp(in)) ! [005021] Line of sight bearing (degT)
|
---|
894 | IF ( Values(IE+4) < 0.0 .OR. &
|
---|
895 | Values(IE+4) >= 360.0 ) &
|
---|
896 | Values(IE+4) = MISSING
|
---|
897 |
|
---|
898 | ! Include L1+L2 or skip them?
|
---|
899 |
|
---|
900 | nRepFac = nRepFac + 1
|
---|
901 | IF ( CorrOnly ) THEN
|
---|
902 | Values(IE+5) = 1 ! [031001] Replication factor
|
---|
903 | IE = IE - 12
|
---|
904 | RepFac(nRepFac) = 1
|
---|
905 | ELSE
|
---|
906 | Values(IE+5) = 3 ! [031001] Replication factor
|
---|
907 | RepFac(nRepFac) = 3
|
---|
908 |
|
---|
909 | ! L1 data
|
---|
910 |
|
---|
911 | Values(IE+6) = FreqL1 ! [002121] L1=1.5Ghz
|
---|
912 |
|
---|
913 | Values(IE+7) = REAL(ROdata%Lev1b%Impact_L1(in), KIND=dp) ! [007040] Impact parameter (m)
|
---|
914 | IF ( Values(IE+7) < 6200000.0_dp .OR. &
|
---|
915 | Values(IE+7) > 6600000.0_dp ) &
|
---|
916 | Values(IE+7) = MISSING
|
---|
917 |
|
---|
918 | Values(IE+8) = REAL(ROdata%Lev1b%BAngle_L1(in)) ! [015037] B/angle (rad)
|
---|
919 | IF ( Values(IE+8) < -0.001 .OR. &
|
---|
920 | Values(IE+8) > 0.08288 ) &
|
---|
921 | Values(IE+8) = MISSING
|
---|
922 |
|
---|
923 | Values(IE+9) = FOstats ! [008023] 1st order stats (rms)
|
---|
924 |
|
---|
925 | Values(IE+10) = REAL(ROdata%Lev1b%BAngle_L1_Sigma(in)) ! [015037] B/angle error (rad)
|
---|
926 | IF ( Values(IE+10) < 0.0 .OR. &
|
---|
927 | Values(IE+10) > 0.009485 ) & ! 1/8 (-3 bits) from 015037
|
---|
928 | Values(IE+10) = MISSING
|
---|
929 |
|
---|
930 | Values(IE+11) = MISSING ! [008023] 1st order stats (off)
|
---|
931 |
|
---|
932 | ! L2 data
|
---|
933 |
|
---|
934 | Values(IE+12) = FreqL2 ! [002121] L2=1.2Ghz
|
---|
935 |
|
---|
936 | Values(IE+13) = REAL(ROdata%Lev1b%Impact_L2(in), KIND=dp) ! [007040] Impact parameter (m)
|
---|
937 | IF ( Values(IE+13) < 6200000.0_dp .OR. &
|
---|
938 | Values(IE+13) > 6600000.0_dp ) &
|
---|
939 | Values(IE+13) = MISSING
|
---|
940 |
|
---|
941 | Values(IE+14) = REAL(ROdata%Lev1b%BAngle_L2(in)) ! [015037] B/angle (rad)
|
---|
942 | IF ( Values(IE+14) < -0.001 .OR. &
|
---|
943 | Values(IE+14) > 0.08288 ) &
|
---|
944 | Values(IE+14) = MISSING
|
---|
945 |
|
---|
946 | Values(IE+15) = FOstats ! [008023] 1st order stats (rms)
|
---|
947 |
|
---|
948 | Values(IE+16) = REAL(ROdata%Lev1b%BAngle_L2_Sigma(in)) ! [015037] B/angle error (rad)
|
---|
949 | IF ( Values(IE+16) < 0.0 .OR. &
|
---|
950 | Values(IE+16) > 0.009485 ) & ! 1/8 (-3 bits) from 015037
|
---|
951 | Values(IE+16) = MISSING
|
---|
952 |
|
---|
953 | Values(IE+17) = MISSING ! [008023] 1st order stats (off)
|
---|
954 | END IF
|
---|
955 |
|
---|
956 | ! Corrected bending angle (always encoded)
|
---|
957 |
|
---|
958 | Values(IE+18) = FreqLc ! [002121] corrected
|
---|
959 |
|
---|
960 | Values(IE+19) = REAL(ROdata%Lev1b%Impact(in), KIND=dp) ! [007040] Impact parameter (m)
|
---|
961 | IF ( Values(IE+19) < 6200000.0_dp .OR. &
|
---|
962 | Values(IE+19) > 6600000.0_dp ) &
|
---|
963 | Values(IE+19) = MISSING
|
---|
964 |
|
---|
965 | Values(IE+20) = REAL(ROdata%Lev1b%BAngle(in)) ! [015037] B/Ang (rad)
|
---|
966 | IF ( Values(IE+20) < -0.001 .OR. &
|
---|
967 | Values(IE+20) > 0.08288 ) &
|
---|
968 | Values(IE+20) = MISSING
|
---|
969 |
|
---|
970 | Values(IE+21) = FOstats ! [008023] 1st order stats (rms)
|
---|
971 |
|
---|
972 | Values(IE+22) = REAL(ROdata%Lev1b%BAngle_Sigma(in)) ! [015037] Error in B/Ang (rad)
|
---|
973 | IF ( Values(IE+22) < 0.0 .OR. &
|
---|
974 | Values(IE+22) > 0.009485 ) & ! 1/8 (-3 bits) from 015037
|
---|
975 | Values(IE+22) = MISSING
|
---|
976 |
|
---|
977 | Values(IE+23) = MISSING ! [008023] 1st order stats (off)
|
---|
978 |
|
---|
979 | Values(IE+24) = REAL(ROdata%Lev1b%Bangle_Qual(in)) ! [033007] Percent confidence
|
---|
980 | IF ( Values(IE+24) < 0.0 .OR. &
|
---|
981 | Values(IE+24) > 100.0 ) &
|
---|
982 | Values(IE+24) = MISSING
|
---|
983 |
|
---|
984 | IE = IE + 23
|
---|
985 | END DO
|
---|
986 | IE = IE + 1
|
---|
987 |
|
---|
988 | !-------------------------------------------------------------
|
---|
989 | ! 5. Level 2a data (derived refractivity profile)
|
---|
990 | !-------------------------------------------------------------
|
---|
991 |
|
---|
992 | ! Interpolation thinning may generate a set of fixed geometric height
|
---|
993 | ! levels but no valid Level 2a profile data if no input L2a - reject such
|
---|
994 | ! empty N-profiles
|
---|
995 |
|
---|
996 | IF ( ROdata%Lev2a%Missing ) THEN
|
---|
997 | CALL message(msg_diag, "Rejecting empty Level 2a (N) profile")
|
---|
998 | ROdata%Lev2a%Npoints = 0
|
---|
999 | END IF
|
---|
1000 |
|
---|
1001 | Values(IE+1) = ROdata%Lev2a%Npoints ! [031002] Replication factor
|
---|
1002 | nRepFac = nRepFac + 1
|
---|
1003 | RepFac(nRepFac) = NINT(Values(IE+1))
|
---|
1004 |
|
---|
1005 | DO in = 1, ROdata%Lev2a%Npoints
|
---|
1006 |
|
---|
1007 | Values(IE+2) = REAL(ROdata%Lev2a%Alt_Refrac(in)) ! [007007] Height amsl (m)
|
---|
1008 | IF ( Values(IE+2) < -1000.0_dp .OR. &
|
---|
1009 | Values(IE+2) > 100000.0_dp ) &
|
---|
1010 | Values(IE+2) = MISSING
|
---|
1011 |
|
---|
1012 | Values(IE+3) = REAL(ROdata%Lev2a%Refrac(in)) ! [015036] Refrac (N-units)
|
---|
1013 | IF ( Values(IE+3) < 0.0 .OR. &
|
---|
1014 | Values(IE+3) > 524.28 ) &
|
---|
1015 | Values(IE+3) = MISSING
|
---|
1016 |
|
---|
1017 | Values(IE+4) = FOstats ! [008023] 1st order stats (rms)
|
---|
1018 |
|
---|
1019 | Values(IE+5) = REAL(ROdata%Lev2a%Refrac_Sigma(in)) ! [015036] Refrac error (N-units)
|
---|
1020 | IF ( Values(IE+5) < 0.0 .OR. &
|
---|
1021 | Values(IE+5) > 16.38 ) & ! 1/32 (-5 bits) from 015036
|
---|
1022 | Values(IE+5) = MISSING
|
---|
1023 |
|
---|
1024 | Values(IE+6) = MISSING ! [008023] 1st order stats (off)
|
---|
1025 |
|
---|
1026 | Values(IE+7) = REAL(ROdata%Lev2a%Refrac_Qual(in)) ! [033007] Percent confidence
|
---|
1027 | IF ( Values(IE+7) < 0.0 .OR. &
|
---|
1028 | Values(IE+7) > 100.0 ) &
|
---|
1029 | Values(IE+7) = MISSING
|
---|
1030 |
|
---|
1031 | IE = IE + 6
|
---|
1032 | END DO
|
---|
1033 | IE = IE + 1
|
---|
1034 |
|
---|
1035 | !-------------------------------------------------------------
|
---|
1036 | ! 6. Level 2b data (retrieved P,T,q profile)
|
---|
1037 | !-------------------------------------------------------------
|
---|
1038 |
|
---|
1039 | ! Interpolation thinning may generate a set of fixed geopotential height
|
---|
1040 | ! levels but no valid Level 2b profile data if no input L2b - reject such
|
---|
1041 | ! empty P,T,q-profiles
|
---|
1042 |
|
---|
1043 |
|
---|
1044 | IF ( ROdata%Lev2b%Missing ) THEN
|
---|
1045 | CALL message(msg_diag, "Rejecting empty Level 2b (T,q,P) profile")
|
---|
1046 | ROdata%Lev2b%Npoints = 0
|
---|
1047 | END IF
|
---|
1048 |
|
---|
1049 | Values(IE+1) = ROdata%Lev2b%Npoints ! [031002] Replication factor
|
---|
1050 | nRepFac = nRepFac + 1
|
---|
1051 | RepFac(nRepFac) = NINT(Values(IE+1))
|
---|
1052 |
|
---|
1053 | DO in = 1, ROdata%Lev2b%Npoints
|
---|
1054 |
|
---|
1055 | Values(IE+2) = REAL(ROdata%Lev2b%Geop(in)) ! [007009] Geopot ht (gpm)
|
---|
1056 | IF ( Values(IE+2) < -1000.0_dp .OR. &
|
---|
1057 | Values(IE+2) > 100000.0_dp ) &
|
---|
1058 | Values(IE+2) = MISSING
|
---|
1059 |
|
---|
1060 | Values(IE+3) = REAL(ROdata%Lev2b%Press(in)) * 1E2 ! [010004] Pressure (Pa)
|
---|
1061 | IF ( Values(IE+3) <= 0.0_dp .OR. & ! Min. 0.1hPa
|
---|
1062 | Values(IE+3) > 150000.0_dp ) &
|
---|
1063 | Values(IE+3) = MISSING
|
---|
1064 |
|
---|
1065 | Values(IE+4) = REAL(ROdata%Lev2b%Temp(in)) ! [012001] Temperature (K)
|
---|
1066 | IF ( Values(IE+4) < 150.0 .OR. &
|
---|
1067 | Values(IE+4) > 350.0 ) &
|
---|
1068 | Values(IE+4) = MISSING
|
---|
1069 |
|
---|
1070 | Values(IE+5) = REAL(ROdata%Lev2b%SHum(in)) * 1E-3 ! [013001] Spec/humidity (Kg/Kg)
|
---|
1071 | IF ( Values(IE+5) < 0.0 .OR. &
|
---|
1072 | Values(IE+5) > 0.16 ) &
|
---|
1073 | Values(IE+5) = MISSING
|
---|
1074 |
|
---|
1075 | Values(IE+6) = FOstats ! [008023] 1st order stats (rms)
|
---|
1076 |
|
---|
1077 | Values(IE+7) = REAL(ROdata%Lev2b%Press_Sigma(in)) * 1E2 ! [010004] Pressure error (Pa)
|
---|
1078 | IF ( Values(IE+7) < 0.0 .OR. &
|
---|
1079 | Values(IE+7) > 620.0 ) &
|
---|
1080 | Values(IE+7) = MISSING
|
---|
1081 |
|
---|
1082 | Values(IE+8) = REAL(ROdata%Lev2b%Temp_Sigma(in)) ! [012001] Temperature error (K)
|
---|
1083 | IF ( Values(IE+8) < 0.0 .OR. &
|
---|
1084 | Values(IE+8) > 6.2 ) &
|
---|
1085 | Values(IE+8) = MISSING
|
---|
1086 |
|
---|
1087 | Values(IE+9) = REAL(ROdata%Lev2b%SHum_Sigma(in)) * 1E-3 ! [013001] S/Hum error (Kg/Kg)
|
---|
1088 | IF ( Values(IE+9) < 0.0 .OR. &
|
---|
1089 | Values(IE+9) > 0.0051 ) &
|
---|
1090 | Values(IE+9) = MISSING
|
---|
1091 |
|
---|
1092 | Values(IE+10) = MISSING ! [008023] 1st order stats (off)
|
---|
1093 |
|
---|
1094 | Values(IE+11) = REAL(ROdata%Lev2b%Meteo_Qual(in)) ! [033007] Percent confidence
|
---|
1095 | IF ( Values(IE+11) < 0.0 .OR. &
|
---|
1096 | Values(IE+11) > 100.0 ) &
|
---|
1097 | Values(IE+11) = MISSING
|
---|
1098 |
|
---|
1099 | IE = IE + 10
|
---|
1100 | END DO
|
---|
1101 | IE = IE + 1
|
---|
1102 |
|
---|
1103 | !-------------------------------------------------------------
|
---|
1104 | ! 7. Level 2c data (retrieved surface params)
|
---|
1105 | !-------------------------------------------------------------
|
---|
1106 |
|
---|
1107 | Values(IE+1) = 0 ! [008003] Vertical sig. (surf)
|
---|
1108 |
|
---|
1109 | VALUES(IE+2) = REAL(ROdata%Lev2c%Geop_Sfc) ! [007009] Geoptot.Ht. (of surf) (gpm)
|
---|
1110 | IF ( Values(IE+2) < -1000.0_dp .OR. &
|
---|
1111 | Values(IE+2) > 10000.0_dp ) &
|
---|
1112 | Values(IE+2) = MISSING
|
---|
1113 |
|
---|
1114 | Values(IE+3) = REAL(ROdata%Lev2c%Press_Sfc) * 1E2 ! [010004] Surface pressure (Pa)
|
---|
1115 | IF ( Values(IE+3) < 0.0_dp .OR. &
|
---|
1116 | Values(IE+3) > 150000.0_dp ) &
|
---|
1117 | Values(IE+3) = MISSING
|
---|
1118 |
|
---|
1119 | Values(IE+4) = FOstats ! [008023] 1st order stats (rms)
|
---|
1120 |
|
---|
1121 | Values(IE+5) = REAL(ROdata%Lev2c%Press_Sfc_Sigma) * 1E2 ! [010004] S/press error (Pa)
|
---|
1122 | IF ( Values(IE+5) < 0.0 .OR. &
|
---|
1123 | Values(IE+5) > 620.0 ) &
|
---|
1124 | Values(IE+5) = MISSING
|
---|
1125 |
|
---|
1126 | Values(IE+6) = MISSING ! [008023] 1st order stats (off)
|
---|
1127 |
|
---|
1128 | Values(IE+7) = REAL(ROdata%Lev2c%Press_Sfc_Qual) ! [033007] Percent confidence
|
---|
1129 | IF ( Values(IE+7) < 0.0 .OR. &
|
---|
1130 | Values(IE+7) > 100.0 ) &
|
---|
1131 | Values(IE+7) = MISSING
|
---|
1132 |
|
---|
1133 | nValues = IE + 7 ! Total no. of values
|
---|
1134 |
|
---|
1135 | !-------------------------------------------------------------
|
---|
1136 | ! 8. Tidy up before return
|
---|
1137 | !-------------------------------------------------------------
|
---|
1138 |
|
---|
1139 | CALL message_set_routine(routine)
|
---|
1140 |
|
---|
1141 | END SUBROUTINE ConvertROPPtoBUFR
|
---|
1142 | !--------------------------------------------------------------------
|
---|
1143 |
|
---|
1144 | END MODULE ropp2bufr
|
---|