      PROGRAM BFDEMO
!                                                                       
!     BFDEMO - Program to demonstrate use of BUFREX routine.            
!                                                                       
!     Purpose.                                                          
!     --------                                                          
!                                                                       
!     Demonstrates use of BUFREX routine to unpack                      
!     BUFR coded data.                                                  
!                                                                       
!     Interface.                                                        
!     ----------                                                        
!                                                                       
!     File of BUFR coded data attached as 'input_datafile'              
!                                                                       
!     Method.                                                           
!     -------                                                           
!                                                                       
!     Read BUFR messages and print sections 0, 1, 2, 3 and 4.                 
!                                                                       
!                                                                       
!     Externals.                                                        
!     ----------     
!
!     PBOPEN
!     PBCLOSE
!     PBBUFR
!     BUS012
!     BUFREX
!     BUPRS0
!     BUPRS1
!     BUPRS2
!     BUPRS3
!     BUUKEY
!     BUSEL
!     BUPRT
!
!                                                                       
!     WMO Manual on Codes, Volume I, International Codes, PartB-Binary Codes  
!     WMO No. 306, FM 94-IX Ext BUFR.      
!                                                                       
!     Comments.                                                         
!     ---------                                                         
!                                                                       
!     BUFREX provides a number of packing/unpacking options.       
!     See documentation in routine BUFREX for details.                  
!                                                                       
!     Author.                                                           
!     -------                                                           
!                                                                       
!     M. Dragosavac                                 
!                                                                       
!     Modifications.                                                    
!     --------------
!     
!     U. Modigliani     ECMWF   08.97
!                       rewritten in Fortran 90
!
!-----------------------------------------------------------------
!                                         
      IMPLICIT NONE     
!
      EXTERNAL PBOPEN, PBCLOSE, PBBUFR, BUS012, BUFREX, BUPRS0, BUPRS1, &
               BUPRS2, BUPRS3, BUUKEY, BUSEL, BUPRT    
!                                                                       
!     This parameter holds the 'number of bytes per integer'    
!   
      INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)   
!
!     These parameters hold the 'number of bytes per single/double precision real'    
!   
      INTEGER(KIND=I4B), PARAMETER :: NBYTES_SP = KIND(1.0)           
!
      INTEGER(KIND=I4B), PARAMETER :: NBYTES_DP = KIND(1.0D0)
!
      INTEGER(KIND=I4B), PARAMETER :: JSUP = 9, JSEC0 = 3, JSEC1 = 40, &
                         JSEC2 = 4096, JSEC3 = 4, JSEC4 = 2, JKEY = 46

!     The default size of the Section 1 is 18 octets and 22 octets for
!     Bufr Edition 4, if there are no local entries.
!                                                                       
      INTEGER(KIND=I4B), PARAMETER :: & ! These paramters depend on the input data!
        KELEM =  80000,  &              ! expected number of expanded elements
        KVALS = 360000,  &              ! expected number of data values
        JBUFL =  20000                  ! length of bufr message (words)
!
      INTEGER(KIND=I4B), DIMENSION(JBUFL) :: KBUFF
!                                                                       
!      CHARACTER(LEN=*), PARAMETER :: INPUT_FILE='../data/synop_4.bufr'
      CHARACTER(LEN=*), PARAMETER :: OPEN_MODE='r'
!
      CHARACTER(LEN=64), DIMENSION(KELEM)  :: CNAMES
      CHARACTER(LEN=24), DIMENSION(KELEM)  :: CUNITS
      CHARACTER(LEN=80), DIMENSION(KVALS)  :: CVALS
!                                                                       
      INTEGER(KIND=I4B), DIMENSION(JSUP)  :: KSUP 
      INTEGER(KIND=I4B), DIMENSION(JSEC0) :: KSEC0 
      INTEGER(KIND=I4B), DIMENSION(JSEC1) :: KSEC1 
      INTEGER(KIND=I4B), DIMENSION(JSEC2) :: KSEC2
      INTEGER(KIND=I4B), DIMENSION(JSEC3) :: KSEC3
      INTEGER(KIND=I4B), DIMENSION(JSEC4) :: KSEC4
       
      INTEGER(KIND=I4B), DIMENSION(JKEY) :: KEY 
!                                                                       
!     The array VALUES (and the missing value indicator RVIND) are
!     declared as REAL*8 from emoslib version 370 onwards.
!
      REAL(KIND=NBYTES_DP), DIMENSION(KVALS)  :: VALUES
!      
      INTEGER(KIND=I4B), DIMENSION(KELEM) :: KTDLST, KTDEXP
!                                                                       
!     DATA CNAMES / KELEM * ' ' / , CUNITS / KELEM * ' ' / 
!                                                                       
!     Clear error counter.
!                                              
      INTEGER(KIND=I4B) :: NUMERR = 0    
!                                                                       
!     Set message counter.
!                                               
      INTEGER(KIND=I4B) :: NMESSAGE = 0   
      INTEGER(KIND=I4B) :: ISTATUS = 0 
      INTEGER(KIND=I4B) :: KUNIT, KBUFL, KEL, KTDLEN, KTDEXL
      INTEGER(KIND=I4B) :: IONE = 1
      INTEGER(KIND=I4B) :: ONE = 1 
!
      INTEGER :: i
      CHARACTER(len=255) :: arg
      CALL getarg(1, arg)
      CNAMES = ' '
      CUNITS = ' '
      CVALS = ' ' 
!                                                                       
!     Open input file for reading.   
!                                    
      CALL PBOPEN (KUNIT, arg, OPEN_MODE, ISTATUS) 
!
!     Check return code.
!      
      WRITE ( * , * ) ' ' 
      WRITE ( * , * ) 'BFDEMO: After PBOPEN, status code   = ', ISTATUS 
      WRITE ( * , * ) ' ' 
      IF (ISTATUS .NE. 0) THEN 
          CALL PBCLOSE (KUNIT, ISTATUS)
          STOP 'BFDEMO: PBOPEN failed.'
      END IF       
!                                                                       
!     This is the beginning of a loop through BUFR records
!     reading one field at a time from the input datafile. 
!                                                                       
LOOP: DO WHILE (.TRUE.)     
!                                                               
         WRITE ( * , * ) '****************************************************' 
         WRITE ( * , * ) ' ' 
         CALL PBBUFR (KUNIT, KBUFF, JBUFL * NBYTES_SP, KBUFL, ISTATUS) 
         WRITE ( * , * ) 'BFDEMO: After PBBUFR, status code   = ', ISTATUS 
!                                                                       
         IF (ISTATUS .EQ. - 1) THEN
!
!        Exit the DO loop.
!
	        EXIT LOOP
         END IF
!        
!        It can be more specific: see PBBUFR error codes.
!                                                                      
         IF (ISTATUS .LT. - 1) THEN  
            CALL PBCLOSE (KUNIT, ISTATUS)
            STOP 'BFDEMO: Error reading file.' 
         END IF
!                                                                       
         NMESSAGE = NMESSAGE + 1 
!      
         WRITE ( * , * ) 'BFDEMO: BUFR message number         = ', NMESSAGE 
         WRITE ( * , * ) 'BFDEMO: Length of message           = ', KBUFL 
         WRITE ( * , * ) ' ' 
         WRITE ( * , * ) '****************************************************'
         WRITE ( * , * ) ' ' 
!                                                                       
         KBUFL = KBUFL / NBYTES_SP + 1 
!
!        Expands only section 0, 1 and 2 of Bufr message.
!                                                                  
         CALL BUS012 (KBUFL, KBUFF, KSUP, KSEC0, KSEC1, KSEC2, ISTATUS)       
!              
         IF(ISTATUS .NE. 0) THEN
            WRITE ( * , * ) 'Error in BUS012: ', ISTATUS
            CYCLE LOOP
         END IF
!
!        Decode Bufr message into fully expanded form; returning
!        information relevant for all Bufr sections, expanded values,
!        their names and units.
!      
         KEL=KELEM
         IF(KSUP(6).GT.1) THEN 
           KEL=KVALS/KSUP(6)
           IF (KEL.GT.KELEM) KEL=KELEM
         END IF
!
         CALL BUFREX (KBUFL, KBUFF, KSUP, KSEC0, KSEC1, KSEC2, KSEC3, KSEC4,   &
                      KEL, CNAMES, CUNITS, KVALS, VALUES, CVALS, ISTATUS)    
!                    
!        Check return code.
!                                                                       
         IF (ISTATUS .GT. 0) THEN
!
!           Increase the number of errors' counter.
! 
            NUMERR = NUMERR + 1 
            CYCLE LOOP
         END IF       
!
!        Print section 0 of Bufr message.
!            
         CALL BUPRS0 (KSEC0)      
!
!        Print section 1 of Bufr message.
!       
         CALL BUPRS1 (KSEC1) 
!
!        Expands local ECMWF information from section 2.
!    
         CALL BUUKEY (KSEC1, KSEC2, KEY, KSUP, ISTATUS) 
!
!        Print section 2 of Bufr message (expanded RDB key).
!
         CALL BUPRS2 (KSUP, KEY) 
!     
!        Returns list of Data Descriptors as in Section 3  of Bufr
!        message and total/requested list of elements.
!
         CALL BUSEL (KTDLEN, KTDLST, KTDEXL, KTDEXP, ISTATUS) 
!
!        Print section 3 of Bufr message.
!  
         CALL BUPRS3 (KSEC3, KTDLEN, KTDLST, KTDEXL, KTDEXP, KELEM, CNAMES) 
!                                                                       
!        Print expanded Bufr message.
!                                                                  
         CALL BUPRT (IONE, ONE, KSUP(6), KEL, CNAMES, CUNITS, CVALS, KVALS, &
	             VALUES, KSUP, KSEC1, ISTATUS)
!                                                                       
!        Loop back for next BUFR record.                                   
!                                                                       
      END DO LOOP
!                                                                       
!     End-of-file on input.                                             
!
      WRITE ( * , * ) 'BFDEMO: End-of-file on input.'  
      WRITE ( * , * ) ' ' 
      WRITE ( * , * ) '****************************************************' 
      WRITE ( * , * ) ' ' 
      WRITE ( * , * ) 'BFDEMO: Number of records processed = ', NMESSAGE 
      WRITE ( * , * ) 'BFDEMO: Number of decoding errors   = ', NUMERR 
      WRITE ( * , * ) ' ' 
      WRITE ( * , * ) '****************************************************'
! 
      CALL PBCLOSE (KUNIT, ISTATUS)
!                         
	  STOP 'BFDEMO: Terminated'
!                                       
      END PROGRAM BFDEMO                            
