Ticket #470: ropp2bufr_mod.f90.30062016

File ropp2bufr_mod.f90.30062016, 41.0 KB (added by Ian Culverwell, 8 years ago)

ropp2bufr_mod.f90.30062016

Line 
1! $Id: ropp2bufr_mod.f90 4452 2015-01-29 14:42:02Z idculv $
2
3MODULE 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
77CONTAINS
78!--------------------------------------------------------------------
79
80SUBROUTINE 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 *, ''
153END SUBROUTINE Usage
154!--------------------------------------------------------------------
155
156SUBROUTINE 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 *, ''
231END SUBROUTINE Usage_eum
232
233!-------------------------------------------------------------------------
234
235SUBROUTINE 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
502END SUBROUTINE GetOptions
503!----------------------------------------------------------------------------
504
505SUBROUTINE 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
1141END SUBROUTINE ConvertROPPtoBUFR
1142!--------------------------------------------------------------------
1143
1144END MODULE ropp2bufr