SUBROUTINE RC_DCOD ( cldt, bufrtn, nhours, iret )
C************************************************************************
C* RC_DCOD								*
C*									*
C* This routine decodes bulletins containing radio occultation data     *
C* into NCEP BUFR format.                        			*
C*									*
C* RC_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		10/08						*
C* J. Ator/NCEP		09/09	Add UT_CBS3 check			*
C* J. Ator/NCEP		09/20	Redesigned to fully decode input msgs,  *
C*      			and to add RSRD, EXPRSRD, BID and RCPTIM*
C*                              to NCEP output stream.                  * 
C* M. Weiss/IMSG        05/21   MAXOUT (200000) to (199900)             *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
        INCLUDE         'BUFR.CMN'
C*
        CHARACTER*(*)   cldt, bufrtn
C*
	CHARACTER	bull*(DCMXBF), cbull*(DCMXBF),
     +			seqnum*8, buhd*8, cborg*8, bulldt*8, bbb*8,
     +                  rundt*12, sysdt*12, logmsg*200,
     +			bufrdn*(DCMXLN), bufrbn*(DCMXLN),
     +                  bfstyp*8, subtyp*8, tagpr*8, tagprp*10
C*
C*      Maximum number of data values in a radio occultation subset.
C*
        PARAMETER       ( MXMN = 125000 )
C*
        REAL*8          r8in ( MXMN )
C*
	INTEGER		irundt (5), irptdt (5), ibull ( DCMXBF / 4 ),
     +                  ndrps2 (MXBFLV16), RC_NDRP
C
	LOGICAL		bullok
C*
	EQUIVALENCE	( cbull (1:4), ibull (1) )
C*
C*	Expected descriptors within Section 3 of a radio occultation
C*	BUFR message.
C*
	PARAMETER	( NXDESC = 1 )
	CHARACTER 	cxdesc(NXDESC)*6
C*
	DATA		cxdesc / '310026' /
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/dcrocc',
     +          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 )
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 )

	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
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
              bullok = .true.
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.
            END IF
          END IF
C
	  DO WHILE ( bullok )
C
C*	    Locate the next BUFR message within the bulletin, and store
C*	    it within an equivalenced integer array.
C
	    ipt1 = INDEX ( bull ( ibptr : lenb ), 'BUFR' )
	    IF ( ipt1 .eq. 0 )  THEN
	      bullok = .false.
C
C*            Make sure that all BUFR output for this bulletin
C*            has been written to the BUFR output stream before
C*            going back to DC_GBUL and waiting for a new bulletin
C*            on the input pipe.
C
              CALL UT_WBFR ( iubfmn, 'rocc', 1, ierwbf )
            ELSE
              nrept = 0
              istart = ibptr + ipt1 - 1
              ibptr = istart + 4
              cbull = bull ( istart : lenb )
              msglen = IUPBS01 ( ibull, 'LENM' )
              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
                msgok = .true.
              END IF
C
              IF ( msgok ) THEN
C
C*	        Retrieve the Section 3 descriptors from the message
C*              and compare it with the list of expected descriptors.
C
	        CALL UT_CBS3 ( 2, ibull, cxdesc, NXDESC, iercs3 )
	        IF ( iercs3 .ne. 0 ) THEN
                  msgok = .false.
                  logmsg = 'message does not contain 310026 sequence'
                  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.
                ELSE
                  icmp = IUPBS3 ( ibull, 'ICMP' )
                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*                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
                  CALL UFBSEQ ( iubfma, r8in, MXMN, 1, nlv,
     +                          'YYMMDD' )
                  rptyr = UT_BMRI ( r8in (1) )
                  rptmo = UT_BMRI ( r8in (2) )
                  rptdy = UT_BMRI ( r8in (3) )
                  CALL UFBSEQ ( iubfma, r8in, MXMN, 1, nlv,
     +                          'HHMM' )
                  rpthr = UT_BMRI ( r8in (1) )
                  rptmi = UT_BMRI ( r8in (2) )
                  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
                    nrept = nrept + 1
C
C*                  If the message is uncompressed, or if this is the
C*                  first subset in the message, then get the delayed
C*                  replication counts.
C
                    IF ( ( icmp .eq. 0 ) .or. ( nrept .eq. 1 ) ) THEN
                      ndrps1 = RC_NDRP ( iubfma, 'BEARAZ', 2 )
                      IF ( ndrps1 .gt. 0 ) THEN
                        CALL GETTAGPR ( iubfma, 'MEFR', 1, tagpr,
     +                                  ierptg )
                        IF ( ierptg .ne. 0 ) THEN
                          DO ii = 1, ndrps1
                            ndrps2 (ii) = 0
                          END DO
                        ELSE
                          CALL ST_LSTR ( tagpr, ltagpr, ier )
                          tagprp = '{' // tagpr(1:ltagpr) // '}'
                          CALL UFBREP ( iubfma, r8in, 1, MXMN, nrep,
     +                                  tagprp )
                          DO ii = 1, ndrps1
                            ndrps2 (ii) = IDINT ( r8in (ii) )
                          END DO
                        END IF
                      END IF
                      ndrps3 = RC_NDRP ( iubfma, 'ARFR', 1 )
                      ndrps4 = RC_NDRP ( iubfma, 'SPFH', 1 )
                    END IF
C
C*                  Log the subtype and satellite ID.
C
                    CALL UT_BFRI ( iubfma, 'SAID', said, ier )
                    isaid = INT ( said )
                    subtyp = 'NC003010'
                    WRITE ( logmsg, FMT = '(2A, I4)' )
     +                  subtyp, ':  satellite ID =', isaid
                    CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg )
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*                  Set the delayed replication counts.
C
                    CALL DRFINI ( iubfmn, ndrps1, 1, '(ROSEQ1)' )
                    IF ( ndrps1 .gt. 0 ) THEN
                      CALL DRFINI ( iubfmn, ndrps2, ndrps1,
     +                             '{ROSEQ2}' )
                    END IF
                    CALL DRFINI ( iubfmn, ndrps3, 1, '(ROSEQ3)' )
                    CALL DRFINI ( iubfmn, ndrps4, 1, '(ROSEQ4)' )
C
C*                  Read and write the main report sequence.
C
                    CALL UFBSEQ ( iubfma, r8in, MXMN, 1, nlv,
     +                            'RAOCSEQ' )
                    CALL UFBSEQ ( iubfmn, r8in, MXMN, 1, nlv,
     +                            'RAOCSEQ' )
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*                  Restrictions on redistribution.
C
                    IF ( ( isaid .ge. 265 ) .and.
     +                   ( isaid .le. 269 ) ) THEN
                      CALL UT_RIBF ( iubfmn, 'RSRD', 128., ier )
                      CALL UT_RIBF ( iubfmn, 'EXPRSRD', 24., ier )
                    END IF
C
C*                  Write the BUFR output to the BUFR output stream.
C
                    CALL UT_WBFR ( iubfmn, 'rocc', 0, ierwbf )
                  END IF
C
                END IF
C
              END DO
C
            END IF
C              
          END DO 
C
	END DO
C*
	RETURN
	END