SUBROUTINE SF_BUFR  ( iret )
C************************************************************************
C* SF_BUFR								*
C*									*
C* This subroutine retrieves data from the interface arrays, converts	*
C* it into BUFR output, and then writes the BUFR output to the BUFR	*
C* output stream.							*
C*									*
C* SF_BUFR  ( IRET )							*
C*									*
C* Input parameters:							*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* J. Ator/NCEP		04/05						*
C* J. Ator/NCEP		07/06	Set BUFR types/subtypes based upon STYP	*
C* J. Ator/NCEP		11/09	Add WACN to BUFR output			*
C* S. Guan/NCEP         08/11   Decode HM height of tide                *
C* J. Ator/NCEP		02/14	Process RVF forecast data		*
C* J. Ator/NCEP		08/14	Add processing of multiple levels of	*
C*				discharge and height			*
C* J. Ator/NCEP		02/19	Write to afospcp output BUFR file	*
C* J. Ator/NCEP		04/19	Add BID info to afospcp output BUFR file*
C* M. Weiss/NCEP        05/20   Added logic to process the parameter    * 
C*                              code for water velocity (WVIRG) and     *
C*                              elevation of a natural lake (HLIRG) to  *
C*                              accomodate stations BRKQ6 and YNTN6.    * 
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
	INCLUDE		'BUFR.CMN'
	INCLUDE		'sfcmn.cmn'
C*
	PARAMETER	( MXBFPM = 6 )
C*
	PARAMETER	( MAXTD = 10 )
	PARAMETER	( MAXHD = 5 )
C*
	CHARACTER	ctds(MAXTD)*2, ctd*2, cimn*8, bfrstr*4, iqual,
     +			bfstyp*8
C*
	INTEGER		itds(MAXTD),
     +			nht(MXBFLV), ndc(MXBFLV)
C*
	LOGICAL		newtd, newflv
C*
        REAL*8          r8ary (4), r8ft ( MXBFPM, MXBFLV ),
     +			r8ht ( MXBFLV, 5, MAXHD ), r8htn ( 5, MXBFLV ),
     +			r8dc ( MXBFLV, 5, MAXHD ), r8dcn ( 5, MXBFLV ),
     +			UT_RIBM, SF_FCTS, SF_DCHS, SF_HGTS, PKFTBV
C*
	INCLUDE		'ERMISS.FNC'
C*-----------------------------------------------------------------------
C
	iret = 0
C
	year = rivals (1)
	rmth = rivals (2)
	days = rivals (3)
	hour = rivals (4)
	rmin = rivals (5)
	IF  ( ( ERMISS ( year ) ) .or. ( ERMISS ( rmth ) ) .or.
     +	      ( ERMISS ( days ) ) .or. ( ERMISS ( hour ) )  )  THEN
		RETURN
	END IF
C 
	ibfdt = ( INT ( year ) * 1000000 ) +
     +		( INT ( rmth ) * 10000 )  +
     +		( INT ( days ) * 100 ) + INT ( hour )
C
C*      Check if this is an afospcp bulletin, and, if so, initialize
C*      a new BUFR message for that output stream.
C
        IF ( afpcp ) THEN
            ibfop = ibufro (NBUFRO)
	    CALL OPENMB ( ibfop, 'NC000011', ibfdt )
	    CALL UT_CIBF ( ibfop, 'RPID', civals (1), 8, iercbf )
	    CALL UT_RIBF ( ibfop, 'YEAR', year, ierrbf )
	    CALL UT_RIBF ( ibfop, 'MNTH', rmth, ierrbf )
	    CALL UT_RIBF ( ibfop, 'DAYS', days, ierrbf )
	    CALL UT_RIBF ( ibfop, 'HOUR', hour, ierrbf )
	    CALL UT_RIBF ( ibfop, 'MINU', rmin, ierrbf )
	    CALL UT_RIBF ( ibfop, 'CLAT' , rivals (6), ierrbf )
	    CALL UT_RIBF ( ibfop, 'CLON' , rivals (7), ierrbf )
	    CALL UT_CIBF ( ibfop, 'SEQNUM', seqnum, 8, iercbf )
	    CALL UT_CIBF ( ibfop, 'BUHD', buhd, 8, iercbf )
	    CALL UT_CIBF ( ibfop, 'BORG', cborg, 8, iercbf )
	    CALL UT_CIBF ( ibfop, 'BULTIM', bulldt, 8, iercbf )
	    CALL UT_CIBF ( ibfop, 'BBB', bbb, 8, iercbf )
        END IF
C
C*	Divide the interface values into groups based upon their
C*	associated time durations.  Then, encode a separate BUFR
C*	report for each such group of values.
C
	ntd = 0
	IF ( dattyp .eq. 'F' ) THEN
	    inc = 8
	ELSE
	    inc = 3
	END IF
C
	DO WHILE ( .true. )
C
C*	    Determine the next time duration for which to encode
C*	    a BUFR report.
C
	    irptr = 9 + ( ntd * inc )
	    newtd = .false.
	    DO WHILE  ( ( .not. newtd ) .and.
     +		       ( ( irptr + inc - 1 ) .le. nimn ) )
		ctd = rimnem ( irptr )(5:6)
		itd = INT ( rivals ( irptr ) )
C
C*		Is this a "new" time duration (for which we haven't
C*		yet encoded a BUFR report)?  Note that, for now at
C*		least, we aren't encoding any forecast data which
C*		has a non-zero time duration.
C
		IF  ( ( dattyp .eq. 'F' ) .and. ( itd .ne. 0 ) ) THEN
		  irptr = irptr + inc
		ELSE
		  i = 1
		  newtd = .true.
		  DO WHILE  ( ( i .le. ntd ) .and. ( newtd ) )
		    IF ( ( ctd .eq. ctds (i) ) .and.
     +			 ( itd .eq. itds (i) ) ) THEN
		      newtd = .false.
		      irptr = irptr + inc
		    ELSE
		      i = i + 1
		    END IF
		  END DO
		END IF 
	    END DO
	    IF  ( .not. newtd )  THEN
C
C*		We are done!
C
	        IF ( afpcp ) CALL UT_WBFR ( ibfop, 'shef', 0, ierwbf )
		RETURN
	    END IF
C
C*	    Initialize a BUFR report for this time duration.
C 
	    IF ( dattyp .eq. 'F' ) THEN
		bfstyp = 'NC001014'
		itab = 2
	    ELSE IF ( ( civals (2)(1:4) .eq. 'COOP' ) .or.
     +		      ( civals (2)(1:5) .eq. 'UCOOP' ) )  THEN
		bfstyp = 'NC255102'
		itab = 3
	    ELSE IF ( civals (2)(1:5) .eq. 'C-MAN' ) THEN
		bfstyp = 'NC001010'
		itab = 2
	    ELSE IF ( civals (2)(1:4) .eq. 'BUOY' ) THEN
		bfstyp = 'NC001011'
		itab = 2
	    ELSE IF ( ( civals (2)(1:4) .eq. 'CTGN' ) .or.
     +		      ( civals (2)(1:3) .eq. 'HTG' ) )  THEN
		bfstyp = 'NC001012'
		itab = 2
	    ELSE
		bfstyp = 'NC000010'
		itab = 1
	    END IF
	    ibfo = ibufro ( itab )
C 
	    CALL OPENMB  ( ibfo, bfstyp, ibfdt )
C 
C*	    Report ID.
C
	    CALL UT_CIBF  ( ibfo, 'RPID', civals (1), 8, iercbf )
C
C*	    Report date-time.
C
	    CALL UT_RIBF  ( ibfo, 'YEAR', year, ierrbf )
	    CALL UT_RIBF  ( ibfo, 'MNTH', rmth, ierrbf )
	    CALL UT_RIBF  ( ibfo, 'DAYS', days, ierrbf )
	    CALL UT_RIBF  ( ibfo, 'HOUR', hour, ierrbf )
	    CALL UT_RIBF  ( ibfo, 'MINU', rmin, ierrbf )
C
C*	    Time duration.
C
	    IF ( dattyp .ne. 'F' ) THEN
	        IF ( .not. ERMISS ( rivals ( irptr ) ) )  THEN
		  CALL UT_RIBF  ( ibfo, 'TP' // ctd ,
     +			( rivals ( irptr ) * (-1) ) , ierrbf )
		END IF
	    END IF
C
C*	    Latitude, longitude and elevation.
C
	    CALL UT_RIBF  ( ibfo, 'CLAT' , rivals (6), ierrbf )
	    CALL UT_RIBF  ( ibfo, 'CLON' , rivals (7), ierrbf )
	    CALL UT_RIBF  ( ibfo, 'HSMSL', rivals (8), ierrbf )
C
C*	    Receipt date-time.
C
	    CALL UT_RIBF ( ibfo, 'RCYR', FLOAT ( irundt(1) ), ierrbf )
	    CALL UT_RIBF ( ibfo, 'RCMO', FLOAT ( irundt(2) ), ierrbf )
	    CALL UT_RIBF ( ibfo, 'RCDY', FLOAT ( irundt(3) ), ierrbf )
	    CALL UT_RIBF ( ibfo, 'RCHR', FLOAT ( irundt(4) ), ierrbf )
	    CALL UT_RIBF ( ibfo, 'RCMI', FLOAT ( irundt(5) ), ierrbf )
	    CALL UT_RIBF ( ibfo, 'RCTS', 0., ierrbf )
C
C*	    Bulletin ID information.
C
	    CALL UT_CIBF  ( ibfo, 'SEQNUM', seqnum, 8, iercbf )
	    CALL UT_CIBF  ( ibfo, 'BUHD', buhd, 8, iercbf )
	    CALL UT_CIBF  ( ibfo, 'BORG', cborg, 8, iercbf )
	    CALL UT_CIBF  ( ibfo, 'BULTIM', bulldt, 8, iercbf )
	    CALL UT_CIBF  ( ibfo, 'BBB', bbb, 8, iercbf )
C
C*	    Locate all other interface values which have this same time
C*	    duration and encode them into this BUFR report.
C
	    nst = 0
	    nmxst = 0
	    nmist = 0
	    nflv = 0
	    DO WHILE  ( ( irptr + inc - 1 ) .le. nimn )
		IF  ( ( rimnem ( irptr )(5:6) .eq. ctd ) .and.
     +		      ( INT ( rivals ( irptr ) ) .eq. itd ) )  THEN
C
		    rvalu = rivals ( irptr + 1 )
C
C*		    Encode this interface value, along with its
C*		    associated SHEF revision and qualifier flags,
C*		    into the BUFR report.
C*		    
		    cimn  = rimnem ( irptr + 1 )
		    IF  ( ( cimn(1:2) .eq. 'MX' ) .or.
     +			  ( cimn(1:2) .eq. 'MN' ) )  THEN
			ipt = 3
		    ELSE
			ipt = 1
		    END IF
C
C*		    SHEF revision flag.
C
		    r8ary (3) = UT_RIBM ( rivals ( irptr + 2 ) )
C
C*		    SHEF qualifier flag.
C
		    iqual = civals ( irptr + 1 )(1:1)
		    r8ary (4) =
     +			UT_RIBM ( FLOAT ( MOVA2I ( iqual ) - 64 ) )
C
C*		    For now at least, the only forecast variables we're
C*		    encoding are 'DCH' and 'HGT' and now 'WVL'.
C*                                                   (Water Velocity)
                    IF  ( ( dattyp .ne. 'F' ) .or.
     +			  ( cimn(1:3) .eq. 'DCH' ) .or.
     +                    ( cimn(1:3) .eq. 'WVL' ) .or.
     +			  ( cimn(1:3) .eq. 'HGT' ) )  THEN
C
		      IF ( dattyp .eq. 'F' ) THEN
C
C*			Get the forecast valid time.
C
			fyr = rivals ( irptr + 3 )
			fmo = rivals ( irptr + 4 )
			fdy = rivals ( irptr + 5 )
			fhr = rivals ( irptr + 6 )
			fmi = rivals ( irptr + 7 )
C
C*			Is there already a level in the forecast data
C*			array for this valid time?
C
			i = 1
			newflv = .true.
			DO WHILE  ( ( i .le. nflv ) .and. ( newflv ) )
			  IF  ( ( fyr .eq. r8ft ( 2, i ) ) .and.
     +				( fmo .eq. r8ft ( 3, i ) ) .and.
     +				( fdy .eq. r8ft ( 4, i ) ) .and.
     +				( fhr .eq. r8ft ( 5, i ) ) .and.
     +				( fmi .eq. r8ft ( 6, i ) ) )  THEN
C
C*			    YES, so add the new interface values to
C*			    this level.
C
			    newflv = .false.
			    iflv = i
			  ELSE
			    i = i + 1
			  END IF
			END DO
			IF ( newflv ) THEN
C
C*			  NO, so initialize a new level in the forecast
C*			  data array to hold the new interface values.
C
			  nflv = nflv + 1
			  iflv = nflv
			  r8ft ( 1, iflv ) = 4.
			  r8ft ( 2, iflv ) = fyr
			  r8ft ( 3, iflv ) = fmo
			  r8ft ( 4, iflv ) = fdy
			  r8ft ( 5, iflv ) = fhr
			  r8ft ( 6, iflv ) = fmi
			  nht ( iflv ) = 0
			  ndc ( iflv ) = 0
			  DO j = 1, MAXHD
			    DO i = 1, 5
			      r8ht ( iflv, i, j ) = r8bfms
			      r8dc ( iflv, i, j ) = r8bfms
			    END DO
			  END DO
			END IF
C
		      END IF      ! dattyp .eq. 'F'
C
		      IF  ( cimn .eq. 'TPCI    ' )  THEN
C
C*			Total precipitation.
C
			r8ary (2) = UT_RIBM ( PR_INMM ( rvalu ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'TOPC', ierfsq )
                        IF ( afpcp ) THEN 
                          IF ( ( ctd .eq. 'HR') .and.
     +                        ( ( itd .eq. 1 ) .or. ( itd .eq. 3 ) .or.
     +                          ( itd .eq. 6 ) .or. ( itd .eq. 12 ) .or.
     +                          ( itd .eq. 24 ) ) )  THEN
                            WRITE ( UNIT = bfrstr, FMT = '( A, I2.2 )' )
     +                          'TP', itd
                          ELSE
                            bfrstr = 'TOPC'
                          END IF
                          afpv = UT_BMRI ( r8ary (2) )
                          CALL UT_RIBF ( ibfop, bfrstr, afpv, ierrbf )
                        END IF
C
		      ELSE IF  ( cimn .eq. 'SHPT    ' )  THEN
C
C*			Type of precipitation.
C
			ishpt = INT ( rvalu )
			IF  ( ( ishpt .ge. 0 ) .and.
     +			      ( ishpt .le. 9 ) ) THEN
			  IF  ( ishpt .eq. 0 )  THEN
			    r8ary (2) = PKFTBV ( 30, 19 )
			  ELSE IF  ( ishpt .eq. 1 )  THEN
			    r8ary (2) = PKFTBV ( 30,  5 )
			  ELSE IF  ( ishpt .eq. 2 )  THEN
			    r8ary (2) = PKFTBV ( 30,  3 ) +
     +					PKFTBV ( 30,  5 )
			  ELSE IF  ( ishpt .eq. 3 )  THEN
			    r8ary (2) = PKFTBV ( 30,  4 )
			  ELSE IF  ( ishpt .eq. 4 )  THEN
			    r8ary (2) = PKFTBV ( 30,  3 ) +
     +					PKFTBV ( 30,  4 )
			  ELSE IF  ( ishpt .eq. 5 )  THEN
			    r8ary (2) = PKFTBV ( 30,  7 )
			  ELSE IF  ( ishpt .eq. 6 )  THEN
			    r8ary (2) = PKFTBV ( 30,  9 )
			  ELSE IF  ( ishpt .eq. 7 )  THEN
			    r8ary (2) = PKFTBV ( 30,  8 )
			  ELSE IF  ( ishpt .eq. 8 )  THEN
			    r8ary (2) = PKFTBV ( 30, 10 )
			  ELSE
			    r8ary (2) = PKFTBV ( 30, 14 )
			  END IF
			  CALL SF_BFSQ ( r8ary, 3, ibfo, 'PRTP',
     +					 ierfsq )
			END IF
C
                      ELSE IF  ( cimn(1:3) .eq. 'HGT' )  THEN
C
C*			Height.
C
			r8ary (2) = UT_RIBM ( PR_HGFM ( rvalu ) )
C
C*                      Forecast Parameter Codes (dattyp = F)
C*                      See sfintf.f: IF parcod(4:5) = FF or
C*                                       parcod(1:5) = HGIFZ or 
C*                                       parcod(1:5) = HGIFE then 
C* F (fcst types)       Parameter Code  Interface Mnemonic (cimn)
C* FF = includes QPF    HGIFF   -->     HGTGF - Height river stage 
C*                      HMIFF   -->     HGTMF - Height of tide 
C*                NEW   HLIFF   -->     HGTLF - Elevation, natural lake 
C*                      HPIRG   -->     HGTPF - Elevation, reservior pool       
C*                      Note: HLIFF not present in SHEF ingest files 
C* FZ = Nonspecific     HGIFZ   -->     HGTGZ - Height river stage 
C* FE = Public version  HGIFE   -->     HGTGE - Height river stage 
C
			IF ( dattyp .eq. 'F' ) THEN
			  IF ( nht ( iflv ) .lt. MAXHD ) THEN
			    nht(iflv) = nht(iflv) + 1
			    r8ht ( iflv, 1, nht(iflv) ) =
     +			      SF_FCTS ( cimn(5:5) )
			    r8ht ( iflv, 2, nht(iflv) ) =
     +			      SF_HGTS ( cimn(4:4) )
			    r8ht ( iflv, 3, nht(iflv) ) = r8ary (2)
			    r8ht ( iflv, 4, nht(iflv) ) = r8ary (3)
			    r8ht ( iflv, 5, nht(iflv) ) = r8ary (4)
			  END IF
C
C*                      Observation Parameter Codes (dattyp ne F)
C* R (obs types)        Parameter Code  Interface Mnemonic  (cimn)
C* RG = GOES            HGIRG   -->     HGTG - Height river stage
C*                      HMIRG   -->     HGTM - Height of tide
C*                NEW   HLIRG   -->     HGTL - Elevation, natural lake 
C*                      HPIRG   -->     HGTP - Elevation, reservior pool
C
			ELSE IF ( cimn (4:4) .eq. 'G' ) THEN
			  CALL SF_BFSQ ( r8ary, 3, ibfo, 'RSHM',
     +					 ierfsq )
			ELSE IF ( cimn (4:4) .eq. 'M' ) THEN
			  CALL SF_BFSQ ( r8ary, 3, ibfo, 'TLLW',
     +					 ierfsq )
			ELSE IF ( cimn (4:4) .eq. 'L' ) THEN
			  CALL SF_BFSQ ( r8ary, 3, ibfo, 'TERC',
     +					 ierfsq )
			END IF
C
                      ELSE IF  ( cimn(1:3) .eq. 'WVL' )  THEN
C
C*			 Speed of Current (meters/second)
C
                        r8ary (2) = UT_RIBM ( PR_HGFM ( rvalu ) )
C
C*                      Forecast Parameter Codes (dattyp = F)
C*                      See sfintf.f: IF parcod(4:5) = FF or 
C*                                       parcod(1:5) = HGIFZ or 
C*                                       parcod(1:5) = HGIFE then                       
C* F (fcst types)       Parameter Code  Interface Mnemonic (cimn)
C* FF = includes QPF    WVIFF   -->     WVLVF - Height river stage 
C*                      Note: WVIFF not present in SHEF ingest files. 
C*                            May not exist. No "dattyp = F" processing. 
C
C*                      Observation Parameter Codes (dattyp ne F) 
C* R (obs types)        Parameter Code  Interface Mnemonic (cimn) 
C* RG = GOES            WVIRG   -->     WVLV - Speed of current
C
                        IF ( cimn (4:4) .eq. 'V' ) THEN
                          CALL SF_BFSQ ( r8ary, 3, ibfo, 'SPOC',
     +                                   ierfsq )
                        END IF
C
                      ELSE IF  ( cimn(1:3) .eq. 'DCH' )  THEN
C
C*			Discharge.
C
			IF ( dattyp .eq. 'F' ) THEN
			  IF ( ndc ( iflv ) .lt. MAXHD ) THEN
			    ndc(iflv) = ndc(iflv) + 1
			    r8dc ( iflv, 1, ndc(iflv) ) =
     +			      SF_FCTS ( cimn(5:5) )
			    r8dc ( iflv, 2, ndc(iflv) ) =
     +			      SF_DCHS ( cimn(4:4) )
			    IF ( .not. ERMISS ( rvalu ) )
     +			      r8dc ( iflv, 3, ndc(iflv) ) =
     +				rvalu * 28.3168
			    r8dc ( iflv, 4, ndc(iflv) ) = r8ary (3)
			    r8dc ( iflv, 5, ndc(iflv) ) = r8ary (4)
			  END IF
			END IF
C
		      ELSE IF  ( ( cimn(1:2) .eq. 'SN' ) .and.
     +				 ( cimn(4:4) .eq. 'W' ) )  THEN
C
C*			Snow depth (fresh or total).
C
			r8ary (2) =
     +			    UT_RIBM ( PR_HGMK ( PR_INMM ( rvalu ) ) )
			IF  ( cimn(3:3) .eq. 'E' )  THEN
			  bfrstr = 'DOFS'
			ELSE
			  bfrstr = 'TOSD'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
                        IF ( afpcp ) THEN
                          afpv = UT_BMRI ( r8ary (2) )
                          CALL UT_RIBF ( ibfop, bfrstr, afpv, ierrbf )
                        END IF
C
		      ELSE IF  ( cimn .eq. 'WEQS    ' )  THEN
C
C*			Snow water equivalent.
C
			r8ary (2) = UT_RIBM ( PR_INMM ( rvalu ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'SWEM', ierfsq )
C
		      ELSE IF  ( cimn(ipt:ipt+3) .eq. 'TMPF' )  THEN
C
C*			Temperature.
C
			r8ary (2) = UT_RIBM ( PR_TMFK ( rvalu ) )
			IF  ( cimn(2:2) .eq. 'X' )  THEN
			  bfrstr = 'MXTM'
			ELSE IF  ( cimn(2:2) .eq. 'N' )  THEN
			  bfrstr = 'MITM'
			ELSE
			  bfrstr = 'TMDB'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
                        IF ( ( afpcp ) .and. ( ctd .eq. 'HR' ) .and.
     +                        ( bfrstr(1:1) .eq. 'M' ) ) THEN
                          afpv = UT_BMRI ( r8ary (2) )
                          CALL UT_RIBF ( ibfop, bfrstr, afpv, ierrbf )
                          afpv = FLOAT ( itd )
                          CALL UT_RIBF ( ibfop, '.DTH' // bfrstr, afpv,
     +                                   ierrbf )
                        END IF
C
		      ELSE IF  ( cimn .eq. 'TMWF    ' )  THEN
C
C*			Wet bulb temperature.
C
			r8ary (2) = UT_RIBM ( PR_TMFK ( rvalu ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'TMWB', ierfsq )
C
		      ELSE IF  ( cimn .eq. 'DWPF    ' )  THEN
C
C*			Dew point temperature.
C
			r8ary (2) = UT_RIBM ( PR_TMFK ( rvalu ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'TMDP', ierfsq )
C
		      ELSE IF  ( cimn .eq. 'WTMF    ' )  THEN
C
C*			Water temperature.
C
			r8ary (2) = UT_RIBM ( PR_TMFK ( rvalu ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'WATM', ierfsq )
C
		      ELSE IF  ( cimn .eq. 'WACN    ' )  THEN
C
C*			Water conductivity.
C
C*			Divide by 10**4 to convert microSiemens/cm
C*			to Siemens/m.
C
			r8ary (2) =
     +			  UT_RIBM ( PR_D100 ( PR_D100 ( rvalu ) ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'WACN', ierfsq )
C
		      ELSE IF  ( ( cimn(ipt:ipt+3) .eq. 'CSTD' ) .or.
     +				 ( cimn(ipt:ipt+3) .eq. 'STMF' ) )  THEN
C
C*			Soil temperature (with or without depth).
C
			IF  ( cimn (ipt:ipt) .eq. 'C' )  THEN
			  icstdn = NINT ( rvalu * 1000. )
			  dblsi = FLOAT ( icstdn / 1000 )
			  stmf = ( FLOAT ( MOD ( icstdn, 1000 ) ) )
			ELSE
			  dblsi = RMISSD
			  stmf = rvalu
			END IF
C
			r8ary (1) =
     +			    UT_RIBM ( PR_HGMK ( PR_INMM ( dblsi ) ) )
			r8ary (2) = UT_RIBM ( PR_TMFK ( stmf ) )
C
			IF  ( cimn(2:2) .eq. 'X' )  THEN
			  nmxst = nmxst + 1
			  IF  ( nmxst .eq. 1 )  THEN
			    bfrstr = 'XST1'
			  ELSE
			    bfrstr = 'XST2'
			  END IF
			ELSE IF  ( cimn(2:2) .eq. 'N' )  THEN
			  nmist = nmist + 1
			  IF  ( nmist .eq. 1 )  THEN
			    bfrstr = 'IST1'
			  ELSE
			    bfrstr = 'IST2'
			  END IF
			ELSE
			  nst = nst + 1
			  IF  ( nst .eq. 1 )  THEN
			    bfrstr = 'STM1'
			  ELSE
			    bfrstr = 'STM2'
			  END IF
			END IF
C
			CALL SF_BFSQ ( r8ary, 4, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( cimn(ipt:ipt+3) .eq. 'RELH' )  THEN
C
C*			Relative humidity.
C
			r8ary (2) = UT_RIBM ( rvalu )
			IF  ( cimn(2:2) .eq. 'X' )  THEN
			  bfrstr = 'MXRH'
			ELSE IF  ( cimn(2:2) .eq. 'N' )  THEN
			  bfrstr = 'MIRH'
			ELSE
			  bfrstr = 'REHU'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( ( cimn .eq. 'DRCT    ' ) .or.
     +				 ( cimn .eq. 'PWDR    ' ) )  THEN
C
C*			Wind direction (normal or peak).
C
			r8ary (2) = UT_RIBM ( rvalu )
			IF  ( cimn(1:1) .eq. 'D' )  THEN
			  bfrstr = 'WDIR'
			ELSE
			  bfrstr = 'PKWD'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( cimn(2:4) .eq. 'MPH' )  THEN
C
C*			Wind speed (normal, peak or gusts).
C
			r8ary (2) =
     +			    UT_RIBM ( PR_KNMS ( PR_MHKN ( rvalu ) ) )
			IF  ( cimn(1:1) .eq. 'S' )  THEN
			  bfrstr = 'WSPD'
			ELSE IF  ( cimn(1:1) .eq. 'P' )  THEN
			  bfrstr = 'PKWS'
			ELSE
			  bfrstr = 'MXGS'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( cimn .eq. 'CWDS    ' )  THEN
C
C*			Combined wind direction and speed.
C
			icwdsn = NINT ( rvalu * 10000. )
C
			r8ary (2) =
     +			    UT_RIBM ( FLOAT ( MOD ( icwdsn, 1000 ) ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'WDIR', ierfsq )
C
			smph = FLOAT ( icwdsn / 1000 ) / 10.
			r8ary (2) =
     +			    UT_RIBM ( PR_KNMS ( PR_MHKN ( smph ) ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'WSPD', ierfsq )
C
		      ELSE IF  ( ( cimn(1:1) .eq. 'P' ) .and.
     +			       ( cimn(3:4) .eq. 'SI' ) )  THEN
C
C*			Pressure (normal or reduced to MSL).
C
			IF  ( rvalu .lt. 900. )  THEN
C
C*			  The value is in inches, so convert to mb.
C
			  prmb = PR_ALTM ( rvalu )
			ELSE
			  prmb = rvalu
			END IF
C
			r8ary (2) = UT_RIBM ( PR_M100 ( prmb ) )
			IF  ( cimn(2:2) .eq. 'R' )  THEN
			  bfrstr = 'PRES'
			ELSE
			  bfrstr = 'PMSL'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( INDEX ( cimn, 'WWM' ) .ne. 0 )  THEN
C
C*			Past or present weather.
C
			r8ary (2) = UT_RIBM ( rvalu )
			IF  ( cimn(1:1) .eq. 'P' )  THEN
			  bfrstr = 'PSW1'
			ELSE
			  bfrstr = 'PRWE'
			END IF
			CALL SF_BFSQ ( r8ary, 3, ibfo, bfrstr, ierfsq )
C
		      ELSE IF  ( cimn .eq. 'VSBY    ' )  THEN
C
C*			Horizontal visibility.
C
			r8ary (2) =
     +			    UT_RIBM ( PR_HGFM ( PR_HGSF ( rvalu ) ) )
			CALL SF_BFSQ ( r8ary, 3, ibfo, 'HOVI', ierfsq )
C
		      ELSE IF  ( ( cimn .eq. 'SOGR    ' ) .or.
C
C*				State of the ground.
C
     +				 ( cimn .eq. 'CLAM    ' ) .or.
C
C*				Cloud amount.
C
     +				 ( cimn .eq. 'ALBD    ' ) .or.
C
C*				Albedo.
C
     +				 ( cimn .eq. 'TOSH    ' ) )  THEN
C
C*				Total sunshine.
C
			r8ary (2) = UT_RIBM ( rvalu )
			CALL SF_BFSQ ( r8ary, 3, ibfo, cimn(1:4),
     +				       ierfsq )
                        IF ( ( afpcp ) .and. ( cimn .eq. 'SOGR    ' ) )
     +                      CALL UT_RIBF ( ibfop, 'SOGR', rvalu, ierrbf)
C
		      ELSE
C
			logmsg = '  unable to create BUFR output for '
     +				// cimn
			CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg)
C
		      END IF
C
		    END IF
C
		END IF
C
		irptr = irptr + inc
C
	    END DO
C
	    IF ( dattyp .eq. 'F' ) THEN
C
C*		Store the forecast data array.
C
		IF ( nflv .gt. 0 ) THEN
		    CALL DRFINI ( ibfo, nflv, 1, '{SHRVFFSQ}' )
		    CALL UFBREP ( ibfo, r8ft, MXBFPM, nflv, ierbrp,
     +			'TSIG YEAR MNTH DAYS HOUR MINU' )
C
C*		    Height data.
C
		    CALL DRFINI ( ibfo, nht, nflv, '{SHRVHTSQ}' )
		    idx = 0
		    DO j = 1, nflv
		      IF ( nht(j) .gt. 0 ) THEN
			DO i = 1, nht(j)
			  idx = idx + 1
			  DO k = 1, 5
			    r8htn ( k, idx ) = r8ht ( j, k, i ) 
			  END DO
			END DO
		      END IF
		    END DO
		    IF ( idx .gt. 0 ) THEN
		      CALL UFBSEQ ( ibfo, r8htn, 5, idx, ierbrp,
     +			'SHRVHTSQ' )
		    END IF
C
C*		    Discharge data.
C
		    CALL DRFINI ( ibfo, ndc, nflv, '{SHRVDCSQ}' )
		    idx = 0
		    DO j = 1, nflv
		      IF ( ndc(j) .gt. 0 ) THEN
			DO i = 1, ndc(j)
			  idx = idx + 1
			  DO k = 1, 5
			    r8dcn ( k, idx ) = r8dc ( j, k, i ) 
			  END DO
			END DO
		      END IF
		    END DO
		    IF ( idx .gt. 0 ) THEN
		      CALL UFBSEQ ( ibfo, r8dcn, 5, idx, ierbrp,
     +			'SHRVDCSQ' )
		    END IF
C
		END IF
	    END IF
C
C*	    Store the BUFR report for this time duration.
C
	    CALL UT_WBFR ( ibfo, 'shef', 0, ierwbf )
C
C*	    Update the ctds and itds arrays, then go back and determine
C*	    the next time duration for which to encode a BUFR report.
C
	    ntd = ntd + 1
	    IF  ( ntd .gt. MAXTD )  THEN
		logmsg = '  MAXTD overflow when generating BUFR output.'
		CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg)
		RETURN
	    END IF
	    ctds ( ntd ) = ctd
	    itds ( ntd ) = itd
	END DO
C*
	RETURN
	END