SUBROUTINE RD_DCOD  ( cldt, bufrtn, nhours, iret )
C************************************************************************
C* RD_DCOD								*
C*									*
C* This routine decodes bulletins containing WMO-migrated radiosonde	*
C* BUFR messages into NCEP BUFR format. 				*
C*									*
C* RD_DCOD ( CLDT, 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		03/12						*
C* J. Ator/NCEP		10/14	Increase sizes of MXDSC and MXLV,	*
C*				store RPID, replicate BID and RCPTIM,	*
C*				check land station metadata vs. table,	*
C*				add MXNLV check to prevent overflow of	*
C*				MAXSS parameter in BUFRLIB		*
C* J. Ator/NCEP		02/15	Increase sizes of MXLV, MXNLV and MAXSS,*
C*				use HOLD4WLC instead of WRITLC		*
C* J. Ator/NCEP		05/15	Use DC_CRID to build dropsonde RPID	*
C* J. Ator/NCEP		10/16	Increase sizes of MXNLV and MAXSS	*
C* J. Ator/NCEP		06/17	Check for overly-small input message	*
C* J. Ator/NCEP		10/19	Decode and store WIGOS IDs when present,*
C*				remove metadata checks vs. lndstn table,*
C*				process 309056 and 309057 sequences     *
C* M. Weiss/IMSG        05/21   MAXOUT ( 200000 ) --> ( 199900 )        *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
C*
	CHARACTER*(*)	cldt, bufrtn
C*
C*	Maximum number of descriptors within Section 3 of a
C*	WMO radiosonde BUFR message.
C*
	PARAMETER	( MXDSC = 50 )
C*
C*	Maximum number of sounding levels that will be decoded from
C*	a WMO radiosonde BUFR message.
C*
	PARAMETER	( MXLV = 12000 )
C*
C*	Maximum number of sounding levels that will be encoded into
C*	an NCEP radiosonde BUFR message.
C*
	PARAMETER	( MXNLV = 7600 )
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, acid*8, rserl*20,
     +			cverstg*8, wkstg*80, wkstg2*8, rpid*8, dpid*8,
     +                  wgoslid*16, softv*12,
     +                  bufrdn*(DCMXLN), bufrbn*(DCMXLN)
C*
	INTEGER		irundt ( 5 ), irptdt ( 5 ), 
     +			ibull ( DCMXBF / 4 )
C*
	LOGICAL		bullok, msgok, gotwigos, gotrdscnt, gothppg,
     +			gotrserl, gottmpc, gotwbh, gotdrp, gotcld,
     +                  gotsoftv
C*
	REAL*8		r8in ( MXMN, MXLV ), r8wk ( MXMN, MXLV ),
     +			r8bfms, GETBMISS
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*	Set any configurable BUFRLIB parameters to optimize them for
C*	the needs of this program.  This includes setting any
C*	parameters associated with BUFRLIB features that we won't be
C*	using in this program (e.g. writing compressed output, storing
C*	messages in internal memory, etc.) to artificially low values,
C*	which in turn will prevent the unnecessary allocation of a lot
C*	of memory that will never be used.
C
 	CALL ISETPRM ( 'NFILES', 4 )
 	CALL ISETPRM ( 'MXMSGL', 400000 )
 	CALL ISETPRM ( 'MAXSS', 250000 )
 	CALL ISETPRM ( 'MAXMEM', 100000 )
 	CALL ISETPRM ( 'MAXMSG', 100 )
 	CALL ISETPRM ( 'MXDXTS', 5 )
 	CALL ISETPRM ( 'MXCDV', 100 )
 	CALL ISETPRM ( 'MXCSB', 100 )
 	CALL ISETPRM ( 'MXLCC', 8 )
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/dcrdsn',
     +		FORM = 'UNFORMATTED' )
	CALL OPENBF ( iubfma, 'SEC3', iubftn )
C
	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*	Since this decoder may generate BUFR subsets larger than 65530
C*	bytes, and since BUFRLIB will write such subsets into their own
C*	BUFR messages within the same internal call to subroutine
C*	MSGUPD, then it is possible for an empty BUFR message (i.e.
C*	containing 0 subsets) to be subsequently generated, so we need
C*	to tell BUFRLIB to never write any such empty messages to its
C*	output stream.
C
	CALL CLOSMG ( (-1) * iubfmn )
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, 'rdsn', 1, ierwbf )
	      END IF
	    ELSE
	      istart = ibptr + ipt1 - 1
	      ibptr = istart + 4
	      cbull = bull ( istart : lenb )
C
	      nmsg = nmsg + 1
	      msgok = .false.
C
C*	      Check for a corrupt or empty (overly-small) BUFR message.
C
	      msglen = IUPBS01 ( ibull, 'LENM' )
	      IF ( ( msglen .gt. lenb ) .or.
     +		  ( cbull ( msglen-3 : msglen ) .ne. '7777' ) ) THEN
		logmsg = 'ERROR: corrupt BUFR message'
		CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
	      ELSE IF ( msglen .lt. 120 ) THEN
		WRITE ( logmsg, FMT = '(A, I3, A)' )
     +		  'ERROR: BUFR message length was only ',
     +		  msglen, ' bytes'
		CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
	      ELSE
		gottmpc = .false.
		gotwbh = .false.
		gotdrp = .false.
		gotrdscnt = .false.
		gothppg = .false.
		gotrserl = .false.
                gotsoftv = .false.
C
C*		Retrieve the Section 3 descriptors from the message to
C*		ensure it contains WMO radiosonde data.
C
		CALL UPDS3 ( ibull, MXDSC, cdesc, ndesc )
		ii = 1
		DO WHILE ( ( ii .le. ndesc ) .and. ( .not. msgok ) )
		  IF ( ( cdesc(ii) .eq. '309050' ) .or.
     +		       ( cdesc(ii) .eq. '309051' ) ) THEN
		    msgok = .true.
		    IF ( cdesc(ii)(6:6) .eq. '1' ) gotwbh = .true.
		  ELSE IF ( ( cdesc(ii) .eq. '309052' ) .or.
     +                      ( cdesc(ii) .eq. '309053' ) .or.
     +                      ( cdesc(ii) .eq. '309056' ) .or.
     +			    ( cdesc(ii) .eq. '309057' ) ) THEN
		    msgok = .true.
		    gottmpc = .true.
		    IF ( cdesc(ii)(6:6) .eq. '3' ) THEN
                      gotdrp = .true.
		    ELSE IF ( cdesc(ii)(6:6) .eq. '6' ) THEN
                      gotrdscnt = .true.
                      gothppg = .true.
                      gotrserl = .true.
                      gotsoftv = .true.
		    ELSE IF ( cdesc(ii)(6:6) .eq. '7' ) THEN
                      gothppg = .true.
                      gotrserl = .true.
                      gotsoftv = .true.
                    END IF
		  ELSE
		    ii = ii + 1
		  END IF
		END DO
		IF ( msgok ) THEN
C
C*		  If there are any extra descriptors, check for any long
C*		  character strings.
C
		  IF ( ndesc .gt. 1 ) THEN
		    logmsg = 'message contains extra descriptors:'
		    CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		    DO ii = 1, ndesc
		      IF ( cdesc(ii) .eq. '301128' ) THEN
                        gotrserl = .true.
                        gotsoftv = .true.
		      ELSE IF ( cdesc(ii) .eq. '001081' ) THEN
                        gotrserl = .true.
		      ELSE IF ( cdesc(ii) .eq. '025061' ) THEN
                        gotsoftv = .true.
                      END IF
		      WRITE ( logmsg, FMT = '(I6, A, A)' )
     +			  ii, ': ', cdesc(ii)
		      CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		    END DO
		  END IF
		ELSE
		  logmsg = 'message does not follow WMO template:'
		  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		  DO ii = 1, ndesc
		    WRITE ( logmsg, FMT = '(I6, A, A)' )
     +		        ii, ': ', cdesc(ii)
		    CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
		  END DO
		END IF
	      END IF
C
	      IF ( msgok ) THEN
C
C*		Get the message type and subtype.
C
		mtyp = IUPBS01( ibull, 'MTYP' )
		msbti = IUPBS01( ibull, 'MSBTI' )
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*		  Get the date-time of the launch.
C
		  CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				'DATETMLN' )
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 ( r8in (2,1) )
		  rptmo = UT_BMRI ( r8in (3,1) )
		  rptdy = UT_BMRI ( r8in (4,1) )
		  rpthr = UT_BMRI ( r8in (5,1) )
		  rptmi = UT_BMRI ( r8in (6,1) )
		  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
C*		  Check the type of measuring equipment used.
C
		  CALL UT_BFRI ( iubfma, 'A4ME', a4me, ier )
		  ia4me = INT ( a4me )
		  IF ( ia4me .eq. 6 ) THEN
		    logmsg = 'report contains wind profiler data ' //
     +			'and will be skipped'
		    CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
		  ELSE IF ( iertmk .eq. 0 ) THEN
C
C*		    Determine the NCEP BUFR output subtype.
C
		    CALL UT_BFRI ( iubfma, 'WMOB', wmob, ier )
		    CALL UT_BFRI ( iubfma, 'WMOS', wmos, ier )
		    IF ( ( .not. gottmpc ) .and. ( ia4me .eq. 1 ) ) THEN
		      subtyp = 'NC002105'
		    ELSE IF ( ( gotdrp ) .or. ( gotrdscnt ) ) THEN
		      subtyp = 'NC002104'
		    ELSE IF ( ( mtyp .eq. 2 ) .and.
     +			      ( msbti .eq. 7 ) ) THEN
		      subtyp = 'NC002104'
		    ELSE IF ( ( mtyp .eq. 2 ) .and.
     +			     ( ( msbti .ge. 14 ) .and.
     +                         ( msbti .le. 16 ) ) ) THEN
		      subtyp = 'NC002104'
		    ELSE IF ( ( mtyp .eq. 2 ) .and.
     +			      ( msbti .eq. 6 ) ) THEN
		      subtyp = 'NC002102'
		    ELSE IF ( ( mtyp .eq. 2 ) .and.
     +			      ( msbti .eq. 5 ) ) THEN
		      subtyp = 'NC002103'
		    ELSE
		      IF ( ( .not. ERMISS ( wmob ) ) .and.
     +			   ( .not. ERMISS ( wmos ) ) )  THEN
			subtyp = 'NC002101'
		      ELSE
			subtyp = 'NC002103'
		      END IF
		    END IF
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 date-time of the launch.
C
		    CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +				  'DATETMLN' )
C
C*		    Get the report ID.
C
		    IF ( ( subtyp .eq. 'NC002104' ) .and.
     +                  ( .not. gotrdscnt ) ) THEN
		      lrpid = 7
		      rpid = 'DRP99A'
		      CALL UT_BFCI ( iubfma, 'ACID', acid, ierbci )
		      CALL UT_BFRI ( iubfma, 'OSQN', osqn, ierbri )
		      IF ( ( acid(1:1) .ne. ' ' ) .and.
     +			    ( .not. ERMISS ( osqn ) ) ) THEN
			iosqn = INT ( osqn )
			IF ( iosqn .lt. 10 ) THEN
			  WRITE ( wkstg, FMT = '( A, A, I2.2 )' )
     +			    acid, 'OB ', iosqn
			ELSE
			  WRITE ( wkstg, FMT = '( A, A, I3 )' )
     +			    acid, 'OB ', iosqn
			END IF
			CALL DC_CRID ( wkstg, dpid, ldpid, ierrid )
			IF ( ierrid .eq. 0 ) THEN
			  lrpid = ldpid
			  rpid = dpid(1:lrpid)
			END IF 
		      END IF
		    ELSE 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
		      CALL READLC ( iubfma, smid, 'SMID' )
		      lrpid = 8
		      rpid = smid(1:lrpid)
		    END IF
C
C*		    Store the report ID, and write a log message
C*		    with the subtype and report ID.
C
		    CALL UT_CIBF ( iubfmn, 'RPID', rpid, lrpid, iercbf )
		    logmsg = subtyp // ':  station ID = ' //
     +			rpid(1:lrpid)
		    CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
C
C*                  Get and store the WIGOS identifier.
C
                    gotwigos = .false.
                    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 IF (  ( lrpid .eq. 5 ) .and.
     +                       (  ( rpid(1:5) .eq. '91212' ) .or.
     +                          ( rpid(1:5) .eq. '91285' ) .or.
     +                          ( ( rpid(1:2) .eq. '72' ) .and.
     +                            ( rpid(3:5) .ne. '388' ) )  )  ) THEN
C
C*                    Temporarily manufacture WIGOS identifiers for
C*                    some U.S. sites, just to begin populating the
C*                    downstream database, and until these sites begin
C*                    generating WIGOS identifiers on their own.
C
                      gotwigos = .true.
                      r8wk (1,1) = 0
                      IF ( ( rpid(1:5) .eq. '72327' ) .or.
     +                     ( rpid(1:5) .eq. '72518' ) .or.
     +                     ( rpid(1:5) .eq. '72520' ) .or.
     +                     ( rpid(1:5) .eq. '72662' ) ) THEN
                        r8wk (2,1) = 20001
                      ELSE
                        r8wk (2,1) = 20000
                      END IF
                      r8wk (3,1) = 0
                      r8wk (4,1) = r8bfms
                      CALL UFBSEQ ( iubfmn, r8wk, MXMN, 1, nlv,
     +                              'WIGOSID' )
                      wgoslid = rpid(1:5) // '           '
                    END IF
C
C*		    Get and store the identification and instrumentation
C*		    values.
C
		    IF ( ( subtyp .eq. 'NC002104' ) .and.
     +                  ( .not. gotrdscnt ) ) THEN
		      CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    'IDLPIDRP' )
		      CALL DRFINI ( iubfmn, 1, 1, '{IDLPIDRP}' )
		      CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +				    'IDLPIDRP' )
		    ELSE
		      CALL READLC ( iubfma, smid, 'SMID' )
		      IF ( gottmpc ) THEN
			CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				      'IDLSIPTM' )
                        IF ( .not. gotrdscnt ) THEN
			  CALL DRFINI ( iubfmn, 1, 1, '{IDLSIPTM}' )
			  CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +				        'IDLSIPTM' )
                        ELSE
		          CALL UT_RIBF ( iubfmn, 'WMOB', wmob, ier )
		          CALL UT_RIBF ( iubfmn, 'WMOS', wmos, ier )
                          DO ii = 1, 4
			    r8wk (ii,1) = r8in (ii+3,1)
                          END DO
			  CALL UFBINT ( iubfmn, r8wk, MXMN, 1, nlv,
     +				  'RATP SIRC TTSS A4ME' )
                        END IF
		      ELSE
			CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				      'IDLSIWDM' )
			r8wk (1,1) = r8in (1,1)
			r8wk (2,1) = r8in (2,1)
                        DO ii = 3, 5
			  r8wk (ii,1) = r8in (ii+1,1)
                        END DO
			CALL UFBINT ( iubfmn, r8wk, MXMN, 1, nlv,
     +				      'WMOB WMOS RATP TTSS A4ME' )
		      END IF
		    END IF
C
C*		    Get and store the launch site coordinates.
C
                    IF ( gotrdscnt ) THEN
                      CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +                              'CLATH CLONH HEIT' )
		      CALL UFBINT ( iubfmn, r8in, MXMN, 1, nlv,
     +                              'CLATH CLONH HEIT' )
                    ELSE
		      CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    'HAVCOLS' )
		      CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +				    'HAVCOLS' )
                    END IF
C
		    IF ( ( gottmpc ) .and.
     +			( subtyp .ne. 'NC002104' ) ) THEN
C
C*		      Get and store the cloud information.
C
		      CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    'CLINRVSD' )
		      gotcld = .false.
		      DO ii = 1, 6
			IF ( IBFMS ( r8in (ii,1) ) .eq. 0 )
     +			  gotcld = .true.
		      END DO
		      IF ( gotcld ) THEN
			CALL DRFINI ( iubfmn, 1, 1, '{CLINRVSD}' )
			CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +				      'CLINRVSD' )
		      END IF
C
C*		      Get and store the sea/water temperature.
C
		      CALL UT_BFRI ( iubfma, 'SST1', rsst1, ier )
		      CALL UT_RIBF ( iubfmn, 'SST1', rsst1, ier )
		    END IF
C
C*		    Sounding level data.
C
		    IF ( gottmpc ) THEN
C
C*		      The levels contain temperatures and winds.
C
                      IF ( gothppg ) THEN
		        CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				      'TDWPRAOH' )
                      ELSE
		        CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				      'TDWPRAOB' )
                      END IF
		      IF ( nlv .gt. 0 ) THEN
			wkstg = 'LTDS VSIGX PRLC GP10 LATDH LONDH ' //
     +				'TMDB TMDP WDIR WSPD'
			IF ( nlv .gt. MXNLV ) THEN
			  WRITE ( logmsg, FMT = '(A, I5, A, I5, A)' )
     +			    'WARNING: Only stored first ', MXNLV,
     +			    ' of ', nlv, ' sounding levels in output'
			  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
			  nlv = MXNLV
			END IF
			DO jj = 1, nlv
			  DO ii = 1, 10
			    r8wk (ii,jj) = r8in (ii,jj)
			  END DO
			  IF ( IBFMS ( r8wk (4,jj) ) .eq. 0 )
     +			    r8wk (4,jj) = r8wk (4,jj) * 9.8
			END DO
C
C*			Check for wind shear data on an existing level.
C
		        CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nwlv,
     +				      'WSPLRAOB' )
		        IF ( nwlv .gt. 0 ) THEN
			  wkstg(53:62) = ' AWSB AWSA'
			  DO jj = 1, nlv
			    r8wk (11,jj) = r8bfms
			    r8wk (12,jj) = r8bfms
			    DO kk = 1, nwlv
			      IF ( r8wk (3,jj) .eq. r8in(3,kk) ) THEN
				r8wk (11,jj) = r8in (6,kk)
				r8wk (12,jj) = r8in (7,kk)
			      END IF
			    END DO
			  END DO
			END IF
		      END IF
		    ELSE
C
C*		      The levels contain winds only.
C
		      IF ( gotwbh ) THEN
			wkstg = 'LTDS VSIGX GP07 LATDH LONDH WDIR WSPD'
			wkstg2 = 'WDHLRAOB'
			rmf = 9.8
		      ELSE
			wkstg = 'LTDS VSIGX PRLC LATDH LONDH WDIR WSPD'
			wkstg2 = 'WDPLRAOB'
			rmf = 1.0
		      END IF
		      CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv,
     +				    wkstg2 )
		      IF ( nlv .gt. 0 ) THEN
			IF ( nlv .gt. MXNLV ) THEN
			  WRITE ( logmsg, FMT = '(A, I5, A, I5, A)' )
     +			    'WARNING: Only stored first ', MXNLV,
     +			    ' of ', nlv, ' sounding levels in output'
			  CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
			  nlv = MXNLV
			END IF
			DO jj = 1, nlv
			  DO ii = 1, 7
			    r8wk (ii,jj) = r8in (ii,jj)
			  END DO
			  IF ( IBFMS ( r8wk (3,jj) ) .eq. 0 )
     +			    r8wk (3,jj) = r8wk (3,jj) * rmf
			END DO
C
C*			Check for wind shear data on an existing level.
C
			wkstg2(2:2) = 'S'
		        CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nwlv,
     +				      wkstg2 )
		        IF ( nwlv .gt. 0 ) THEN
			  wkstg(38:47) = ' AWSB AWSA'
			  DO jj = 1, nlv
			    r8wk (8,jj) = r8bfms
			    r8wk (9,jj) = r8bfms
			    DO kk = 1, nwlv
			      IF ( r8wk (3,jj) .eq.
     +				    ( r8in(3,kk) * rmf ) ) THEN
				r8wk (8,jj) = r8in (6,kk)
				r8wk (9,jj) = r8in (7,kk)
			      END IF
			    END DO
			  END DO
			END IF
		      END IF
		    END IF
		    IF ( nlv .gt. 0 ) THEN
		      CALL UFBINT ( iubfmn, r8wk, MXMN, nlv, nwlv,
     +				    wkstg )
		    END IF
C
C*		    Additional data values which may or may not exist in
C*		    all reports.
C
		    IF ( gotrserl )
     +		      CALL READLC ( iubfma, rserl, 'RSERL' ) 
C
		    IF ( gotsoftv )
     +		      CALL READLC ( iubfma, softv, 'SOFTV' ) 
C
                    CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +                     'RASCN RRLSE RFREQ PSENS TSENS RHSENS ' //
     +                     'RACP RCONF RGRSY GHTC CAHM RTERM' )
		    CALL UFBINT ( iubfmn, r8in, MXMN, 1, nlv,
     +                     'RASCN RRLSE RFREQ PSENS TSENS RHSENS ' //
     +                     'RACP RCONF RGRSY GHTC CAHM RTERM' )
C
                    CALL UFBINT ( iubfma, r8in, MXMN, MXLV, nlv,
     +                     'BMFGR BTYPE BWGHT BSHEL BGTYP BGAMT ' //
     +                     'BFTLN BGVOL' )
		    CALL UFBINT ( iubfmn, r8in, MXMN, 1, nlv,
     +                     'BMFGR BTYPE BWGHT BSHEL BGTYP BGAMT ' //
     +                     'BFTLN BGVOL' )
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*		    Long character fields.
C
		    IF ( gotwigos )
     +		      CALL HOLD4WLC ( iubfmn, wgoslid, 'WGOSLID' )
		    IF ( gotrserl )
     +		      CALL HOLD4WLC ( iubfmn, rserl, 'RSERL' )
		    IF ( gotsoftv )
     +		      CALL HOLD4WLC ( iubfmn, softv, 'SOFTV' )
		    IF ( ( subtyp .ne. 'NC002104' ) .or. ( gotrdscnt ) )
     +		      CALL HOLD4WLC ( iubfmn, smid, 'SMID' )
C
C*		    Write the BUFR output to the BUFR output stream.
C
		    CALL UT_WBFR ( iubfmn, 'rdsn', 0, ierwbf )
		  END IF
		END IF
	      END DO
            END IF
	  END DO
	END DO
C*
	RETURN
	END