SUBROUTINE NX_BUFR ( iunbfo, irundt, iptbdt, + seqnum, buhd, cborg, bulldt, bbb, + rawslc, lenslc, rawptb, lenptb, iret ) C************************************************************************ C* NX_BUFR * C* * C* This subroutine retrieves interface-stored data, converts it into * C* BUFR output, and then writes the BUFR output to the BUFR output * C* stream. * C* * C* NX_BUFR ( IUNBFO, IRUNDT, IPTBDT, * C* SEQNUM, BUHD, CBORG, BULLDT, BBB, * C* RAWSLC, LENSLC, RAWPTB, LENPTB, 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* IPTBDT (5) INTEGER Part B date-time * C* (YYYY, MM, DD, HH, MM ) * C* SEQNUM CHAR* Bulletin sequence number * C* BUHD CHAR* Bulletin header * C* CBORG CHAR* Bulletin originator * C* BULLDT CHAR* Bulletin date-time * C* BBB CHAR* Bulletin BBB indicator * C* RAWSLC CHAR* Raw station location info. as * C* originally encoded in bulletin * C* LENSLC INTEGER Length of RAWSLC * C* RAWPTB CHAR* Raw part B data as originally * C* encoded in bulletin * C* LENPTB INTEGER Length of RAWPTB * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C** * C* Log: * C* D. Kidwell/NCEP 10/96 * C* J. Ator/NCEP 04/98 New interface format, style changes * C* R. Hollern/NCEP 01/99 Moved init of mbstr, lmbstr into code * C* J. Ator/NCEP 02/99 Convert RMSW from knots to m/s for BUFR * C* J. Ator/NCEP 06/01 Use UT_WBFR and BUFR.CMN, clean up * C* J. Ator/NCEP 01/02 Use simplified UT_CIBF * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'BUFR.CMN' INCLUDE 'nxcmn.cmn' INCLUDE 'nxcmn_bufr.cmn' C* INTEGER irundt (*), iptbdt (*) C* CHARACTER*(*) rawslc, rawptb, + seqnum, buhd, cborg, bulldt, bbb C* CHARACTER cdata*(DCMXBF) C* REAL*8 r8wlv ( NCWLV, MXBFLV ), UT_RIBM C------------------------------------------------------------------------ iret = 0 C C* Set the BUFR message date-time. C ibfdt = ( iptbdt (1) * 1000000 ) + ( iptbdt (2) * 10000 ) + + ( iptbdt (3) * 100 ) + iptbdt (4) C C* Open a BUFR message for output. C CALL OPENMB ( iunbfo, 'NC002008', ibfdt ) C C* Bulletin ID information. C CALL UT_CIBF ( iunbfo, 'SEQNUM', seqnum, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BUHD', buhd, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BORG', cborg, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BULTIM', bulldt, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BBB', bbb, 8, iercbf ) C C* Raw report. C cdata = rawslc (1:lenslc) // ' ' // rawptb (1:lenptb) lcdata = lenslc + lenptb + 1 IF ( lcdata .gt. MXBFRR ) THEN WRITE ( UNIT = logmsg, FMT = '( A, I4, A )' ) + 'Only stored first ', MXBFRR, ' bytes of raw report' CALL DC_WLOG ( 4, 'NX', 1, logmsg, ierwlg ) END IF CALL UT_CIBF ( iunbfo, 'RRSTG', cdata, lcdata, iercbf ) C C* Part B date-time. C CALL UT_RIBF ( iunbfo, 'YEAR', FLOAT ( iptbdt (1) ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MNTH', FLOAT ( iptbdt (2) ), ierrbf ) CALL UT_RIBF ( iunbfo, 'DAYS', FLOAT ( iptbdt (3) ), ierrbf ) CALL UT_RIBF ( iunbfo, 'HOUR', FLOAT ( iptbdt (4) ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MINU', FLOAT ( iptbdt (5) ), 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* Elevation. C CALL UT_RIBF ( iunbfo, 'SELV', rivals ( irselv ), ierrbf ) C C* Report ID. C CALL UT_CIBF ( iunbfo, 'RPID', civals ( icrpid ), 8, iercbf ) C C* Corrected report indicator. C corn = 0.0 IF ( bbb (1:1) .eq. 'C' ) THEN corn = 1.0 END IF CALL UT_RIBF ( iunbfo, 'CORN', corn, 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* Wind levels. C npbw = INT ( rivals ( irnpbw ) ) IF ( npbw .gt. 0 ) THEN DO jj = 1, npbw C C* Height. C r8wlv ( LWHEIT, jj ) = + UT_RIBM ( rivals ( irhgtm ( jj ) ) ) C C* Wind direction. C r8wlv ( LWWDIR, jj ) = + UT_RIBM ( rivals ( irdrct ( jj ) ) ) C C* Wind speed. C r8wlv ( LWWSPD, jj ) = + UT_RIBM ( PR_KNMS ( rivals ( irsknt ( jj ) ) ) ) C C* Root mean square error. C r8wlv ( LWRMSW, jj ) = + UT_RIBM ( PR_KNMS ( rivals ( irrmse ( jj ) ) ) ) END DO CALL UFBINT ( iunbfo, r8wlv, NCWLV, npbw, ierufb, CWLVST ) END IF C CALL UT_WBFR ( iunbfo, 'nxrdwind', 0, ierwbf ) C* RETURN END