SUBROUTINE UG_BUFR ( iunbfo, irundt, rptcpy, lrcpy, iret ) C************************************************************************ C* UG_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* UG_BUFR ( IUNBFO, IRUNDT, RPTCPY, LRCPY, IRET ) * C* * C* Input parameters: * C* IUNBFO INTEGER BUFR output file unit number * C* IRUNDT (5) INTEGER Run date-time * C* (YYYY, MM, DD, HH, MM) * C* RPTCPY CHAR* Report * C* LRCPY CHAR* Length of report * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C** * C* Log: * C* C. Caruso Magee/NCEP 05/05 Based on dcalps * C* J. Ator/NCEP 05/09 Add WACN to BUFR output * C* J. Ator/NCEP 06/11 Allow station IDs up to 16 characters * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'ugcmn.cmn' INCLUDE 'ugcmn_bufr.cmn' C* INTEGER irundt (5) C* CHARACTER*(*) rptcpy C* CHARACTER bfstyp*8, rrstg*120 C* REAL dchgm C* REAL*8 r8wnd ( NCWND, MXWND ), + r8rsh ( NCRSH, MXRSH ), + r8dch ( NCDCH, MXDCH ), + r8pcp ( NCPCP, MXPCP ), + UT_RIBM C* INCLUDE 'ERMISS.FNC' C*----------------------------------------------------------------------- iret = 0 C C* Set the BUFR message subtype. C bfstyp = 'NC001009' C C* Set the BUFR message date-time. C year = rivals ( iryear ) rmth = rivals ( irmnth ) days = rivals ( irdays ) hour = rivals ( irhour ) 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 ) C C* Open a BUFR message for output. C CALL OPENMB ( iunbfo, bfstyp, ibfdt ) C C* Report date-time. C CALL UT_RIBF ( iunbfo, 'YEAR', rivals ( iryear ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MNTH', rivals ( irmnth ), ierrbf ) CALL UT_RIBF ( iunbfo, 'DAYS', rivals ( irdays ), ierrbf ) CALL UT_RIBF ( iunbfo, 'HOUR', rivals ( irhour ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MINU', rivals ( irminu ), 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, 'CLAT', rivals ( irslat ), ierrbf ) C C* Longitude. C CALL UT_RIBF ( iunbfo, 'CLON', rivals ( irslon ), ierrbf ) C C* Station elevation. C CALL UT_RIBF ( iunbfo, 'SELV', rivals ( irselv ), ierrbf ) C C* Air temperature (0 12 101). Only store one of tmpc or tmpf C* (some stations report both, some one or the other). C IF ( .not. ERMISS ( rivals ( irtmpc ) ) ) THEN CALL UT_RIBF ( iunbfo, 'TMDB', + PR_TMCK ( rivals ( irtmpc ) ), ierrbf ) ELSEIF ( .not. ERMISS ( rivals ( irtmpf ) ) ) THEN CALL UT_RIBF ( iunbfo, 'TMDB', + PR_TMFK ( rivals ( irtmpf ) ), ierrbf ) END IF C C* Water temperature (0 22 043). C CALL UT_RIBF ( iunbfo, 'SST1', PR_TMCK ( rivals ( irwtmp ) ), + ierrbf ) C C* Water conductivity (0 13 081). Divide by 10**4 to convert C* microSiemens/cm to Siemens/m. C CALL UT_RIBF ( iunbfo, 'WACN', + PR_D100 ( PR_D100 ( rivals ( irwacn ) ) ), + ierrbf ) C C* Wind dir (0 11 001), wind speed (0 11 002), wind dir sensor type C* (0 02 202) and wind speed sensor type (0 02 203). C* Convert speed from miles/hr to knots to meters/sec. C nrep = NINT ( rivals ( irnwnd ) ) IF ( nrep .gt. 0 .and. nrep .lt. 3 ) THEN DO i = 1, nrep r8wnd ( LCWDIR, i ) = + UT_RIBM ( rivals ( irwdir ( i ) ) ) r8wnd ( LCWSPD, i ) = + UT_RIBM (PR_KNMS(PR_MHKN(rivals( irwspd ( i ) )))) r8wnd ( LCDDWD, i ) = + UT_RIBM ( rivals ( irddwd ( i ) ) ) r8wnd ( LCDDWS, i ) = + UT_RIBM ( rivals ( irddws ( i ) ) ) END DO CALL UFBINT ( iunbfo, r8wnd, NCWND, nrep, ierufb, + CWNDST ) END IF C C* Wind gust speed (0 11 041). C* Convert from miles/hr to knots to meters/sec. C CALL UT_RIBF ( iunbfo, 'MXGS', + PR_KNMS ( PR_MHKN ( rivals ( irgust ) ) ), ierrbf ) C C* Total precipitation (0 13 011) and precip sensor type (0 02 206). C* Convert from inches to millimeters. C nrep = NINT ( rivals ( irnpcp ) ) IF ( nrep .gt. 0 .and. nrep .lt. 3 ) THEN DO i = 1, nrep r8pcp ( LDTOPC, i ) = + UT_RIBM ( PR_INMM ( rivals ( irprec ( i ) ) ) ) r8pcp ( LDDDPC, i ) = + UT_RIBM ( rivals ( irddpc ( i ) ) ) END DO CALL UFBINT ( iunbfo, r8pcp, NCPCP, nrep, ierufb, + CPCPST ) END IF C C* Salinity (0 22 062). C CALL UT_RIBF ( iunbfo, 'SALN', rivals ( irsaln ), ierrbf ) C C* River stage height (gage height) (0 07 198) and river stage height C* sensor type (0 02 204). Convert from feet to meters. C nrep = NINT ( rivals ( irnrsh ) ) IF ( nrep .gt. 0 .and. nrep .lt. 3 ) THEN DO i = 1, nrep r8rsh ( LDRSHM, i ) = + UT_RIBM ( PR_HGFM ( rivals ( irrshm ( i ) ) ) ) r8rsh ( LDDDRS, i ) = + UT_RIBM ( rivals ( irddrs ( i ) ) ) END DO CALL UFBINT ( iunbfo, r8rsh, NCRSH, nrep, ierufb, + CRSHST ) END IF C C* River stage height above NGVD 1929 (0 07 199). C* Convert from feet to meters. C CALL UT_RIBF ( iunbfo, 'RSH29', + PR_HGFM ( rivals ( irrsh9 ) ) , ierrbf ) C C* Stream velocity (0 13 214). C* Convert from feet/sec to meters/sec. C CALL UT_RIBF ( iunbfo, 'STRV', + PR_HGFM ( rivals ( irstrv ) ) , ierrbf ) C C* Discharge (0 13 215) and discharge sensor type (0 02 205). C* Convert from cubic feet/sec to cubic meters/sec. C nrep = NINT ( rivals ( irndch ) ) IF ( nrep .gt. 0 .and. nrep .lt. 3 ) THEN DO i = 1, nrep dchgm = rivals ( irdchg ( i ) ) * ( (.3048)**3 ) r8dch ( LDDCHG, i ) = UT_RIBM ( dchgm ) r8dch ( LDDDDC, i ) = + UT_RIBM ( rivals ( irdddc ( i ) ) ) END DO CALL UFBINT ( iunbfo, r8dch, NCDCH, nrep, ierufb, + CDCHST ) END IF C C* Raw report. C CALL UT_CIBF ( iunbfo, 'RRSTG', rptcpy, lrcpy, iercbf ) C C* Write the output to the BUFR interface. C CALL UT_WBFR ( iunbfo, 'usgs', 0, ierdbf ) C C* Site ID (0 01 198). C CALL WRITLC ( iunbfo, civals ( icstid ), 'RPID' ) C* RETURN END