bufr.pm:bufrdump

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
Next revision 		Previous revision
bufr.pm:bufrdump [2015-03-18 13:19:19]
pals 		bufr.pm:bufrdump [2022-05-31 09:29:31] (current)
Line 1: Line 1:
-Use this in Makefile, with $(FC) set to your Fortran compiler (e.g. gfortran or g77), $(LDIR) set to the directory where libbufr.a is located, and $(FCFLAGS) set to -fbackslash for gfortran+Use this in Makefile, with $(FC) set to your Fortran compiler (e.g. gfortran or g77), $(LDIR) set to the directory where libbufr.a is located, and $(FCFLAGS) set to -fbackslash for gfortran. Note that code for comfilter.f is found at the end of this page (below the code for bufrdump.F).
  
 <code> <code>
Line 7: Line 7:
  
 <code fortran bufrdump.F> <code fortran bufrdump.F>
-C (C) Copyright 2010, met.no+C (C) Copyright 2010-2016 MET Norway
 C C
 C This program is free software; you can redistribute it and/or modify C This program is free software; you can redistribute it and/or modify
Line 49: Line 49:
 C export BUFR_TABLES=/usr/local/lib/bufrtables/ C export BUFR_TABLES=/usr/local/lib/bufrtables/
 C C
-C Author: P.Sannes met.no 2010+C Author: P.Sannes, MET Norway
  
  
Line 161: Line 161:
       INTEGER verbose       INTEGER verbose
  
 +      LOGICAL metar             ! Set to TRUE if metar (data subcategory 5) 
 +      
       INTEGER kelem,kxelem      ! expected (max) number of expanded elements       INTEGER kelem,kxelem      ! expected (max) number of expanded elements
       INTEGER kvals             ! expected (max) number of data values       INTEGER kvals             ! expected (max) number of data values
Line 208: Line 209:
  
       kerr = 0       kerr = 0
 +      metar = .FALSE. 
 +      
 C     Do a partial expansion without quality control C     Do a partial expansion without quality control
       kreq(1) = 1               ! All original elements without quality control       kreq(1) = 1               ! All original elements without quality control
Line 226: Line 228:
 C C
  
-C     Using parameter kelem in call to BUFREX might be too big for +C     Using parameter kelem in call to BUFREX might be too big for some 
-C     multisubset messages. Have copied the method used in decode_bufr.F +C     multisubset messages (or too small for other messages). Have 
-C     in libbufr, first calling BUS012 in order to get number of subsets +C     copied the method used in decode_bufr.F in libbufr, first calling 
-C     ksup(6)+C     BUS012 in order to get number of subsets ksup(6)
       CALL BUS012(ilen,ibuff,ksup,ksec0,ksec1,ksec2,kerr)       CALL BUS012(ilen,ibuff,ksup,ksec0,ksec1,ksec2,kerr)
       IF (kerr.NE.0) THEN       IF (kerr.NE.0) THEN
Line 238: Line 240:
       END IF       END IF
       kxelem = kvals/ksup(6)       kxelem = kvals/ksup(6)
-      IF (kxelem .GT. kelem) kxelem = kelem+C     The second IF-condition is not in decode_bufr.F, but else I get 'KELEM 
 +C     ARGUMENT TOO SMALL' from BUUPWT when decoding large radiosondefiles 
 +      IF (kxelem.GT.kelem .AND. ksup(6).GT.10) kxelem = kelem
  
       CALL BUFREX (ilen,ibuff,ksup,ksec0,ksec1,ksec2,       CALL BUFREX (ilen,ibuff,ksup,ksec0,ksec1,ksec2,
Line 253: Line 257:
      +     'Number of subsets:',ksup(6)      +     'Number of subsets:',ksup(6)
  
-C     Convert messages with data category (BUFR table A) 0-2 and 4 only.+C     Convert messages with data category (BUFR table A) 0-2,4,6 and 31 only.
 C     0 = Surface data - land, 1 = Surface data - sea, 2 = Vertical C     0 = Surface data - land, 1 = Surface data - sea, 2 = Vertical
 C     sounding (other than satellite) 4 = Single level upper-air data C     sounding (other than satellite) 4 = Single level upper-air data
-C     (other than satellite) +C     (other than satellite) 6 = Radar data 31 = Oceanographic data 
-      IF (ksec1(6).GT.2 .AND. ksec1(6).NE.4 .AND. ksec1(6).NE.31) RETURN+      IF (ksec1(6).GT.2 .AND. ksec1(6).NE.4 .AND. ksec1(6).NE.6 
 +     +     .AND. ksec1(6).NE.31) RETURN 
 + 
 +C     MET (and perhaps also other ECMWF based software?) uses local 
 +C     subcategory 5 for metar (and BUFR edition 3) 
 +      IF (KSEC1(2).EQ.3 .AND. KSEC1(6).EQ.0 .AND. KSEC1(7).EQ.5) THEN 
 +         metar = .TRUE. 
 +      END IF
  
       IF (filter) THEN       IF (filter) THEN
Line 293: Line 304:
             IF (obstype.EQ.'surface') THEN             IF (obstype.EQ.'surface') THEN
                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,
-     +              values,cvals,rectangle,verbose)+     +              values,cvals,rectangle,metar,verbose)
             ELSE IF (obstype(1:8).EQ.'sounding') THEN             ELSE IF (obstype(1:8).EQ.'sounding') THEN
                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,
Line 305: Line 316:
             ELSE IF (ksec1(6).LE.1) THEN             ELSE IF (ksec1(6).LE.1) THEN
                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,
-     +              values,cvals,rectangle,verbose)+     +              values,cvals,rectangle,metar,verbose)
             ELSE IF (ksec1(6).EQ.2) THEN             ELSE IF (ksec1(6).EQ.2) THEN
                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,
Line 312: Line 323:
                CALL print_amdar_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_amdar_values(ksub,kxelem,ktdexl,ktdexp,
      +              values,cvals,rectangle,verbose)      +              values,cvals,rectangle,verbose)
 +            ELSE IF (ksec1(6).EQ.6) THEN
 +               CALL print_radar_profiler_values(ksub,kxelem,ktdexl,
 +     +              ktdexp,values,cvals,rectangle,verbose)
             ELSE IF (ksec1(6).EQ.31) THEN             ELSE IF (ksec1(6).EQ.31) THEN
                CALL print_oceanographic_values(ksub,kxelem,ktdexl,                CALL print_oceanographic_values(ksub,kxelem,ktdexl,
Line 330: Line 344:
             IF (obstype.EQ.'surface') THEN             IF (obstype.EQ.'surface') THEN
                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,
-     +              values,cvals,rectangle,verbose)+     +              values,cvals,rectangle,metar,verbose)
             ELSE IF (obstype(1:8).EQ.'sounding') THEN             ELSE IF (obstype(1:8).EQ.'sounding') THEN
                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,
Line 342: Line 356:
             ELSE IF (ksec1(6).LE.1) THEN             ELSE IF (ksec1(6).LE.1) THEN
                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_surface_values(ksub,kxelem,ktdexl,ktdexp,
-     +              values,cvals,rectangle,verbose)+     +              values,cvals,rectangle,metar,verbose)
             ELSE IF (ksec1(6).EQ.2) THEN             ELSE IF (ksec1(6).EQ.2) THEN
                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_sounding_values(ksub,kxelem,ktdexl,ktdexp,
Line 349: Line 363:
                CALL print_amdar_values(ksub,kxelem,ktdexl,ktdexp,                CALL print_amdar_values(ksub,kxelem,ktdexl,ktdexp,
      +              values,cvals,rectangle,verbose)      +              values,cvals,rectangle,verbose)
 +            ELSE IF (ksec1(6).EQ.6) THEN
 +               CALL print_radar_profiler_values(ksub,kxelem,ktdexl,
 +     +              ktdexp,values,cvals,rectangle,verbose)
             ELSE IF (ksec1(6).EQ.31) THEN             ELSE IF (ksec1(6).EQ.31) THEN
 C     For ocea files at met.no data category is 31. But note that IOB C     For ocea files at met.no data category is 31. But note that IOB
Line 379: Line 396:
       CHARACTER(LEN=200) argument ! Buffer for next argument       CHARACTER(LEN=200) argument ! Buffer for next argument
       CHARACTER(LEN=1350) Usage       CHARACTER(LEN=1350) Usage
-      CHARACTER(LEN=900) Help+      CHARACTER(LEN=950) Help
       INTEGER iargc,iarg       INTEGER iargc,iarg
  
Line 442: Line 459:
      +     // 'So far only filtering on exact matches on integer and\n'      +     // 'So far only filtering on exact matches on integer and\n'
      +     // 'character valued BUFR descriptors has been implemented.'      +     // 'character valued BUFR descriptors has been implemented.'
 +     +     // ' But note that the\nclosely related program bufrdump.pl'
 +     +     // ' has a lot more options for filtering.'
      +     // '\n\nIf an error occurs during decoding (typically '      +     // '\n\nIf an error occurs during decoding (typically '
      +     // 'because the required BUFR table\nis missing or message '      +     // 'because the required BUFR table\nis missing or message '
Line 772: Line 791:
                    END DO       ! all data in subset                    END DO       ! all data in subset
                    IF (.NOT.match) ! there is one descriptor in condition which                    IF (.NOT.match) ! there is one descriptor in condition which
-     +                  EXIT       ! subset does not match, so go to next +     +                  EXIT       ! subset does not match, so go to next
                                    ! value line                                    ! value line
                 END DO          ! all descriptors in condition                 END DO          ! all descriptors in condition
Line 791: Line 810:
  
 C     Identify pressure, temperature etc and print parameter=value to C     Identify pressure, temperature etc and print parameter=value to
-C     screen. Note: have seen one example (high resolution data) where +C     screen. Note: have seen high resolution data with 7002 HEIGHT OR 
-C     7002 HEIGHT OR ALTITUDE was used as vertical coordinate instead of +C     ALTITUDE and wind profiler data with 007009 GEOPOTENTIAL HEIGHT 
-C     7004 PRESSURE (10004 was used for pressure). Not able to handle +C     used as vertical coordinate instead of 7004 PRESSURE (10004 was 
-C     that in present code.+C     used for pressure in the first case). Not able to handle that in 
 +C     present code.
       SUBROUTINE print_sounding_values(ksub,kxelem,ktdexl,ktdexp,values,       SUBROUTINE print_sounding_values(ksub,kxelem,ktdexl,ktdexp,values,
      +     cvals,rectangle,obstype,verbose)      +     cvals,rectangle,obstype,verbose)
Line 813: Line 833:
  
       REAL*8 II,iii,ix,year,month,day,hour,minute,       REAL*8 II,iii,ix,year,month,day,hour,minute,
-     +     longitude,latitude,height+     +     longitude,latitude,height,wigos_series 
 +      CHARACTER*5 wigos_issuer,wigos_issueno,missing5
       CHARACTER*9 call_sign,missing9       CHARACTER*9 call_sign,missing9
 +      CHARACTER*8 flight_number,missing8
 +      CHARACTER*16 wigos_localid,missing16
 +
       CHARACTER one_bits       CHARACTER one_bits
       REAL*8 value       REAL*8 value
-      INTEGER idx,cidx,desc,n,maxlevel,numlevels,ind +      INTEGER idx,cidx,desc,n,maxlevel,numlevels,i,ind,ind2,ind3 
-      PARAMETER(maxlevel=4000)+      PARAMETER(maxlevel=100000)
  
       REAL*8 P(maxlevel),D(maxlevel),F(maxlevel),       REAL*8 P(maxlevel),D(maxlevel),F(maxlevel),
Line 845: Line 869:
  
       one_bits = CHAR(255)       one_bits = CHAR(255)
-      WRITE(missing9,'(9A)') one_bits,one_bits,one_bits,one_bits, +      WRITE(missing5,'(5A)') one_bits,one_bits,one_bits,one_bits, 
-     +     one_bits,one_bits,one_bits,one_bits,one_bits+     +     one_bits 
 +      WRITE(missing8,'(8A)') one_bits,one_bits,one_bits,one_bits, 
 +     +     one_bits,one_bits,one_bits,one_bits 
 +      missing9 = missing8 // one_bits 
 +      missing16 = missing8 // missing8
       vss_missing = '       '       vss_missing = '       '
  
 C     Initialize all parameters to missing values C     Initialize all parameters to missing values
       call_sign = missing9       call_sign = missing9
 +      flight_number = missing8
 +      wigos_issuer = missing5
 +      wigos_issueno = missing5
 +      wigos_localid = missing16
 +      wigos_series = rvind
       II = rvind       II = rvind
       iii= rvind       iii= rvind
Line 892: Line 925:
          ELSE IF (desc.EQ.1002) THEN ! WMO station number          ELSE IF (desc.EQ.1002) THEN ! WMO station number
             iii = value             iii = value
-         ELSE IF (desc.EQ.1011) THEN  ! Ship or mobile land station identifier+         ELSE IF (desc.EQ.1011.OR.   ! Ship or mobile land station identifier 
 +     +           desc.EQ.1195) THEN  ! Mobil land station identifier
                cidx = int(value/1000)                cidx = int(value/1000)
                call_sign = cvals(cidx) ! CCITTIA5 data                call_sign = cvals(cidx) ! CCITTIA5 data
                call_sign = ctrim(call_sign,9,missing9)                call_sign = ctrim(call_sign,9,missing9)
 +         ELSE IF (desc.EQ.1006) THEN ! Aircraft flight number, used for dropsondes
 +            cidx = int(value/1000)
 +            flight_number = cvals(cidx) ! CCITTIA5 data
 +            flight_number = ctrim(flight_number,8,missing8)
 +         ELSE IF (desc.EQ.1125) THEN ! WIGOS identifier series
 +            wigos_series = value
 +         ELSE IF (desc.EQ.1126) THEN ! WIGOS issuer of identifier
 +            i = NINT(value)
 +            WRITE(wigos_issuer,'(I5)') i
 +            wigos_issuer = ADJUSTL(wigos_issuer)
 +         ELSE IF (desc.EQ.1127) THEN ! WIGOS issue number
 +            i = NINT(value)
 +            WRITE(wigos_issueno,'(I5)') i
 +            wigos_issueno = ADJUSTL(wigos_issueno)
 +         ELSE IF (desc.EQ.1128) THEN  ! WIGOS local identifier
 +            cidx = int(value/1000)
 +            wigos_localid = cvals(cidx) ! CCITTIA5 data
 +            wigos_localid = ctrim(wigos_localid,16,missing16)
          ELSE IF (desc.EQ.2001) THEN ! Type of station          ELSE IF (desc.EQ.2001) THEN ! Type of station
             ix = value             ix = value
Line 917: Line 969:
          ELSE IF (desc.EQ.6002 .AND. longitude.EQ.rvind) THEN ! Longitude (coarse accuracy)          ELSE IF (desc.EQ.6002 .AND. longitude.EQ.rvind) THEN ! Longitude (coarse accuracy)
             longitude = value             longitude = value
-         ELSE IF (desc.EQ.7001) THEN ! Height of station +         ELSE IF (desc.EQ.7001.OR.  ! Height of station 
-            height = value +     +           desc.EQ.7030.OR.   ! Height of station ground above mean sea level 
-         ELSE IF (desc.EQ.4086.AND.n<maxlevel) THEN ! Long time period or displacement [second]+     +           desc.EQ.7031.OR.   ! Height of barometer above mean sea level 
 +     +           desc.EQ.7007) THEN ! Height (i.e. of release of sonde above mean sea level) 
 +            IF (height.EQ.rvind) THEN 
 +               height = value 
 +            END IF 
 +         ELSE IF (desc.EQ.4086.AND.n.LT.maxlevel) THEN ! Long time period or displacement [second]
 C     In WMO template (309052) descriptors 004086 and 008042 comes BEFORE 7004 pressure C     In WMO template (309052) descriptors 004086 and 008042 comes BEFORE 7004 pressure
             tp(n+1) = value             tp(n+1) = value
-         ELSE IF (desc.EQ.8042.AND.n<maxlevel) THEN ! Extended vertical sounding significance+         ELSE IF (desc.EQ.8042.AND.n.LT.maxlevel) THEN ! Extended vertical sounding significance
             CALL vss_8042(NINT(value),vss(n+1))             CALL vss_8042(NINT(value),vss(n+1))
          ELSE IF (desc.EQ.7004) THEN ! Pressure          ELSE IF (desc.EQ.7004) THEN ! Pressure
             n = n + 1           ! new level             n = n + 1           ! new level
             IF (n.GT.maxlevel) THEN             IF (n.GT.maxlevel) THEN
 +               n = maxlevel
                WRITE(*,*) 'Too many levels! Skipping rest of message'                WRITE(*,*) 'Too many levels! Skipping rest of message'
                GOTO 110                GOTO 110
Line 972: Line 1030:
       END IF       END IF
  
-      WRITE(*,*)+
       IF (II.NE.rvind .AND. iii.NE.rvind) THEN       IF (II.NE.rvind .AND. iii.NE.rvind) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,I5.5)') 'wmonr=',NINT(II)*1000 + NINT(iii)          WRITE(*,'(A,I5.5)') 'wmonr=',NINT(II)*1000 + NINT(iii)
 +      ELSE IF (wigos_series.NE.rvind .AND. wigos_issuer.NE.missing5
 +     +        .AND. wigos_issueno.NE.missing5
 +     +        .AND. wigos_localid.NE.missing16) THEN
 +         ind = index(wigos_issuer,' ') - 1
 +         IF (ind.EQ.-1) ind = 5
 +         ind2 = index(wigos_issueno,' ') - 1
 +         IF (ind2.EQ.-1) ind2 = 5
 +         ind3 = index(wigos_localid,' ') - 1
 +         IF (ind3.EQ.-1) ind3 = 16
 +         WRITE(*,*)
 +         WRITE(*,'(A,I1.1,A1,A,A1,A,A1,A)')
 +     +        'wigosid=',NINT(wigos_series),
 +     +        '-',wigos_issuer(1:ind),
 +     +        '-',wigos_issueno(1:ind2),
 +     +        '-',wigos_localid(1:ind3)
       ELSE IF (call_sign.NE.missing9) THEN       ELSE IF (call_sign.NE.missing9) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,A)') 'call_sign=',call_sign(1:lenstr(call_sign,1))          WRITE(*,'(A,A)') 'call_sign=',call_sign(1:lenstr(call_sign,1))
 +      ELSE IF (flight_number.NE.missing8) THEN
 +         WRITE(*,*)
 +         WRITE(*,'(A,A)') 'aircraft=',
 +     +        flight_number(1:lenstr(flight_number,1))
       ELSE       ELSE
          IF (verbose .GT. 1) THEN          IF (verbose .GT. 1) THEN
-            WRITE(*,*) 'Both wmonr and call sign are missing!!!'+            WRITE(*,*) 
 +            WRITE(*,*) 'Both wmonr, wigosid, call sign and aircraft' 
 +     +           // ' flight number are missing !!!'
          END IF          END IF
          RETURN          RETURN
Line 1056: Line 1137:
  
       END SUBROUTINE print_sounding_values       END SUBROUTINE print_sounding_values
 +
 +C     -----------------------------------------------------------------
 +
 +C     Identify height, wind and data quality parameters and print parameter=value to
 +C     screen for the given heights.
 +      SUBROUTINE print_radar_profiler_values(ksub,kxelem,ktdexl,ktdexp,
 +     +     values,cvals,rectangle,verbose)
 +      IMPLICIT NONE
 +
 +      INTEGER ksub              ! Input: number of subset currently processed
 +      INTEGER kxelem            ! Input: expected (max) number of expanded elements
 +      INTEGER ktdexl            ! Input: number of entries in list of expanded data descriptors
 +      INTEGER ktdexp(*)         ! Input: array containing expanded data descriptors
 +      REAL*8 values(*)          ! Input: expanded data values (one subset)
 +      CHARACTER*80 cvals(*)     ! Input: CCITTIA5 Bufr elements entries (one subset)
 +      LOGICAL rectangle         ! Input: TRUE if observations are wanted for a rectangle only
 +      INTEGER verbose           ! Input: verbose level
 +
 +      REAL*8 rvind              ! missing value for real*8 data
 +      PARAMETER (rvind=1.7E38)
 +
 +      REAL*8 II,iii,ix,year,month,day,hour,minute,
 +     +     longitude,latitude,height
 +      CHARACTER*9 call_sign,missing9
 +      CHARACTER one_bits
 +      REAL*8 value
 +      INTEGER idx,cidx,desc,n,maxlevel,numlevels,ind
 +      PARAMETER(maxlevel=1000)
 +
 +      REAL*8 HH(maxlevel),D(maxlevel),F(maxlevel),
 +     +     Q1(maxlevel),WC(maxlevel),Q2(maxlevel)
 +
 +C     Variables used for geographical filtering av observations
 +      REAL*8 x1,y1,x2,y2
 +      COMMON /COM_RECTANGLE/  x1,y1,x2,y2
 +
 +C     Functions
 +      INTEGER lenstr
 +      CHARACTER*9 ctrim  ! length must be >= longest variable ctrim is used for
 +
 +      one_bits = CHAR(255)
 +      WRITE(missing9,'(9A)') one_bits,one_bits,one_bits,one_bits,
 +     +     one_bits,one_bits,one_bits,one_bits,one_bits
 +
 +C     Initialize all parameters to missing values
 +      call_sign = missing9
 +      II = rvind
 +      iii= rvind
 +      year = rvind
 +      month = rvind
 +      day = rvind
 +      hour = rvind
 +      minute = rvind
 +      latitude = rvind
 +      longitude = rvind
 +      height = rvind
 +      DO n=1,maxlevel
 +         HH(n) = rvind
 +         D(n) = rvind
 +         F(n) = rvind
 +         Q1(n) = rvind
 +         WC(n) = rvind
 +         Q2(n) = rvind
 +      END DO
 +
 +C     Loop through all expanded descriptors
 +      n = 0 ! Numbering the pressure levels
 +      DO idx=1,ktdexl
 +         desc = ktdexp(idx)
 +         value = values(idx + (ksub-1)*kxelem)
 +
 +C     Nothing to do if value is missing (note that the missing value
 +C     returned from libbufr might not be exactly equal to rvind)
 +         IF (ABS(value - rvind)/rvind.LE.0.001) THEN
 +            CYCLE
 +         END IF
 +
 +         IF (desc.EQ.1001) THEN ! WMO block number
 +            II = value
 +         ELSE IF (desc.EQ.1002) THEN ! WMO station number
 +            iii = value
 +         ELSE IF (desc.EQ.1011.OR.   ! Ship or mobile land station identifier
 +     +           desc.EQ.1195) THEN  ! Mobil land station identifier
 +               cidx = int(value/1000)
 +               call_sign = cvals(cidx) ! CCITTIA5 data
 +               call_sign = ctrim(call_sign,9,missing9)
 +         ELSE IF (desc.EQ.2001) THEN ! Type of station
 +            ix = value
 +         ELSE IF (desc.EQ.4001) THEN ! Year
 +            year = value
 +         ELSE IF (desc.EQ.4002) THEN ! Month
 +            month = value
 +         ELSE IF (desc.EQ.4003) THEN ! Day
 +            day = value
 +         ELSE IF (desc.EQ.4004) THEN ! Hour
 +            hour = value
 +         ELSE IF (desc.EQ.4005) THEN ! Minute
 +            minute = value
 +C     Seen 5002 and 6002 used for each level in high resolution data
 +         ELSE IF (desc.EQ.5001 .AND. latitude.EQ.rvind) THEN ! Latitude (high accuracy)
 +            latitude = value
 +         ELSE IF (desc.EQ.5002 .AND. latitude.EQ.rvind) THEN ! Latitude (coarse accuracy)
 +            latitude = value
 +         ELSE IF (desc.EQ.6001 .AND. longitude.EQ.rvind) THEN ! Longitude (high accuracy)
 +            longitude = value
 +         ELSE IF (desc.EQ.6002 .AND. longitude.EQ.rvind) THEN ! Longitude (coarse accuracy)
 +            longitude = value
 +         ELSE IF (desc.EQ.7001) THEN  ! Height of station
 +            IF (height.EQ.rvind) THEN
 +               height = value
 +            END IF
 +         ELSE IF (desc.EQ.7007) THEN ! Height
 +            n = n + 1           ! new level
 +            IF (n.GT.maxlevel) THEN
 +               n = maxlevel
 +               WRITE(*,*) 'Too many levels! Skipping rest of message'
 +               GOTO 110
 +            END IF
 +            HH(n) = value
 +C     All following descriptors come after 7007 height
 +         ELSE IF (n.GT.0 .AND. n.LE.maxlevel) THEN
 +            IF (desc.EQ.11001) THEN ! Wind direction
 +               D(n) = value
 +            ELSE IF (desc.EQ.11002) THEN ! Wind speed
 +               F(n) = value
 +            ELSE IF (desc.EQ.11006) THEN ! W-component
 +               WC(n) = value
 +            ELSE IF (desc.EQ.33002) THEN ! Quality information, included 2 times per level
 +               IF (ktdexp(idx-1).EQ.11002) THEN
 +                  Q1(n) = value
 +               ELSE
 +                  Q2(n) = value
 +               END IF
 +            END IF
 +         END IF
 +      END DO
 + 110  CONTINUE
 +      numlevels = n
 +
 +      IF (rectangle) THEN
 +         IF (longitude.EQ.rvind .OR. latitude.EQ.rvind
 +     +        .OR. longitude.LT.x1 .OR. longitude.GT.x2
 +     +        .OR. latitude.LT.y1 .OR. latitude.GT.y2) RETURN
 +      END IF
 +
 +      IF (II.NE.rvind .AND. iii.NE.rvind) THEN
 +         WRITE(*,*)
 +         WRITE(*,'(A,I5.5)') 'wmonr=',NINT(II)*1000 + NINT(iii)
 +      ELSE IF (call_sign.NE.missing9) THEN
 +         WRITE(*,*)
 +         WRITE(*,'(A,A)') 'call_sign=',call_sign(1:lenstr(call_sign,1))
 +      ELSE
 +         IF (verbose .GT. 1) THEN
 +            WRITE(*,*)
 +            WRITE(*,*) 'Both wmonr and call sign are missing!!!'
 +         END IF
 +         RETURN
 +      END IF
 +
 +      IF (year.NE.rvind.AND.month.NE.rvind.AND.day.NE.rvind
 +     +     .AND.hour.NE.rvind.AND.minute.NE.rvind) THEN
 +         WRITE(*,900),NINT(year),NINT(month),NINT(day),
 +     +        NINT(hour),NINT(minute)
 + 900     FORMAT('obstime=',I4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':00')
 +      ELSE
 +         IF (verbose .GT. 1) THEN
 +            WRITE(*,*) 'obstime is missing!!!'
 +            RETURN
 +         END IF
 +      ENDIF
 +      IF (ix.NE.rvind) THEN
 +         IF (NINT(ix).EQ.0) THEN
 +            WRITE(*,'(A,A)') 'type=Automatic'
 +         ELSE IF (NINT(ix).EQ.1) THEN
 +            WRITE(*,'(A,A)') 'type=Manned'
 +         ELSE IF (NINT(ix).EQ.2) THEN
 +            WRITE(*,'(A,A)') 'type=Hybrid'
 +         END IF
 +      END IF
 +      IF (latitude.NE.rvind) THEN
 +         WRITE(*,'(A,F10.5)') 'lat=',latitude
 +      END IF
 +      IF (longitude.NE.rvind) THEN
 +         WRITE(*,'(A,F10.5)') 'lon=',longitude
 +      END IF
 +      IF (height.NE.rvind) THEN
 +         WRITE(*,'(A,I7)') 'height=',NINT(height)
 +      END IF
 +
 +      DO n=1,numlevels
 +         WRITE(*,'(A,I12)'),'n=',n
 +         IF (HH(n).NE.rvind) THEN
 +            WRITE(*,'(A,F11.1)') 'HH=',HH(n) ! m
 +         END IF
 +         IF (D(n).NE.rvind) THEN
 +            WRITE(*,'(A,I11)') 'DD=',NINT(D(n))
 +         END IF
 +         IF (F(n).NE.rvind) THEN
 +            WRITE(*,'(A,F11.1)') 'FF=',F(n)
 +         END IF
 +         IF (Q1(n).NE.rvind) THEN
 +            WRITE(*,'(A,I11)') 'Q1=',NINT(Q1(n))
 +         END IF
 +         IF (WC(n).NE.rvind) THEN
 +            WRITE(*,'(A,I11)') 'WC=',NINT(WC(n))
 +         END IF
 +         IF (Q2(n).NE.rvind) THEN
 +            WRITE(*,'(A,I11)') 'Q2=',NINT(Q2(n))
 +         END IF
 +      END DO
 +
 +      END SUBROUTINE print_radar_profiler_values
  
 C     ----------------------------------------------------------------- C     -----------------------------------------------------------------
  
       SUBROUTINE print_surface_values(ksub,kxelem,ktdexl,ktdexp,values,       SUBROUTINE print_surface_values(ksub,kxelem,ktdexl,ktdexp,values,
-     +     cvals,rectangle,verbose)+     +     cvals,rectangle,metar,verbose)
 C     Identify pressure, temperature etc and print parameter=value to screen C     Identify pressure, temperature etc and print parameter=value to screen
       IMPLICIT NONE       IMPLICIT NONE
Line 1071: Line 1364:
       CHARACTER*80 cvals(*)     ! Input: CCITTIA5 Bufr elements entries (one subset)       CHARACTER*80 cvals(*)     ! Input: CCITTIA5 Bufr elements entries (one subset)
       LOGICAL rectangle         ! Input: TRUE if observations are wanted for a rectangle only       LOGICAL rectangle         ! Input: TRUE if observations are wanted for a rectangle only
 +      LOGICAL metar             ! Input: TRUE if metar (data subcategory 5)
       INTEGER verbose           ! Input: verbose level       INTEGER verbose           ! Input: verbose level
  
Line 1076: Line 1370:
       PARAMETER (rvind=1.7E38)       PARAMETER (rvind=1.7E38)
  
-      CHARACTER*8 icao_id,missing8,spc8 +      CHARACTER*5 wigos_issuer,wigos_issueno,missing5 
-      CHARACTER*9 call_sign,missing9,spc9 +      CHARACTER*8 icao_id,missing8 
-      CHARACTER*20 name,missing20,spc20 +      CHARACTER*9 call_sign,missing9 
-      CHARACTER*32 long_name,missing32,spc32+      CHARACTER*16 wigos_localid,missing16 
 +      CHARACTER*20 name,missing20 
 +      CHARACTER*32 long_name,missing32
 C     Parameters defined in Kvalobs C     Parameters defined in Kvalobs
       REAL*8 AA,BI,CH,CI,CL,CM,DD,DG,DG_010,DG_1,DG_X,DI,DW1,DW2,       REAL*8 AA,BI,CH,CI,CL,CM,DD,DG,DG_010,DG_1,DG_X,DI,DW1,DW2,
Line 1088: Line 1384:
      +     TA,TAN_12,TAX_12,TAN,TAX,TD,TGN_12,TW,UU,VV,W1,W2,WW,XIS,ZI,      +     TA,TAN_12,TAX_12,TAN,TAX,TD,TGN_12,TW,UU,VV,W1,W2,WW,XIS,ZI,
 C     Other parameters C     Other parameters
-     +     year,month,day,hour,minute, +     +     year,month,day,hour,minute,a3,buoy_id5,buoy_id7,ds, 
-     +     a3,buoy_id,ds,height,hhh,hour_p,II,iii,ix,latitude,longitude,+     +     height,hhh,hp,hour_p,II,iii,ix,latitude,longitude,
      +     minute_p,TbTbTb,vert_sign_first,vs,wmo_region_number,      +     minute_p,TbTbTb,vert_sign_first,vs,wmo_region_number,
-     +     wmo_region_subarea,state_id,national_number+     +     wmo_region_subarea,state_id,national_number, 
 +     +     wigos_series
       REAL*8 vert_sign(4),CC(4),HS(4),NS(4)       REAL*8 vert_sign(4),CC(4),HS(4),NS(4)
       INTEGER idx,cidx       INTEGER idx,cidx
       INTEGER cloud_type_count  ! Will be increased by one for each 020012       INTEGER cloud_type_count  ! Will be increased by one for each 020012
-                                ! (cloud type) encountered (0 initially) +                                ! (cloud type) encountered (0 initially). 
-      INTEGER num_cloud_layers  ! Number of individual cloud layers, +                                ! Not used for metar 
-                                ! set to value of 031001 (delayed +      INTEGER num_cloud_layers  ! Number of individual cloud layers, set 
-                                ! descriptor) if this is met immediately +                                ! to value of 031001 (delayed descriptor 
-                                ! after a 020012 descriptor (-1 initially)+                                ! replication factor) if this is met immediately 
 +                                ! after a 020012 descriptor (-1 initially). 
 +                                ! For metar num_cloud_layers is increased 
 +                                ! by one for each new 020011
       LOGICAL bad_cloud_data    ! Set to true if something serious wrong is       LOGICAL bad_cloud_data    ! Set to true if something serious wrong is
                                 ! found in cloud data. No more cloud                                 ! found in cloud data. No more cloud
Line 1107: Line 1407:
                                 ! surface') is encountered with a value different                                 ! surface') is encountered with a value different
                                 ! from 0                                 ! from 0
 +      LOGICAL time_of_last_position ! Set to true if 008021 time significance is
 +                                    ! included with value 26
       CHARACTER one_bits       CHARACTER one_bits
       REAL*8 value       REAL*8 value
-      INTEGER desc,i,mm,hh,ind+      INTEGER desc,i,mm,hh,ind,ind2,ind3
       INTEGER degree2dir,NNtoWMO_N       INTEGER degree2dir,NNtoWMO_N
  
Line 1122: Line 1424:
  
       one_bits = CHAR(255)       one_bits = CHAR(255)
 +      WRITE(missing5,'(5A)') one_bits,one_bits,one_bits,one_bits,
 +     +     one_bits
       WRITE(missing8,'(8A)') one_bits,one_bits,one_bits,one_bits,       WRITE(missing8,'(8A)') one_bits,one_bits,one_bits,one_bits,
      +     one_bits,one_bits,one_bits,one_bits      +     one_bits,one_bits,one_bits,one_bits
       missing9 = missing8 // one_bits       missing9 = missing8 // one_bits
 +      missing16 = missing8 // missing8
       missing20 = missing9 // missing9 // one_bits // one_bits       missing20 = missing9 // missing9 // one_bits // one_bits
-      missing32 = missing20 // missing9 // one_bits // one_bits +      missing32 = missing16 // missing16
-     +     // one_bits +
-      spc8 = '        ' +
-      spc9 = '         ' +
-      spc20 = '                    ' +
-      spc32 = '                                '+
  
       cloud_type_count = 0       cloud_type_count = 0
Line 1137: Line 1437:
       num_cloud_layers = -1       num_cloud_layers = -1
       surface_data = .TRUE.       surface_data = .TRUE.
 +      time_of_last_position = .FALSE.
  
 C     Initialize all parameters to missing values C     Initialize all parameters to missing values
Line 1143: Line 1444:
       icao_id = missing8       icao_id = missing8
       call_sign = missing9       call_sign = missing9
 +      wigos_issuer = missing5
 +      wigos_issueno = missing5
 +      wigos_localid = missing16
       name = missing20       name = missing20
       long_name = missing32       long_name = missing32
Line 1234: Line 1538:
       longitude = rvind       longitude = rvind
       height = rvind       height = rvind
 +      hp = rvind
       vert_sign_first = rvind       vert_sign_first = rvind
       II = rvind       II = rvind
Line 1243: Line 1548:
       vs = rvind       vs = rvind
       TbTbTb = rvind       TbTbTb = rvind
-      buoy_id = rvind+      buoy_id5 = rvind 
 +      buoy_id7 = rvind
       wmo_region_number = rvind       wmo_region_number = rvind
       wmo_region_subarea = rvind       wmo_region_subarea = rvind
       state_id = rvind       state_id = rvind
       national_number = rvind       national_number = rvind
 +      wigos_series = rvind
  
       DO i=1,4       DO i=1,4
Line 1300: Line 1607:
          ELSE IF (desc.EQ.4025) THEN ! Time period or displacement [minute]          ELSE IF (desc.EQ.4025) THEN ! Time period or displacement [minute]
             minute_p = value             minute_p = value
 +         ELSE IF (desc.EQ.8021) THEN ! Time significance
 +            IF (NINT(value).EQ.26) THEN
 +               time_of_last_position = .TRUE.
 +            ELSE
 +               time_of_last_position = .FALSE.
 +            END IF
          ELSE IF (desc.EQ.1001 .AND. II.EQ.rvind) THEN ! WMO block number          ELSE IF (desc.EQ.1001 .AND. II.EQ.rvind) THEN ! WMO block number
-            II = value+            IF (value.GE.0 .AND. value.LT.100) II = value
          ELSE IF (desc.EQ.1002 .AND. iii.EQ.rvind) THEN ! WMO station number          ELSE IF (desc.EQ.1002 .AND. iii.EQ.rvind) THEN ! WMO station number
-            iii = value+            IF (value.GE.0 .AND. value.LT.1000) iii = value
          ELSE IF (desc.EQ.1101 .AND. state_id.EQ.rvind) THEN ! WMO member state identifier          ELSE IF (desc.EQ.1101 .AND. state_id.EQ.rvind) THEN ! WMO member state identifier
-            state_id = value+            IF (value.GE.0 .AND. value.LT.1000) state_id = value
          ELSE IF (desc.EQ.1102 .AND. national_number.EQ.rvind) THEN ! National station number          ELSE IF (desc.EQ.1102 .AND. national_number.EQ.rvind) THEN ! National station number
-            national_number = value+            IF (value.GE.0) national_number = value
          ELSE IF (desc.EQ.1015) THEN  ! Station or site name          ELSE IF (desc.EQ.1015) THEN  ! Station or site name
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc20) THEN +            name = cvals(cidx)  ! CCITTIA5 data 
-               name = cvals(cidx) ! CCITTIA5 data +            name = ctrim(name,20,missing20)
-               name = ctrim(name,20,missing20) +
-            END IF+
          ELSE IF (desc.EQ.1019) THEN  ! Long station or site name          ELSE IF (desc.EQ.1019) THEN  ! Long station or site name
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc32) THEN +            long_name = cvals(cidx) ! CCITTIA5 data 
-               long_name = cvals(cidx) ! CCITTIA5 data +            long_name = ctrim(long_name,32,missing32) 
-               long_name = ctrim(long_name,32,missing32) +         ELSE IF (desc.EQ.1125) THEN ! WIGOS identifier series 
-            END IF+            wigos_series = value 
 +         ELSE IF (desc.EQ.1126) THEN ! WIGOS issuer of identifier 
 +            i = NINT(value) 
 +            WRITE(wigos_issuer,'(I5)') i 
 +            wigos_issuer = ADJUSTL(wigos_issuer) 
 +         ELSE IF (desc.EQ.1127) THEN ! WIGOS issue number 
 +            i = NINT(value) 
 +            WRITE(wigos_issueno,'(I5)') i 
 +            wigos_issueno = ADJUSTL(wigos_issueno) 
 +         ELSE IF (desc.EQ.1128) THEN  ! WIGOS local identifier 
 +            cidx = int(value/1000) 
 +            wigos_localid = cvals(cidx) ! CCITTIA5 data 
 +            wigos_localid = ctrim(wigos_localid,16,missing16)
          ELSE IF (desc.EQ.2001) THEN ! Type of station          ELSE IF (desc.EQ.2001) THEN ! Type of station
             IF (ix.EQ.rvind) THEN             IF (ix.EQ.rvind) THEN
Line 1325: Line 1648:
             END IF             END IF
          ELSE IF (desc.EQ.4001) THEN ! Year          ELSE IF (desc.EQ.4001) THEN ! Year
-            IF (year.EQ.rvind) THEN+            IF (year.EQ.rvind.AND..NOT.time_of_last_position) THEN
                year = value                year = value
             END IF             END IF
          ELSE IF (desc.EQ.4002) THEN ! Month          ELSE IF (desc.EQ.4002) THEN ! Month
-            IF (month.EQ.rvind) THEN+            IF (month.EQ.rvind.AND..NOT.time_of_last_position) THEN
                month = value                month = value
             END IF             END IF
          ELSE IF (desc.EQ.4003) THEN ! Day          ELSE IF (desc.EQ.4003) THEN ! Day
-            IF (day.EQ.rvind) THEN+            IF (day.EQ.rvind.AND..NOT.time_of_last_position) THEN
                day = value                day = value
             END IF             END IF
          ELSE IF (desc.EQ.4004) THEN ! Hour          ELSE IF (desc.EQ.4004) THEN ! Hour
-            IF (hour.EQ.rvind) THEN+            IF (hour.EQ.rvind.AND..NOT.time_of_last_position) THEN
                hour = value                hour = value
             END IF             END IF
          ELSE IF (desc.EQ.4005) THEN ! Minute          ELSE IF (desc.EQ.4005) THEN ! Minute
-            IF (minute.EQ.rvind) THEN+            IF (minute.EQ.rvind.AND..NOT.time_of_last_position) THEN
                minute = value                minute = value
             END IF             END IF
Line 1358: Line 1681:
             IF (height.EQ.rvind) THEN             IF (height.EQ.rvind) THEN
                height = value                height = value
 +            END IF
 +         ELSE IF (desc.EQ.7031) THEN ! Hp
 +            IF (hp.EQ.rvind) THEN
 +               hp = value
             END IF             END IF
          ELSE IF (desc.EQ.10004) THEN ! Pressure          ELSE IF (desc.EQ.10004) THEN ! Pressure
Line 1526: Line 1853:
 C     number of cloud layers if previous descriptor is cloud C     number of cloud layers if previous descriptor is cloud
 C     type, according to all WMO recommended templates C     type, according to all WMO recommended templates
 +C     (but DNMI metar is an exception!)
             IF (ktdexp(idx - 1).EQ.20012) THEN             IF (ktdexp(idx - 1).EQ.20012) THEN
                IF (NINT(value).LE.4) THEN                IF (NINT(value).LE.4) THEN
Line 1553: Line 1881:
             END IF             END IF
          ELSE IF (desc.EQ.20011 .AND. .NOT.bad_cloud_data) THEN ! Cloud amount          ELSE IF (desc.EQ.20011 .AND. .NOT.bad_cloud_data) THEN ! Cloud amount
-            IF (cloud_type_count.EQ.0) THEN ! First occurrence+            IF (metar) THEN 
 +               IF (num_cloud_layers.GT.-1) THEN 
 +                  num_cloud_layers = num_cloud_layers + 1 
 +               ELSE 
 +                  num_cloud_layers = 1 
 +               END IF 
 +               NS(num_cloud_layers) = value 
 +            ELSE IF (cloud_type_count.EQ.0) THEN ! First occurrence
                IF (NH.EQ.rvind) THEN                IF (NH.EQ.rvind) THEN
                   NH = value                   NH = value
Line 1572: Line 1907:
             END IF             END IF
          ELSE IF (desc.EQ.20012 .AND. .NOT.bad_cloud_data) THEN ! Cloud type          ELSE IF (desc.EQ.20012 .AND. .NOT.bad_cloud_data) THEN ! Cloud type
-            cloud_type_count = cloud_type_count + 1 +            IF (metar) THEN 
-            IF (cloud_type_count.GT.3) THEN +               CC(num_cloud_layers) = value 
-               cloud_layer = cloud_type_count - 3 +            ELSE    
-               IF (num_cloud_layers .GT.-1) THEN +               cloud_type_count = cloud_type_count + 1 
-                  IF (value < 10.0 ! Accept one digit values only +               IF (cloud_type_count.GT.3) THEN 
-     +                 .AND. cloud_layer.LE.num_cloud_layers) THEN+                  cloud_layer = cloud_type_count - 3 
 +                  IF (num_cloud_layers .GT.-1) THEN 
 +                     IF (value < 10.0 ! Accept one digit values only 
 +     +                    .AND. cloud_layer.LE.num_cloud_layers) THEN 
 +                        CC(cloud_layer) = value 
 +                     END IF 
 +                  ELSE IF (cloud_layer.LT.5) THEN ! rdb-files always have 0 or 4 cloud layers
                      CC(cloud_layer) = value                      CC(cloud_layer) = value
                   END IF                   END IF
-               ELSE IF (cloud_layer.LT.5) THEN ! rdb-files always have 0 or 4 cloud layers +               ELSE 
-                  CC(cloud_layer) = value +                  IF (cloud_type_count.EQ.1) THEN 
-               END IF +                     IF (CL.EQ.rvind) THEN 
-            ELSE +                        CL = value 
-               IF (cloud_type_count.EQ.1) THEN +                     END IF 
-                  IF (CL.EQ.rvind) THEN +                  ELSE IF (cloud_type_count.EQ.2) THEN 
-                     CL = value +                     IF (CM.EQ.rvind) THEN 
-                  END IF +                        CM = value 
-               ELSE IF (cloud_type_count.EQ.2) THEN +                     END IF 
-                  IF (CM.EQ.rvind) THEN +                  ELSE IF (cloud_type_count.EQ.3) THEN 
-                     CM = value +                     IF (CH.EQ.rvind) THEN 
-                  END IF +                        CH = value 
-               ELSE IF (cloud_type_count.EQ.3) THEN +                     END IF
-                  IF (CH.EQ.rvind) THEN +
-                     CH = value+
                   END IF                   END IF
                END IF                END IF
             END IF             END IF
          ELSE IF (desc.EQ.20013 .AND. .NOT.bad_cloud_data) THEN ! Height of base of cloud          ELSE IF (desc.EQ.20013 .AND. .NOT.bad_cloud_data) THEN ! Height of base of cloud
-            IF (cloud_type_count.EQ.0) THEN ! First occurrence+            IF (metar) THEN 
 +               HS(num_cloud_layers) = value 
 +            ELSE IF (cloud_type_count.EQ.0) THEN ! First occurrence
                IF (HL.EQ.rvind) THEN                IF (HL.EQ.rvind) THEN
                   HL = value                   HL = value
Line 1757: Line 2098:
          ELSE IF (desc.EQ.1011) THEN  ! Ship or mobile land station identifier          ELSE IF (desc.EQ.1011) THEN  ! Ship or mobile land station identifier
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc9) THEN+            IF (cidx.GT.0) THEN
                call_sign = cvals(cidx) ! CCITTIA5 data                call_sign = cvals(cidx) ! CCITTIA5 data
                call_sign = ctrim(call_sign,9,missing9)                call_sign = ctrim(call_sign,9,missing9)
Line 1779: Line 2120:
             END IF             END IF
          ELSE IF (desc.EQ.22043.OR.  ! Sea/water temperature (15 bits)          ELSE IF (desc.EQ.22043.OR.  ! Sea/water temperature (15 bits)
-     +           desc.EQ.22042) THEN ! Sea/water temperature (12 bits)+     +           desc.EQ.22042.OR.   ! Sea/water temperature (12 bits) 
 +     +           desc.EQ.22049) THEN ! Sea-surface temperature (15 bits)
             IF (TW.EQ.rvind .AND. surface_data)THEN             IF (TW.EQ.rvind .AND. surface_data)THEN
                TW = value                TW = value
Line 1859: Line 2201:
             END IF             END IF
          ELSE IF (desc.EQ.1005) THEN ! Buoy/platform identifier          ELSE IF (desc.EQ.1005) THEN ! Buoy/platform identifier
-            IF (buoy_id.EQ.rvind) THEN +            IF (buoy_id5.EQ.rvind) THEN 
-               buoy_id = value+               buoy_id5 = value
             END IF             END IF
          ELSE IF (desc.EQ.1003) THEN ! WMO region number/geographical area          ELSE IF (desc.EQ.1003) THEN ! WMO region number/geographical area
Line 1871: Line 2213:
             END IF             END IF
          ELSE IF (desc.EQ.1087) THEN ! WMO Marine observing platform extended identifier          ELSE IF (desc.EQ.1087) THEN ! WMO Marine observing platform extended identifier
-            IF (buoy_id.EQ.rvind) THEN +            IF (buoy_id7.EQ.rvind) THEN 
-               buoy_id = value+               buoy_id7 = value
             END IF             END IF
 C     Special for metar C     Special for metar
          ELSE IF (desc.EQ.1063) THEN  ! ICAO location indicator          ELSE IF (desc.EQ.1063) THEN  ! ICAO location indicator
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc8) THEN +            icao_id = cvals(cidx) ! CCITTIA5 data 
-               icao_id = cvals(cidx) ! CCITTIA5 data +            icao_id = ctrim(icao_id,8,missing8)
-               icao_id = ctrim(icao_id,8,missing8) +
-            END IF+
          ELSE IF (desc.EQ.10052) THEN ! Altimeter setting (QNH)          ELSE IF (desc.EQ.10052) THEN ! Altimeter setting (QNH)
             IF (PH.EQ.rvind) THEN             IF (PH.EQ.rvind) THEN
Line 1894: Line 2234:
       END IF       END IF
  
-      WRITE(*,*) 
       IF (II.NE.rvind .AND. iii.NE.rvind) THEN       IF (II.NE.rvind .AND. iii.NE.rvind) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,I5.5)') 'wmonr=',NINT(II)*1000 + NINT(iii)          WRITE(*,'(A,I5.5)') 'wmonr=',NINT(II)*1000 + NINT(iii)
 +      ELSE IF (wigos_series.NE.rvind .AND. wigos_issuer.NE.missing5
 +     +        .AND. wigos_issueno.NE.missing5
 +     +        .AND. wigos_localid.NE.missing16) THEN
 +         ind = index(wigos_issuer,' ') - 1
 +         IF (ind.EQ.-1) ind = 5
 +         ind2 = index(wigos_issueno,' ') - 1
 +         IF (ind2.EQ.-1) ind2 = 5
 +         ind3 = index(wigos_localid,' ') - 1
 +         IF (ind3.EQ.-1) ind3 = 16
 +         WRITE(*,*)
 +         WRITE(*,'(A,I1.1,A1,A,A1,A,A1,A)')
 +     +        'wigosid=',NINT(wigos_series),
 +     +        '-',wigos_issuer(1:ind),
 +     +        '-',wigos_issueno(1:ind2),
 +     +        '-',wigos_localid(1:ind3)
       ELSE IF (state_id.NE.rvind .AND. national_number.NE.rvind) THEN       ELSE IF (state_id.NE.rvind .AND. national_number.NE.rvind) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,I3.3,A1,I10.10)') 'nationalnr=',NINT(state_id),          WRITE(*,'(A,I3.3,A1,I10.10)') 'nationalnr=',NINT(state_id),
      +        '_',NINT(national_number)      +        '_',NINT(national_number)
Line 1908: Line 2264:
             ind = ind - 1             ind = ind - 1
          END DO          END DO
 +         WRITE(*,*)
          WRITE(*,'(A,A)') 'call_sign=',          WRITE(*,'(A,A)') 'call_sign=',
      +        call_sign(1:ind)      +        call_sign(1:ind)
-      ELSE IF (buoy_id.NE.rvind.AND.wmo_region_number.NE.rvind+      ELSE IF (buoy_id7.NE.rvind) THEN 
 +C     New templates introduced in 2014 for data category 1 use 001087 
 +C     WMO Marine observing platform extended identifier, 7 digits 
 +         WRITE(*,*) 
 +         WRITE(*,'(A,I7)') 'buoy_id=',NINT(buoy_id7) 
 +      ELSE IF (buoy_id5.NE.rvind) THEN 
 +         WRITE(*,*) 
 +         IF (wmo_region_number.EQ.rvind 
 +     +        .AND.wmo_region_subarea.EQ.rvind) THEN 
 +C     Old drau files (wrongly) includes wmo_region_number and 
 +C     wmo_region_subarea in 001005 Buoy/platform identifier. Should we 
 +C     expand this to 7 digits by inserting '00'? 
 +            WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id5) 
 +         ELSE IF (wmo_region_number.EQ.rvind
      +        .AND.wmo_region_subarea.NE.rvind) THEN      +        .AND.wmo_region_subarea.NE.rvind) THEN
-         IF (buoy_id.LT.1000) THEN +C     Some BUFR BUOYS on GTS have 'missing' value for wmo_region_number, 
-            WRITE(*,'(A,I5)') 'buoy_id=',NINT(wmo_region_number)*10000 +C     but not for wmo_region_subarea 
-     +           + NINT(wmo_region_subarea)*1000 + NINT(buoy_id) +            WRITE(*,'(A,I6)') 'buoy_id=', 
-         ELSE  +     +           NINT(wmo_region_subarea)*100000 + NINT(buoy_id5) 
-C     This is an error in encoding. We choose to show buoy_id only (and +         ELSE IF (wmo_region_number.NE.rvind 
-C     in all cases I have seen of this error, first 2 digits of buoy_id +     +        .AND.wmo_region_subarea.EQ.rvind) THEN 
-C     is wmo_region_number and wmo_region_subarea respectively). +C     Not easy to know how to display this case, but then I have never 
-            IF (buoy_id.LT.10000) THEN +C     seen this in practice 
-               WRITE(*,'(A,I4)') 'buoy_id=',NINT(buoy_id) +            WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id5) 
-            ELSE IF (buoy_id.LT.100000) THEN +         ELSE IF (buoy_id5.GT.10000.AND. 
-               WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id) +     +           (NINT(buoy_id5) - MOD(NINT(buoy_id5),1000)).EQ. 
-            ELSE IF (buoy_id.LT.1000000) THEN +     +           NINT(wmo_region_number)*10000 
-               WRITE(*,'(A,I6)') 'buoy_id=',NINT(buoy_id) +     +           + NINT(wmo_region_subarea)*1000) THEN 
-            ELSE +C     If first 2 digits of 5 digit buoy_id equals wmo_region_number and 
-               WRITE(*,'(A,I7)') 'buoy_id=',NINT(buoy_id) +C     wmo_region_subarea respectively, this is almost certainly an 
-            END IF +C     encoding error and we choose to show last 3 digits of buoy_id5 only 
-         END IF +           WRITE(*,'(A,I7)') 'buoy_id=',NINT(wmo_region_number)*1000000 
-      ELSE IF (buoy_id.NE.rvind.AND.buoy_id.GT.1000) THEN +     +           + NINT(wmo_region_subarea)*100000 
-C     Old drau files (wrongly) includes wmo_region_number and +     +           + MOD(NINT(buoy_id5),1000)
-C     wmo_region_subarea in 001005 Buoy/platform identifier +
-         IF (buoy_id.LT.10000) THEN +
-            WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id)+
          ELSE          ELSE
-C     New templates introduced in 2014 for data category 1 use 001087 +           WRITE(*,'(A,I7)') 'buoy_id=',NINT(wmo_region_number)*1000000 
-C     WMO Marine observing platform extended identifier, 7 digits +     +           + NINT(wmo_region_subarea)*100000 + NINT(buoy_id5)
-            WRITE(*,'(A,I7)') 'buoy_id=',NINT(buoy_id)+
          END IF          END IF
       ELSE       ELSE
          IF (verbose .GT. 1) THEN          IF (verbose .GT. 1) THEN
-            WRITE(*,*) 'Both wmonr, nationalnr, call_sign and', +            WRITE(*,*) 
-     +           ' buoy_id are missing!!!'+            WRITE(*,*) 'Both wmonr, wigosid, nationalnr, call_sign', 
 +     +           ' and buoy_id are missing!!!'
 C     Example: ISRZ47 EGRR has no proper station identification (except C     Example: ISRZ47 EGRR has no proper station identification (except
 C     station name and position) C     station name and position)
Line 1987: Line 2354:
                                 ! so display as integer                                 ! so display as integer
          WRITE(*,'(A,I7)') 'height=',NINT(height)          WRITE(*,'(A,I7)') 'height=',NINT(height)
 +      END IF
 +      IF (hp.NE.rvind) THEN
 +         WRITE(*,'(A,F11.1)') 'hp=',hp
       END IF       END IF
       IF (vs.NE.rvind) THEN       IF (vs.NE.rvind) THEN
Line 2408: Line 2778:
             n = n + 1           ! new level             n = n + 1           ! new level
             IF (n.GT.maxlevel) THEN             IF (n.GT.maxlevel) THEN
 +               n = maxlevel
                WRITE(*,*) 'Too many levels! Skipping rest of message'                WRITE(*,*) 'Too many levels! Skipping rest of message'
                GOTO 120                GOTO 120
Line 2415: Line 2786:
             n = n + 1           ! new level             n = n + 1           ! new level
             IF (n.GT.maxlevel) THEN             IF (n.GT.maxlevel) THEN
 +               n = maxlevel
                WRITE(*,*) 'Too many levels! Skipping rest of message'                WRITE(*,*) 'Too many levels! Skipping rest of message'
                GOTO 120                GOTO 120
Line 2420: Line 2792:
             w(n) = value             w(n) = value
          ELSE IF (desc.EQ.22045.OR.  ! Sea/water temperature (19 bits)          ELSE IF (desc.EQ.22045.OR.  ! Sea/water temperature (19 bits)
-     +           desc.EQ.22043.OR.   ! Sea/water temperature (15 bits)        +     +           desc.EQ.22043.OR.   ! Sea/water temperature (15 bits) 
-     +           desc.EQ.22042) THEN ! Sea/water temperature (12 bits)       +     +           desc.EQ.22042) THEN ! Sea/water temperature (12 bits)
             IF (n.GT.0 .AND. n.LE.maxlevel) THEN             IF (n.GT.0 .AND. n.LE.maxlevel) THEN
                t(n) = value                t(n) = value
Line 2493: Line 2865:
       END IF       END IF
  
-      WRITE(*,*) 
       IF (buoy_id.NE.rvind.AND.wmo_region_number.NE.rvind       IF (buoy_id.NE.rvind.AND.wmo_region_number.NE.rvind
      +     .AND.wmo_region_subarea.NE.rvind) THEN      +     .AND.wmo_region_subarea.NE.rvind) THEN
 +         WRITE(*,*)
          IF (buoy_id.LT.1000) THEN          IF (buoy_id.LT.1000) THEN
             WRITE(*,'(A,I5)') 'buoy_id=',NINT(wmo_region_number)*10000             WRITE(*,'(A,I5)') 'buoy_id=',NINT(wmo_region_number)*10000
      +           + NINT(wmo_region_subarea)*1000 + NINT(buoy_id)      +           + NINT(wmo_region_subarea)*1000 + NINT(buoy_id)
-         ELSE +         ELSE
 C     This is an error in encoding. We choose to show buoy_id only (and C     This is an error in encoding. We choose to show buoy_id only (and
 C     in all cases I have seen of this error, first 2 digits of buoy_id C     in all cases I have seen of this error, first 2 digits of buoy_id
Line 2516: Line 2888:
 C     Old drau files (wrongly) includes wmo_region_number and C     Old drau files (wrongly) includes wmo_region_number and
 C     wmo_region_subarea in buoy_id C     wmo_region_subarea in buoy_id
 +         WRITE(*,*)
          IF (buoy_id.LT.10000) THEN ! 001005          IF (buoy_id.LT.10000) THEN ! 001005
             WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id)             WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id)
Line 2529: Line 2902:
             ind = ind - 1             ind = ind - 1
          END DO          END DO
 +         WRITE(*,*)
          WRITE(*,'(A,A)') 'call_sign=',          WRITE(*,'(A,A)') 'call_sign=',
      +        call_sign(1:ind)      +        call_sign(1:ind)
       ELSE       ELSE
          IF (verbose .GT. 1) THEN          IF (verbose .GT. 1) THEN
 +            WRITE(*,*)
             WRITE(*,*) 'Both buoy_id and call_sign are missing!!!'             WRITE(*,*) 'Both buoy_id and call_sign are missing!!!'
          END IF          END IF
Line 2620: Line 2995:
       PARAMETER (rvind=1.7E38)       PARAMETER (rvind=1.7E38)
  
-      CHARACTER*8 aircraft,flight_number,missing8,spc8+      CHARACTER*8 aircraft,flight_number,missing8
 C     Parameters defined in Kvalobs C     Parameters defined in Kvalobs
       REAL*8 DD,FF,TT,PP,       REAL*8 DD,FF,TT,PP,
 C     Other parameters C     Other parameters
      +     year,month,day,hour,minute,second,latitude,longitude,      +     year,month,day,hour,minute,second,latitude,longitude,
-     +     flight_level,phase,osn+     +     flight_level,phase,osn,mixing_ratio
       CHARACTER*3 cphase,missing3       CHARACTER*3 cphase,missing3
       INTEGER idx,cidx,ind       INTEGER idx,cidx,ind
Line 2646: Line 3021:
       WRITE(missing8,'(8A)') one_bits,one_bits,one_bits,one_bits,       WRITE(missing8,'(8A)') one_bits,one_bits,one_bits,one_bits,
      +     one_bits,one_bits,one_bits,one_bits      +     one_bits,one_bits,one_bits,one_bits
-      spc8 = '        ' 
  
 C     Initialize all parameters to missing values C     Initialize all parameters to missing values
Line 2667: Line 3041:
       flight_level = rvind       flight_level = rvind
       phase = rvind       phase = rvind
 +      mixing_ratio = rvind
  
 C     Loop through all expanded descriptors C     Loop through all expanded descriptors
Line 2681: Line 3056:
          IF (desc.EQ.1008) THEN ! Aircraft registration number or other identification          IF (desc.EQ.1008) THEN ! Aircraft registration number or other identification
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc8) THEN +            aircraft = cvals(cidx) ! CCITTIA5 data 
-               aircraft = cvals(cidx) ! CCITTIA5 data +            aircraft = ctrim(aircraft,8,missing8)
-               aircraft = ctrim(aircraft,8,missing8) +
-            END IF+
          ELSE IF (desc.EQ.1006) THEN ! Aircraft flight number          ELSE IF (desc.EQ.1006) THEN ! Aircraft flight number
             cidx = int(value/1000)             cidx = int(value/1000)
-            IF (cvals(cidx).NE.spc8) THEN +            flight_number = cvals(cidx) ! CCITTIA5 data 
-               flight_number = cvals(cidx) ! CCITTIA5 data +            flight_number = ctrim(flight_number,8,missing8)
-               flight_number = ctrim(flight_number,8,missing8) +
-            END IF+
          ELSE IF (desc.EQ.1023) THEN ! Observation sequence number          ELSE IF (desc.EQ.1023) THEN ! Observation sequence number
             IF (osn.EQ.rvind) osn = value             IF (osn.EQ.rvind) osn = value
Line 2764: Line 3135:
             IF (PP.EQ.rvind) THEN             IF (PP.EQ.rvind) THEN
                PP = value                PP = value
 +            END IF
 +         ELSE IF (desc.EQ.13002) THEN ! Mixing ratio
 +            IF (mixing_ratio.EQ.rvind) THEN
 +               mixing_ratio = value
             END IF             END IF
          END IF          END IF
Line 2774: Line 3149:
       END IF       END IF
  
-      WRITE(*,*) 
       IF (aircraft.NE.missing8) THEN       IF (aircraft.NE.missing8) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,A)') 'aircraft=',aircraft(1:lenstr(aircraft,1))          WRITE(*,'(A,A)') 'aircraft=',aircraft(1:lenstr(aircraft,1))
       ELSE IF (flight_number.NE.missing8) THEN       ELSE IF (flight_number.NE.missing8) THEN
 +         WRITE(*,*)
          WRITE(*,'(A,A)') 'aircraft=',          WRITE(*,'(A,A)') 'aircraft=',
      +        flight_number(1:lenstr(flight_number,1))      +        flight_number(1:lenstr(flight_number,1))
       ELSE       ELSE
          IF (verbose .GT. 1) THEN          IF (verbose .GT. 1) THEN
 +            WRITE(*,*)
             WRITE(*,*) 'Aircraft (001008/001006) is missing!!!'             WRITE(*,*) 'Aircraft (001008/001006) is missing!!!'
          END IF          END IF
Line 2828: Line 3205:
       END IF       END IF
       IF (PP.NE.rvind) THEN       IF (PP.NE.rvind) THEN
-         WRITE(*,'(A,I16)') 'PP=',NINT(PP)+         WRITE(*,'(A,F16.1)') 'PP=',PP/100 ! hPa 
 +      END IF 
 +      IF (mixing_ratio.NE.rvind) THEN 
 +         WRITE(*,'(A,F16.2)') 'mr=',mixing_ratio*1000 ! g/kg
       END IF       END IF
  
Line 3114: Line 3494:
       return       return
       end       end
-</code> +</code>      
 <code fortran comfilter.f> <code fortran comfilter.f>
 C (C) Copyright 2010, met.no C (C) Copyright 2010, met.no
  • bufr.pm/bufrdump.1426684759.txt.gz
  • Last modified: 2022-05-31 09:23:11
  • (external edit)