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 [2016-09-16 13:43:40]
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 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 259: Line 263:
       IF (ksec1(6).GT.2 .AND. ksec1(6).NE.4 .AND. ksec1(6).NE.6       IF (ksec1(6).GT.2 .AND. ksec1(6).NE.4 .AND. ksec1(6).NE.6
      +     .AND. ksec1(6).NE.31) RETURN      +     .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 294: 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 306: 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 334: 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 346: 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 823: 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=10000)+      PARAMETER(maxlevel=100000)
  
       REAL*8 P(maxlevel),D(maxlevel),F(maxlevel),       REAL*8 P(maxlevel),D(maxlevel),F(maxlevel),
Line 855: 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 907: Line 930:
                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 989: 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 1218: Line 1282:
       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 (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       ELSE
          IF (verbose .GT. 1) THEN          IF (verbose .GT. 1) THEN
 +            WRITE(*,*)
             WRITE(*,*) 'Both wmonr and call sign are missing!!!'             WRITE(*,*) 'Both wmonr and call sign are missing!!!'
          END IF          END IF
Line 1287: Line 1353:
  
       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 1298: 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 1303: 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 1315: 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,a3,buoy_id,ds,+     +     year,month,day,hour,minute,a3,buoy_id5,buoy_id7,ds,
      +     height,hhh,hp,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 1334: 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 1349: 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 1364: 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 1370: 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 1471: 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 1528: 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 1553: 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 1758: 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 1785: 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 1804: 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 1989: 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 2011: 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 2091: 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 2103: 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 2126: 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 2140: 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=', 
 +     +           NINT(wmo_region_subarea)*100000 + NINT(buoy_id5) 
 +         ELSE IF (wmo_region_number.NE.rvind 
 +     +        .AND.wmo_region_subarea.EQ.rvind) THEN 
 +C     Not easy to know how to display this case, but then I have never 
 +C     seen this in practice 
 +            WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id5) 
 +         ELSE IF (buoy_id5.GT.10000.AND. 
 +     +           (NINT(buoy_id5) - MOD(NINT(buoy_id5),1000)).EQ. 
 +     +           NINT(wmo_region_number)*10000 
 +     +           + NINT(wmo_region_subarea)*1000) THEN 
 +C     If first 2 digits of 5 digit buoy_id equals wmo_region_number and 
 +C     wmo_region_subarea respectively, this is almost certainly an 
 +C     encoding error and we choose to show last 3 digits of buoy_id5 only 
 +           WRITE(*,'(A,I7)') 'buoy_id=',NINT(wmo_region_number)*1000000 
 +     +           + NINT(wmo_region_subarea)*100000 
 +     +           + MOD(NINT(buoy_id5),1000)
          ELSE          ELSE
-C     This is an error in encoding. We choose to show buoy_id only (and +           WRITE(*,'(A,I7)') 'buoy_id=',NINT(wmo_region_number)*1000000 
-C     in all cases I have seen of this error, first 2 digits of buoy_id +     +           + NINT(wmo_region_subarea)*100000 + NINT(buoy_id5)
-C     is wmo_region_number and wmo_region_subarea respectively). +
-            IF (buoy_id.LT.10000) THEN +
-               WRITE(*,'(A,I4)') 'buoy_id=',NINT(buoy_id) +
-            ELSE IF (buoy_id.LT.100000) THEN +
-               WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id) +
-            ELSE IF (buoy_id.LT.1000000) THEN +
-               WRITE(*,'(A,I6)') 'buoy_id=',NINT(buoy_id) +
-            ELSE +
-               WRITE(*,'(A,I7)') 'buoy_id=',NINT(buoy_id) +
-            END IF +
-         END IF +
-      ELSE IF (buoy_id.NE.rvind.AND.buoy_id.GT.1000) THEN +
-C     Old drau files (wrongly) includes wmo_region_number and +
-C     wmo_region_subarea in 001005 Buoy/platform identifier +
-         IF (buoy_id.LT.10000) THEN +
-            WRITE(*,'(A,I5)') 'buoy_id=',NINT(buoy_id) +
-         ELSE +
-C     New templates introduced in 2014 for data category 1 use 001087 +
-C     WMO Marine observing platform extended identifier, 7 digits +
-            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 2730: 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
Line 2753: 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 2766: 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 2857: 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 2883: 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 2904: 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 2918: 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 3001: 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 3011: 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 3065: 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 3351: 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.1474033420.txt.gz
  • Last modified: 2022-05-31 09:23:11
  • (external edit)