| 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
|
|---|