SUBROUTINE WP_DCOD  ( cldt, bufrtn, nhours, iret )
C************************************************************************
C* WP_DCOD								*
C*									*
C* This routine decodes bulletins containing wind profiler BUFR	messages*
C* into NCEP BUFR format.		 				*
C*									*
C* WP_DCOD ( CLDT, BUFRTA, BUFRTN, NHOURS, IRET )			*
C*									*
C* Input parameters:							*
C*	CLDT		CHAR*		Date-time from command line	*
C*	BUFRTN		CHAR*		NCEP BUFR tables file		*
C*	NHOURS		INTEGER		Max # of hours before run time	*
C*					for creating NCEP BUFR output	*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C*									*
C**									*
C* Log:									*
C* J. Ator/NCEP		05/14						*
C* J. Ator/NCEP		10/14	Change NC002109 subtype to NC002018	*
C* J. Ator/NCEP		05/15	Process everything as NC002014,		*
C*				including new AMMC, NSAP and NZKL.	*
C* J. Ator/NCEP		01/16	Skip over miscoded BUFR messages	*
C* J. Ator/NCEP		02/16	Store radar VAD winds as NC002018	*
C* J. Ator/NCEP		03/16	Process Japan as NC002013, Europe as	*
C*				NC002016 and U.S. as NC002007		*
C* J. Ator/NCEP		10/19	Look for TPSE if TPMI is missing,	*
C*                              decode and store WIGOS IDs when present,*
C*                              decode and store QMRKs when present     *
C* M. Weiss/IMSG        06/21   MAXOUT (200000) ---> MAXOUT (199900)    *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
C*
	CHARACTER*(*)	cldt, bufrtn
C*
C*	Maximum number of descriptors within Section 3 of a
C*	wind profiler BUFR message.
C*
	PARAMETER	( MXDSC = 75 )
C*
C*	Maximum number of sounding levels within a
C*	wind profiler BUFR message.
C*
	PARAMETER	( MXLV = 500 )
C*
	PARAMETER	( MXMN = 15 )
C*
	CHARACTER	bull*(DCMXBF), cbull*(DCMXBF), bfstyp*8,
     +			seqnum*8, buhd*8, cborg*8, bulldt*8, bbb*8,
     +			rundt*12, sysdt*12, subtyp*8, logmsg*200,
     +			cdesc( MXDSC )*6, smid*9, rpid*8, ufbstg*80,
     +			cpvt*4, cpvtp*8, cpvtp1*10, cpvtp2*10, sstn*8,
     +                  wgoslid*16,
     +                  bufrdn*(DCMXLN), bufrbn*(DCMXLN)
C*
	INTEGER		irundt ( 5 ), irptdt ( 5 ), 
     +			ibull ( DCMXBF / 4 )
C*
	LOGICAL		bullok, msgok, gotw51,
     +			gotuwd, gotvwd, gotwdr, gotwsp, gotwigos
C*
	REAL*8		r8in ( MXMN, MXLV ), r8dttm ( MXMN, MXLV ),
     +			r8wk ( MXMN, MXLV ), r8lvls ( MXMN, MXLV ),
     +			r8val, r8selv, r8bfms, GETBMISS, UT_RIBM,
     +                  GETVALNB
C*
	EQUIVALENCE	( cbull (1:4), ibull (1) )
C*
	INCLUDE		'ERMISS.FNC'
C*-----------------------------------------------------------------------
	iret = 0
C
C*	Get the BUFR tables directory from the tables file.  This
C*	directory will be passed to subroutine MTINFO as the location
C*	in which to search for any needed master table files.
C
	CALL FL_PATH ( bufrtn, bufrdn, bufrbn, ierpth )
C
C*	Open the tables file for the NCEP BUFR (i.e. output) stream.
C
	CALL FL_SOPN ( bufrtn, iubftn, ierspn )
	IF ( ierspn .ne. 0 ) THEN
	  CALL DC_WLOG ( 0, 'FL', ierspn, bufrtn, ierwlg )
	  RETURN
	END IF
C
C*	Open the BUFR messages file.
C
	CALL FL_GLUN ( iubfma, iergln )
	IF ( iergln .ne. 0 ) THEN
	  CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg )
	  RETURN
	END IF
	OPEN ( UNIT = iubfma, FILE = '.dummy/dcwpfl',
     +		FORM = 'UNFORMATTED' )
	CALL OPENBF ( iubfma, 'SEC3', iubftn )
	CALL MTINFO ( bufrdn, 98, 99 )
C
C*	Open the messages file for the NCEP BUFR (i.e. output) stream.
C
	CALL FL_GLUN ( iubfmn, iergln )
	IF ( iergln .ne. 0 ) THEN
	  CALL DC_WLOG ( 0, 'FL', iergln, ' ', ierwlg )
	  RETURN
	END IF
C
C*	Connect the tables and messages files for the
C*	NCEP BUFR (i.e. output) stream.
C
	CALL OPENBF ( iubfmn, 'NUL', iubftn )
	r8bfms = GETBMISS()
C
C*      Specify that NCEP BUFR (i.e. output) messages are to be
C*	encoded using edition 4 and up to 200K bytes in size.
C
	CALL PKVS01 ( 'BEN', 4 )
	CALL MAXOUT ( 199900 )
C
C*	Close the tables file for the NCEP BUFR (i.e. output) stream.
C
	CALL FL_CLOS ( iubftn, iercls )
	IF ( iercls .ne. 0 ) THEN
	  CALL DC_WLOG ( 0, 'FL', iercls, ' ', ierwlg )
	END IF
C
	DO WHILE ( .true. )
C
C*	  Get a new bulletin from the input pipe.
C
	  CALL DC_GBUL ( bull, lenb, ifdtyp, iergbl )
	  IF ( iergbl .ne. 0 ) THEN
C
C*	    A time-out occurred while waiting for a new bulletin
C*	    on the input pipe.  Shut down the decoder and exit.
C
	    CALL DC_WLOG ( 0, 'DC', iergbl, ' ', ierwlg )
	    CALL CLOSBF ( iubfma )
	    CALL CLOSBF ( iubfmn )
	    CALL FL_CLAL ( iercal )
	    RETURN
	  END IF
C
	  bullok = .true.
C
C*	  Decode the header information from this bulletin.
C
	  IF ( ifdtyp .eq. 0 ) THEN
C
C*	    Decode WMO products.
C
	    CALL DC_GHDR ( bull, lenb, seqnum, buhd, cborg,
     +			   bulldt, bbb, ibptr, ierghd )
	    IF ( ierghd .ne. 0 ) THEN
	      CALL DC_WLOG ( 2, 'DC', ierghd, ' ', ierwlg )
	      bullok = .false.
	    ELSE
C
C*	      Start an entry for this bulletin in the decoder log.
C
	      logmsg = '########################################'
	      CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
	      logmsg = seqnum // buhd // cborg // bulldt // bbb
	      CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
	    END IF
	  ELSE
C
C*	    Do not decode AFOS products.
C
	    bullok = .false.
	  END IF
C
	  IF ( bullok ) THEN
C
C*	    Get the system time.
C
	    itype = 1
	    CALL CSS_GTIM ( itype, sysdt, iergtm )
	    IF ( iergtm .ne. 0 ) THEN
	      CALL DC_WLOG ( 2, 'SS', iergtm, ' ', ierwlg )
	      bullok = .false.
	    END IF
	  END IF
C
	  IF ( bullok ) THEN
C
C*	    If a date-time was entered on the command line, then use it
C*	    as the run date-time.  Otherwise, use the system time as
C*	    the run date-time.
C
	    IF ( cldt .eq. 'SYSTEM' ) THEN
	      rundt = sysdt
	    ELSE
	      CALL TI_STAN ( cldt, sysdt, rundt, ierstn )
	      IF ( ierstn .ne. 0 ) THEN
		CALL DC_WLOG ( 2, 'TI', ierstn, ' ', ierwlg )
		bullok = .false.
	      END IF
	    END IF
	  END IF
C
	  IF ( bullok ) THEN
C
C*	    Convert the run date-time to integer.
C
	    CALL TI_CTOI ( rundt, irundt, iercto )
	    IF ( iercto .ne. 0 ) THEN
	      CALL DC_WLOG  ( 2, 'TI', iercto, ' ', ierwlg )
	      bullok = .false.
	    ELSE
	      nmsg = 0
	    END IF
	  END IF
C
	  DO WHILE ( bullok )
C
C*	    Locate the next BUFR message within the bulletin, and
C*	    store it within an equivalenced integer array.
C
	    ipt1 = INDEX ( bull (ibptr:lenb), 'BUFR' )
	    IF ( ipt1 .eq. 0 ) THEN
	      bullok = .false.
	      IF ( nmsg .eq. 0 ) THEN
		IF ( INDEX ( bull (ibptr:lenb), 'NIL' ) .ne. 0 ) THEN
		  logmsg = 'NIL bulletin'
		  CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
		END IF
	      ELSE
C
C*		Make sure that all BUFR output for this bulletin has
C*		been written to the BUFR output stream before going back
C*		to DC_GBUL and waiting for a new bulletin on the pipe.
C
		CALL UT_WBFR ( iubfmn, 'wpfl', 1, ierwbf )
	      END IF
	    ELSE
	      istart = ibptr + ipt1 - 1
	      ibptr = istart + 4
	      cbull = bull ( istart : lenb )
C
	      nmsg = nmsg + 1
	      msgok = .true.
	      gotw51 = .false.
	      gotuwd = .false.
	      gotvwd = .false.
	      gotwdr = .false.
	      gotwsp = .false.
C
C*	      Retrieve the Section 3 descriptors from the message.
C
	      CALL UPDS3 ( ibull, MXDSC, cdesc, ndesc )
C
	      IF ( msgok ) THEN
		msglen = IUPBS01 ( ibull, 'LENM' )
C
C*		Check for a corrupt or miscoded BUFR message; for
C*		example, one that has many descriptors but is extremely
C*		short in length.  Such messages often have incomplete
C*		delayed replication sequences in Section 3, which could
C*		in turn cause a BUFRLIB abort later on within READERME.
C
		IF ( ( msglen .gt. lenb ) .or.
     +		    ( cbull ( msglen-3 : msglen ) .ne. '7777' ) ) THEN
		  msgok = .false.
		  logmsg = 'ERROR: corrupt BUFR message'
		  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		ELSE IF ( ( ndesc .ge. 7 ) .and.
     +			 ( msglen .le. 80 ) ) THEN
		  msgok = .false.
		  logmsg = 'ERROR: miscoded BUFR message'
		  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		END IF
	      END IF
C
	      IF ( msgok ) THEN
C
C*		Check for the presence of one or more particular
C*		descriptors in the message.
C
		ii = 1
		DO WHILE ( ( ii .le. ndesc ) .and. ( .not. gotw51 ) )
		  IF ( cdesc(ii) .eq. '309051' ) THEN
		    gotw51 = .true.
		  ELSE
		    IF ( cdesc(ii) .eq. '011003' ) THEN
		      gotuwd = .true.
		    ELSE IF ( cdesc(ii) .eq. '011004' ) THEN
		      gotvwd = .true.
		    ELSE IF ( cdesc(ii) .eq. '011001' ) THEN
		      gotwdr = .true.
		    ELSE IF ( cdesc(ii) .eq. '011002' ) THEN
		      gotwsp = .true.
		    ELSE IF ( cdesc(ii) .eq. '321022' ) THEN
		      gotwdr = .true.
		      gotwsp = .true.
		    END IF
		    ii = ii + 1
		  END IF
		END DO
		IF ( ( .not. gotw51 ) .and.
     +		     ( .not. ( gotuwd .and. gotvwd ) ) .and.
     +		     ( .not. ( gotwdr .and. gotwsp ) ) ) THEN
		  msgok = .false.
		  logmsg = 'no wind data found in message'
		  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		END IF
	      END IF
C
	      IF ( msgok ) THEN
C
C*		Open the BUFR message for reading.
C
		CALL READERME ( ibull, iubfma, bfstyp, ibfdt, ierrme )
		IF ( ierrme .ne. 0 ) THEN
		  msgok = .false.
		END IF
	      END IF
C
	      DO WHILE ( msgok )
C
C*		Get the next report from this BUFR message.
C
		IF ( IREADSB ( iubfma ) .ne. 0 ) THEN
C
C*		  There are no more reports in this message.
C
		  msgok = .false.
		ELSE
C
C*		  Determine the NCEP BUFR output subtype.
C
                  mtyp = IUPBS01 ( ibull, 'MTYP' )
		  CALL UT_BFRI ( iubfma, 'A4ME', a4me, ier )
		  ia4me = INT ( a4me )
                  IF ( mtyp .eq. 6 ) THEN
		    subtyp = 'NC002018'
		  ELSE IF ( ( ia4me .eq. 6 ) .or.
     +                      ( ia4me .eq. 0 ) ) THEN
		    IF ( cborg(1:4) .eq. 'KBOU' ) THEN
		      subtyp = 'NC002007'
		    ELSE IF ( cborg(1:4) .eq. 'RJTD' ) THEN
		      subtyp = 'NC002013'
		    ELSE IF ( ( cborg(1:1) .eq. 'E' ) .or.
     +			      ( cborg(1:1) .eq. 'L' ) .or.
     +			      ( cborg(1:4) .eq. 'HABP' ) .or.
     +			      ( cborg(1:4) .eq. 'SOWR' ) ) THEN
		      subtyp = 'NC002016'
		    ELSE
		      subtyp = 'NC002014'
		    END IF
		  ELSE IF ( ia4me .eq. 3 ) THEN
		    subtyp = 'NC002018'
		  ELSE
		    subtyp = '????????'
		    IF ( ERMISS ( a4me ) ) THEN
		      logmsg = 'skipped report with missing A4ME'
		    ELSE
		      WRITE ( UNIT = logmsg, FMT = '( A, I2 )' )
     +		      'skipped report with A4ME = ', ia4me
		    END IF
		    CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
		  END IF
C
		  IF ( subtyp(1:1) .ne. '?' ) THEN
C
C*		    Get the report date-time(s) and wind levels.
C*		    If there's more than one date-time, then the wind
C*		    levels may apply to different time periods.
C
		    IF ( gotw51 ) THEN
		      CALL UFBSEQ ( iubfma, r8dttm, MXMN, MXLV, ndttm,
     +		  		    'DATETMLN' )
		      CALL UFBSEQ ( iubfma, r8lvls, MXMN, MXLV, nlvls,
     +				    'WDHLRAOB' )
		    ELSE
		      cpvt = 'HEIT'
		      CALL GETTAGPR ( iubfma, cpvt, 1, cpvtp, iertpr )
		      IF ( iertpr .ne. 0 ) THEN
			cpvt = 'HAST'
		        CALL GETTAGPR ( iubfma, cpvt, 1, cpvtp, iertpr )
		      END IF
		      CALL ST_LSTR ( cpvtp, lcpvtp, ier )
		      cpvtp1 = '{' // cpvtp(1:lcpvtp) // '}'
		      cpvtp2 = '(' // cpvtp(1:lcpvtp) // ')'
		      CALL UFBINT ( iubfma, r8dttm, MXMN, MXLV, ndttm,
     +		      		    'NUL YEAR MNTH DAYS HOUR MINU SECO '
     +				    // cpvtp1(1:lcpvtp+2) // ' '
     +				    // cpvtp2(1:lcpvtp+2) )
		      IF ( ( gotuwd ) .and. ( gotvwd ) ) THEN
			ufbstg = ' UWND VWND '
		      ELSE
			ufbstg = ' WDIR WSPD '
		      END IF
		      CALL UFBREP ( iubfma, r8lvls, MXMN, MXLV, nlvls,
     +				    cpvt // ufbstg(1:11) //
     +				    'WCMP STNR SDHS SDVS NPQC')
		      lptr = 0
		    END IF
C
		    DO kk = 1, ndttm
C
C*		    Don't create BUFR output for reports that are more
C*		    than NHOURS before or more than 3 hours after the
C*		    run time.
C
		    rptyr = UT_BMRI ( r8dttm ( 2, kk ) )
		    rptmo = UT_BMRI ( r8dttm ( 3, kk ) )
		    rptdy = UT_BMRI ( r8dttm ( 4, kk ) )
		    rpthr = UT_BMRI ( r8dttm ( 5, kk ) )
		    rptmi = UT_BMRI ( r8dttm ( 6, kk ) )
		    IF ( ( ERMISS ( rptyr ) ) .or.
     +		         ( ERMISS ( rptmo ) ) .or.
     +		         ( ERMISS ( rptdy ) ) .or.
     +		         ( ERMISS ( rpthr ) ) .or.
     +		         ( ERMISS ( rptmi ) ) ) THEN
		      iertmk = -1
		    ELSE
		      irptdt (1) = INT ( rptyr )
		      irptdt (2) = INT ( rptmo )
		      irptdt (3) = INT ( rptdy )
		      irptdt (4) = INT ( rpthr )
		      irptdt (5) = INT ( rptmi )
		      CALL DC_TMCK ( 2, irundt, irptdt, nhours, 180,
     +				     iertmk )
		    END IF
C
		    IF ( iertmk .eq. 0 ) THEN
C
C*                    Open a BUFR message for output.
C
		      ibfdt = ( irptdt (1) * 1000000 )  +
     +			      ( irptdt (2) * 10000 )  +
     +			      ( irptdt (3) * 100 )  +  irptdt (4)
		      CALL OPENMB ( iubfmn, subtyp, ibfdt )
C
C*		      Store the report date-time.
C
		      r8wk (1,1) = r8dttm ( 2, kk )
		      r8wk (2,1) = r8dttm ( 3, kk )
		      r8wk (3,1) = r8dttm ( 4, kk )
		      CALL UFBSEQ ( iubfmn, r8wk, MXMN, 1, nlv,
     +				    'YYMMDD' )
		      r8wk (1,1) = r8dttm ( 5, kk )
		      r8wk (2,1) = r8dttm ( 6, kk )
		      r8wk (3,1) = r8dttm ( 7, kk )
		      CALL UFBSEQ ( iubfmn, r8wk, MXMN, 1, nlv,
     +				    'HHMMSS' )
C
C*		      Get the report identifying information.
C
		      IF ( gotw51 ) THEN
			CALL READLC ( iubfma, smid, 'SMID' )
		      END IF
C
		      CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    'WMOB WMOS A4ME ANTYP' )
		      wmob = UT_BMRI ( r8in (1,1) )
		      wmos = UT_BMRI ( r8in (2,1) )
		      r8wk (1,1) = r8in (1,1)
		      r8wk (2,1) = r8in (2,1)
		      r8wk (3,1) = r8in (3,1)
		      r8wk (4,1) = r8in (4,1)
C
C*		      Get and store the WIGOS identifier.
C
                       CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +                  'WGOSIDS WGOSISID WGOSISNM' )
                       IF ( ( IBFMS ( r8in (1,1) ) .eq. 0 ) .or.
     +                      ( IBFMS ( r8in (2,1) ) .eq. 0 ) .or.
     +                      ( IBFMS ( r8in (3,1) ) .eq. 0 ) ) THEN
                         gotwigos = .true.
                         CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +                              'WIGOSID' )
                         CALL READLC ( iubfma, wgoslid, 'WGOSLID' )
                       ELSE
                         gotwigos = .false.
                       END IF
C
C*		      Get the latitude and longitude.
C
		      CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    'CLATH CLONH' )
		      IF ( ( IBFMS ( r8in (1,1) ) .eq. 1 ) .or.
     +			   ( IBFMS ( r8in (2,1) ) .eq. 1 ) ) THEN
			CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +				      'CLAT CLON' )
		      END IF
		      r8wk (5,1) = r8in (1,1)
		      r8wk (6,1) = r8in (2,1)
C
C*		      Get the site elevation.
C
		      CALL UFBINT ( iubfma, r8val, 1, 1, nlv, 'HSMSL' )
		      IF ( IBFMS ( r8val ) .eq. 1 ) THEN
			CALL UFBINT ( iubfma, r8val, 1, 1, nlv, 'SELV' )
		      END IF
		      r8selv = r8val
		      r8wk (7,1) = r8val
C
C*		      Store the identifying information, lat/long and
C*		      site elevation.
C
		      IF ( ( subtyp .eq. 'NC002007' ) .or.
     +			   ( subtyp .eq. 'NC002013' ) .or.
     +			   ( subtyp .eq. 'NC002016' ) ) THEN
		        ufbstg ='WMOB WMOS A4ME ANTYP CLAT CLON SELV'
		      ELSE
		        ufbstg ='WMOB WMOS A4ME ANTYP CLATH CLONH HSMSL'
		      END IF
		      CALL UFBINT ( iubfmn, r8wk, MXMN, 1, nlv, ufbstg )
                      IF ( ( .not. ERMISS ( wmob ) ) .and.
     +                     ( .not. ERMISS ( wmos ) ) )  THEN
			lrpid = 5
                        WRITE ( rpid(1:lrpid), FMT = '(I2.2, I3.3)' )
     +			  INT ( wmob ), INT ( wmos )
                      ELSE
			lrpid = 8
			rpid = smid(1:lrpid)
                      END IF
		      CALL UT_CIBF ( iubfmn, 'RPID', rpid, lrpid,
     +				     iercbf )
C
C*		      Write a log message with the report ID.
C
		      logmsg = subtyp // ': station ID = ' //
     +			  rpid(1:lrpid)
		      CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
C
C*		      Store the wind levels.
C
		      nlvst = 0
		      IF ( gotw51 ) THEN
			DO jj = 1, nlvls
			  IF ( ( IBFMS ( r8lvls ( 6, jj ) ) .eq. 0 ).or.
     +			       ( IBFMS ( r8lvls ( 7, jj ) ) .eq. 0 ) )
     +				THEN
			    nlvst = nlvst + 1
			    r8wk ( 1, nlvst ) = r8lvls ( 3, jj )
			    r8wk ( 2, nlvst ) = r8lvls ( 6, jj )
			    r8wk ( 3, nlvst ) = r8lvls ( 7, jj )
                            DO ii = 4, 8
			      r8wk ( ii, nlvst ) = r8bfms
			    END DO
			  END IF
			END DO
		      ELSE
			IF ( IBFMS ( r8dttm ( 8, kk ) ) .eq. 0 ) THEN
			  nlvr = IDINT ( r8dttm ( 8, kk ) )
			ELSE
			  nlvr = IDINT ( r8dttm ( 9, kk ) )
			END IF
			DO jj = 1, nlvr
			  IF ( ( IBFMS ( r8lvls ( 2, jj+lptr ) )
     +				    .eq. 0 )  .or.
     +			       ( IBFMS ( r8lvls ( 3, jj+lptr ) )
     +				    .eq. 0 )  .or.
     +			       ( IBFMS ( r8lvls ( 4, jj+lptr ) )
     +				    .eq. 0 ) )	THEN
			    nlvst = nlvst + 1
			    r8wk ( 1, nlvst ) = r8lvls ( 1, jj+lptr )
			    IF ( ( cpvt .eq. 'HAST' ) .and.
     +				( IBFMS ( r8wk ( 1, nlvst ) ) .eq. 0 ) )
     +			      r8wk ( 1, nlvst ) =
     +				r8wk ( 1, nlvst ) + r8selv
			    IF ( ( gotuwd ) .and. ( gotvwd ) ) THEN
			      uwnd = UT_BMRI ( r8lvls ( 2, jj+lptr ) )
			      vwnd = UT_BMRI ( r8lvls ( 3, jj+lptr ) )
			      r8wk ( 2, nlvst ) =
     +				UT_RIBM ( PR_DRCT ( uwnd, vwnd ) )
			      r8wk ( 3, nlvst ) =
     +				UT_RIBM ( PR_SPED ( uwnd, vwnd ) )
			    ELSE
			      r8wk ( 2, nlvst ) = r8lvls ( 2, jj+lptr )
			      r8wk ( 3, nlvst ) = r8lvls ( 3, jj+lptr )
			    END IF
			    DO ii = 4, 8
			      r8wk ( ii, nlvst ) = r8lvls( ii, jj+lptr )
			    END DO
C
C*                          Get the wind quality marks.
C
                            r8in ( 1, nlvst ) =
     +                        GETVALNB ( iubfma, cpvt, jj, 'QMRK', 1 )
                            r8in ( 2, nlvst ) =
     +                        GETVALNB ( iubfma, cpvt, jj, 'QMRK', 2 )
C
C*                          If QMRK values are unavailable, check for
C*                          1-bit associated field quality values.
C
                            IF ( ( IBFMS ( r8in ( 1, nlvst ) ) .eq. 1 )
     +                             .and.
     +                           ( IBFMS ( r8in ( 2, nlvst ) ) .eq. 1 ))
     +                          THEN
                              r8val =
     +                         GETVALNB ( iubfma, cpvt, jj, 'AFSI', 1)
                              IF ( IDNINT ( r8val ) .eq. 1 ) THEN
                              r8in ( 1, nlvst ) =
     +                         GETVALNB ( iubfma, cpvt, jj, '204001', 1)
                              r8in ( 2, nlvst ) =
     +                         GETVALNB ( iubfma, cpvt, jj, '204001', 2)
                              END IF
                            END IF
			  END IF
			END DO
			lptr = lptr + nlvr
		      END IF
		      IF ( nlvst .gt. 0 ) THEN
			CALL UFBINT ( iubfmn, r8wk, MXMN, nlvst, nlv2,
     +				      'HEIT WDIR WSPD WCMP STNR ' //
     +				      'SDHS SDVS NPQC' )
C
C*                      Store the wind quality marks.
C
                        DO jj = 1, nlvst
                          CALL SETVALNB ( iubfmn, 'HEIT', jj, 'QMRK', 1,
     +                                    r8in ( 1, jj ), iervnb )
                          CALL SETVALNB ( iubfmn, 'HEIT', jj, 'QMRK', 2,
     +                                    r8in ( 2, jj ), iervnb )
                        END DO
		      END IF
C
C*		      Additional data values which may or may not exist
C*		      in all reports.
C
		      CALL UT_BFRI ( iubfma, 'TSIG', rval, ier )
		      CALL UT_RIBF ( iubfmn, 'TSIG', rval, ier )
C
		      CALL UT_BFRI ( iubfma, 'TPMI', tpmi, ier )
                      IF ( .not. ERMISS ( tpmi ) ) THEN
		        CALL UT_RIBF ( iubfmn, 'TPMI', tpmi, ier )
                      ELSE
		        CALL UT_BFRI ( iubfma, 'TPSE', tpse, ier )
                        IF ( .not. ERMISS ( tpse ) ) THEN
		          IF ( subtyp .eq. 'NC002007' ) THEN
		            CALL UT_RIBF ( iubfmn, 'TPSE', tpse, ier )
                          ELSE
                            tpmi = tpse / 60.
		            CALL UT_RIBF ( iubfmn, 'TPMI', tpmi, ier )
                          END IF
                        END IF
                      END IF
C
		      IF ( subtyp .ne. 'NC002013' ) THEN
C
			CALL UFBINT ( iubfma, r8val, 1, 1, nlv, 'MEFR' )
			CALL UFBINT ( iubfmn, r8val, 1, 1, nlv, 'MEFR' )
C
		        IF ( subtyp .eq. 'NC002018' ) THEN
C
			  CALL UFBINT ( iubfma, r8val, 1, 1, nlv,'PRFR')
			  CALL UFBINT ( iubfmn, r8val, 1, 1, nlv,'PRFR')
C
			  CALL UT_BFRI ( iubfma, 'NOIP', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'NOIP', rval, ier )
			ELSE IF ( subtyp .eq. 'NC002007' ) THEN
C
			  CALL UT_BFCI ( iubfma, 'SSTN', sstn, ier )
			  CALL UT_CIBF ( iubfmn, 'SSTN', sstn, 5, ier )
			ELSE
C
			  CALL UT_BFRI ( iubfma, 'BEAMW', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'BEAMW', rval, ier )
C
			  CALL UT_BFRI ( iubfma, 'RAGL', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'RAGL', rval, ier )
			END IF
C
		        IF ( subtyp .eq. 'NC002016' ) THEN
C
			  CALL UT_BFRI ( iubfma, 'MSPE', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'MSPE', rval, ier )
C
			  CALL UT_BFRI ( iubfma, 'WICE', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'WICE', rval, ier )
			END IF
C
		        IF ( ( subtyp .eq. 'NC002007' ) .or.
     +			     ( subtyp .eq. 'NC002016' ) ) THEN
C
			  CALL UT_BFRI ( iubfma, 'TOST', rval, ier )
			  CALL UT_RIBF ( iubfmn, 'TOST', rval, ier )
			END IF
		      END IF
C
C*		      Bulletin header.
C
		      CALL UT_CIBF ( iubfmn, 'SEQNUM', seqnum, 8, ier )
		      CALL UT_CIBF ( iubfmn, 'BUHD', buhd, 8, ier )
		      CALL UT_CIBF ( iubfmn, 'BORG', cborg, 8, ier )
		      CALL UT_CIBF ( iubfmn, 'BULTIM', bulldt, 8, ier )
		      CALL UT_CIBF ( iubfmn, 'BBB', bbb, 8, ier )
C
C*		      Receipt time.
C
		      CALL UT_RIBF ( iubfmn, 'RCTS', FLOAT (0), ier )
		      CALL UT_RIBF ( iubfmn, 'RCYR',
     +				     FLOAT ( irundt (1) ), ier )
		      CALL UT_RIBF ( iubfmn, 'RCMO',
     +				     FLOAT ( irundt (2) ), ier )
		      CALL UT_RIBF ( iubfmn, 'RCDY',
     +				     FLOAT ( irundt (3) ), ier )
		      CALL UT_RIBF ( iubfmn, 'RCHR',
     +				     FLOAT ( irundt (4) ), ier )
		      CALL UT_RIBF ( iubfmn, 'RCMI',
     +				     FLOAT ( irundt (5) ), ier )
C
C*		      Correction indicator.
C
		      IF ( ( IUPBS01 ( ibull, 'USN' ) .gt. 0 ) .or.
     +			    ( bbb(1:1) .eq. 'C' ) ) THEN
		        icorn = 1
		      ELSE
		        icorn = 0
		      END IF
		      CALL UT_RIBF ( iubfmn, 'CORN', FLOAT (icorn), ier )
C
C*		      Write the BUFR output to the BUFR output stream.
C
		      CALL UT_WBFR ( iubfmn, 'wpfl', 0, ierwbf )
                      IF ( gotwigos )
     +                  CALL WRITLC ( iubfmn, wgoslid, 'WGOSLID' )
		      IF ( gotw51 )
     +			CALL WRITLC ( iubfmn, smid, 'SMID' )
                    END IF
C
		    END DO
		  END IF
		END IF
	      END DO
            END IF
	  END DO
	END DO
C*
	RETURN
	END