SUBROUTINE WC_BUFR ( iunbfo, ifile, irundt, irepdt, report,
     +                       wlevel, wdchg, lenr, iret )
C************************************************************************
C* WC_BUFR								*
C*									*
C* This subroutine converts Canadian water level and river gauge	*
C* observations into BUFR output, and then writes the BUFR output       *
C* to the BUFR output stream.				                *
C*									*
C* WC_BUFR  ( IUNBFO, IFILE, IRUNDT, IREPDT, REPORT, WLEVEL, WDCHG,     *
C*            LENR, IRET )                                              *
C*									*
C* Input parameters:							*
C*	IUNBFO		INTEGER		BUFR output file unit number	*
C*      IFILE           INTEGER         File number counter             *
C*	IRUNDT (5)	INTEGER		Run date-time			*
C*      IREPDT (5)      INTEGER         Report date-time                *
C*			           both (YYYY, MM, DD, HH, MM)		*
C*	REPORT          CHAR*           Report                          *
C*      WLEVEL          REAL            Water level                     *
C*      WDCHG           REAL            Water Discharge (.csv only)     *
C*	LENR            INTEGER         Length of report                *
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* M. Weiss/IMSG	10/20   Based on ug_bufr (dcusgs)               *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'wccmn.cmn'
C*
	INTEGER		irundt (5), irepdt (5)
C*
	CHARACTER*(*)	report
C*
	CHARACTER	subset*8, rrstg*120
C*
C*
	INCLUDE		'ERMISS.FNC'
C*-----------------------------------------------------------------------
	iret = 0
C
C*	Set the BUFR message subtype.
C
        IF ( statyp(ifile) .eq. "WL" ) subset = 'NC001021'
        IF ( statyp(ifile) .eq. "RG" ) subset = 'NC001022'
C
C*	Set the BUFR message "report" date-time.
C
	year = FLOAT (irepdt (1))
	rmth = FLOAT (irepdt (2))
	days = FLOAT (irepdt (3))
	hour = FLOAT (irepdt (4))
        smin = FLOAT (irepdt (5))
	IF  ( ( ERMISS ( year ) ) .or. ( ERMISS ( rmth ) ) .or.
     +	      ( ERMISS ( days ) ) .or. ( ERMISS ( hour ) )  )  THEN
	    RETURN
	END IF
	ibfdt = ( INT ( year ) * 1000000 ) + ( INT ( rmth ) * 10000 )  +
     +		( INT ( days ) * 100 ) + INT ( hour ) ! report date-time
C
C*	Open a BUFR message for output.
C
	CALL OPENMB ( iunbfo, subset, ibfdt )
C
C*	Report date-time.
C
	CALL UT_RIBF ( iunbfo, 'YEAR', year, ierrbf )
	CALL UT_RIBF ( iunbfo, 'MNTH', rmth, ierrbf )
	CALL UT_RIBF ( iunbfo, 'DAYS', days, ierrbf )
	CALL UT_RIBF ( iunbfo, 'HOUR', hour, ierrbf )
	CALL UT_RIBF ( iunbfo, 'MINU', smin, ierrbf )
C
C*	Receipt date-time.
C
	CALL UT_RIBF ( iunbfo, 'RCYR', FLOAT ( irundt (1) ), ierrbf )
	CALL UT_RIBF ( iunbfo, 'RCMO', FLOAT ( irundt (2) ), ierrbf )
	CALL UT_RIBF ( iunbfo, 'RCDY', FLOAT ( irundt (3) ), ierrbf )
	CALL UT_RIBF ( iunbfo, 'RCHR', FLOAT ( irundt (4) ), ierrbf )
	CALL UT_RIBF ( iunbfo, 'RCMI', FLOAT ( irundt (5) ), ierrbf )
	CALL UT_RIBF ( iunbfo, 'RCTS', FLOAT ( 0 ), ierrbf )
C
C*	Latitude.
C
        CALL UT_RIBF ( iunbfo, 'CLATH', slat ( ifile ), ierrbf )
C
C*	Longitude.
C
        CALL UT_RIBF ( iunbfo, 'CLONH', slon ( ifile ), ierrbf )
C
C*	Station elevation.
C
        CALL UT_RIBF ( iunbfo, 'SELV', selv ( ifile ), ierrbf )
C
C*	Chart Datum Elevation (0-07-200).
C
        CALL UT_RIBF ( iunbfo, 'CHDEL', chdatum ( ifile ) , ierrbf )
C
C*      Water level height using the descriptor
C*      TERC (0-22-038) TIDAL ELEV WITH RESPECT TO CHART
C
        CALL UT_RIBF ( iunbfo, 'TERC', wlevel , ierrbf )
C
C*      Water Discharge using the descriptor
C*      DCHG (0-13-214) DISCHARGE
C
        IF ( statyp(ifile) .eq. "RG" ) THEN
          CALL UT_RIBF ( iunbfo, 'DCHG', wdchg , ierrbf )
        END IF
Cccccccccccccccccccccccccccccccccccccccccccccccccc
C
C*         Site ID (0-01-198)
C
        CALL UT_CIBF  ( iunbfo, 'RPID', stnid (ifile), 8, iercbf )
C
C*         Raw report (0-58-008)
C
        CALL UT_CIBF  ( iunbfo, 'RRSTG', report, lenr, iercbf )
C
C*	   Write the output to the BUFR interface.
C
        CALL UT_WBFR  ( iunbfo, 'wcan', 0, ierdbf )
C
C
C*         Chart Datum Name or Description (0-07-201).
C
        CALL WRITLC ( iunbfo, datum (ifile), 'CHDNM' )
C
C*         Long Site Name (0-01-019)
C
        CALL WRITLC ( iunbfo, stnnam (ifile), 'LSTN' )
C
C
	RETURN
	END