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