SUBROUTINE AT_DCOD  ( cldt, bufrtn, nhours, iret )
C************************************************************************
C* AT_DCOD								*
C*									*
C* This program decodes bulletins containing altimeter BUFR data into	*
C* NCEP BUFR format.							*
C*									*
C* AT_DCOD ( CLDT, BUFRTN, NHOURS, IRET )		  		*
C*									*
C* Input parameters:							*
C*	CLDT		CHAR*		Date-time from command line	*
C*      BUFRTN          CHAR*           NCEP altimeter BUFR table	*
C*	NHOURS		INTEGER		Max # of hours before run time	*
C*					for creating BUFR output	*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code:			*
C*					  0 = normal return		*
C*									*
C**									*
C* Log:									*
C* S. Guan/NCEP         11/08   Initial version                         *
C* J. Ator/NCEP		11/08	Use CRBMG to read BUFR msgs from a file	*
C* J. Ator/NCEP		09/10	Add UT_CBS3 check			*
C* S. Guan/NCEP         03/10   Add new BUFR Jason2 sequence (3-40-010) *
C*				Change in the format of the Jason-2     *
C*				OGDR-BUFR products to be introduced     *
C* 				April 14 201                            * 
C* S. Guan/NCEP         04/10	Rewrite: creating NC031115 sequence and *
C *                             adding "RCPTIM  CORN"                   *
C* J. Ator/NCEP		12/12	Use IO='INUL' in OPENBF call to		*
C*				preclude use of .dummy file		*
C* J. Ator/NCEP		10/15	Restructured to read GTS bulletins	*
C*				instead of system files and to add	*
C*				processing of Cryosat and SARAL/Altika	*
C* J. Ator/NCEP		07/16	Add processing of Jason-3		*
C* J. Ator/NCEP		03/20	Add processing of Sentinel 3A and 3B	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'BRIDGE.PRM'
C*
	CHARACTER*(*)	 cldt, bufrtn
C*
	PARAMETER	( MXDSC = 10 )
C*
        CHARACTER       bull*(DCMXBF), cbull*(DCMXBF),
     +                  seqnum*8, buhd*8, cborg*8, bulldt*8, bbb*8,
     +                  rundt*12, sysdt*12,
     +                  bfstin*8, bfstot*8, satstg*8,
     +                  logmsg*200, cdesc(MXDSC)*6,
     +                  bufrdn*(DCMXLN), bufrbn*(DCMXLN)

	CHARACTER	bfstyp*8,
     +			cstaq*20, csoftv*12, cnumid*16, cpcid*8
C*
        INTEGER         irundt (5), irptdt (5), ibull ( DCMXBF / 4 )
C*
        LOGICAL         bullok
C*
	PARAMETER	( MXVAL = 1500 )
C*
        REAL*8          r8ary ( MXVAL )
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
C*      NCEP altimeter 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 input BUFR messages stream.
C
        CALL FL_GLUN  ( iubfme, iergln )
        IF  ( iergln .ne. 0 )  THEN
            CALL DC_WLOG  ( 0, 'FL', iergln, ' ', ierwlg )
            RETURN
        END IF
	OPEN ( UNIT = iubfme, FILE = '.dummy/dcaltm',
     +		FORM = 'UNFORMATTED' )
	CALL OPENBF  ( iubfme, 'SEC3', iubftn )
	CALL MTINFO ( bufrdn, 98, 99 )
C
C*      Open the messages file for the
C*      NCEP altimeter 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 altimeter BUFR (i.e. output) stream.
C
        CALL OPENBF  ( iubfmn, 'NUL', iubftn )
C
C*      Specify that NCEP altimeter BUFR (i.e. output) messages are
C*      to be compressed, edition 4 and up to 100K bytes in size.
C
        CALL CMPMSG ( 'Y' )
	CALL PKVS01 ( 'BEN', 4 )
        CALL MAXOUT ( 100000 )
        CALL PKVS01 ( 'MTV', 33 )
C
C*      Close the tables file for the
C*      NCEP altimeter 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  ( iubfme )
		CALL CLOSBF  ( iubfmn )
		CALL FL_CLAL  ( iercal )
		RETURN
	    END IF
            bullok = .true.
            nrept = 0
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
            IF  ( bullok )  THEN
C
C*              If a date-time was entered on the command line, then
C*              use it as the run date-time.  Otherwise, use the
C*              system time as 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
            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
	    IF  ( bullok )  THEN
C
C*		Locate the altimeter BUFR message within the bulletin,
C*		and store it within an equivalenced integer array.
C
		ipt1 = INDEX ( bull ( ibptr : lenb ), 'BUFR' )
		IF  ( ipt1 .ne. 0 )  THEN
		    istart = ibptr + ipt1 - 1
		    cbull = bull ( istart : lenb )
		ELSE
		    bullok = .false.
		END IF
	    END IF
	    IF  ( bullok )  THEN
C
C*		Check for a corrupt BUFR message.
C
		msglen = IUPBS01 ( ibull, 'LENM' )
		IF ( ( msglen .gt. lenb ) .or.
     +		    ( cbull ( msglen-3 : msglen ) .ne. '7777' ) ) THEN
		    bullok = .false.
		    logmsg = 'ERROR: corrupt BUFR message'
		    CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
		END IF
	    END IF
            IF  ( bullok )  THEN
C
C*              Open the altimeter BUFR message.
C
                CALL READERME  ( ibull, iubfme, bfstin, ibfdt, ierrme )
                IF  ( ierrme .ne. 0 )  THEN
                    bullok = .false.
		END IF
	    END IF
            IF  ( bullok )  THEN
C
                corn = FLOAT ( IUPBS01 ( ibull, 'USN' ) )
                IF ( corn .gt. 0.0 ) corn = 1.0
C
C*              Check the contents of Section 3 of the message to
C*		determine the data type.
C
		CALL UPDS3 ( ibull, MXDSC, cdesc, ndesc )
		IF ( ( ndesc .eq. 1 ) .and.
     +			( cdesc(1)(1:6) .eq. '340010' ) ) THEN
                    bfstot = 'NC031115'
		    satstg = 'JASON-2 '
		    idxyear = 8
                    nr8in = 104
		ELSE IF ( ( ndesc .eq. 1 ) .and.
     +			( cdesc(1)(1:6) .eq. '340011' ) ) THEN
                    bfstot = 'NC031122'
		    satstg = 'SARALATK'
		    idxyear = 8
                    nr8in = 78 
		ELSE IF ( ( ndesc .eq. 1 ) .and.
     +			( cdesc(1)(1:6) .eq. '312071' ) ) THEN
                    bfstot = 'NC031123'
		    satstg = 'CRYOST-2'
		    idxyear = 11
                    nr8in = 118 
		ELSE IF ( ( ndesc .eq. 1 ) .and.
     +			( cdesc(1)(1:6) .eq. '340017' ) ) THEN
                    bfstot = 'NC031134'
		    satstg = 'SNTNL-3A'
		    idxyear = 12
                    nr8in = 846 
		ELSE
                    bullok = .false.
                    logmsg = 'message contains unknown descriptors:'
                    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
            DO WHILE ( bullok )
C
C*              Get the next report from this altimeter BUFR message.
C
                IF  ( IREADSB ( iubfme ) .ne. 0 )  THEN
C
C*                  There are no more reports in this message.
C
                    bullok = .false.
C
C*                  Print a count of the number of reports processed.
C
                    WRITE ( UNIT = logmsg, FMT = '( 3A, I4, A )' )
     +                  'found ', satstg, ' BUFR message with ',
     +			nrept, ' reports'
                    CALL DC_WLOG  ( 2, 'DC', 2, logmsg, ierwlg )
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, 'altm', 1, ierwbf )
                ELSE
                    nrept = nrept + 1
C
C*                  Read all of the data values from this report.
C
                    CALL UFBSEQ  ( iubfme, r8ary, MXVAL, 1, ierusq,
     +                             bfstin )
		    CALL READLC  ( iubfme, cstaq, 'STAQ' )
		    CALL READLC  ( iubfme, csoftv, 'SOFTV' )
		    IF ( ( satstg(1:5) .eq. 'JASON' ) .or.
     +                   ( satstg(1:5) .eq. 'SARAL' ) )
     +			CALL READLC  ( iubfme, cnumid, 'NUMID' )
		    IF ( ( satstg(1:5) .eq. 'CRYOS' ) .or.
     +                   ( satstg(1:5) .eq. 'SNTNL' ) )
     +                  CALL UT_BFCI ( iubfme, 'PCID', cpcid, ier )
		    IF ( bfstot .eq. 'NC031115' ) THEN
			isaid = IDNINT( r8ary(1) )
			IF ( isaid .eq. 262 ) THEN
			  bfstot = 'NC031124'
			  satstg(7:7) = '3'
			END IF
		    ELSE IF ( bfstot .eq. 'NC031134' ) THEN
			isaid = IDNINT( r8ary(1) )
			IF ( isaid .eq. 65 ) THEN
			  bfstot = 'NC031135'
		          satstg(8:8) = 'B'
			END IF
		    END IF
C
C*		    Append the bulletin header, receipt time and
C*		    correction indicator to the end of the data
C*		    values array.
C
		    CALL UT_C2R8 ( seqnum, 8, r8ary(nr8in+1), nr8, ier )
		    CALL UT_C2R8 ( buhd,   8, r8ary(nr8in+2), nr8, ier )
		    CALL UT_C2R8 ( cborg,  8, r8ary(nr8in+3), nr8, ier )
		    CALL UT_C2R8 ( bulldt, 8, r8ary(nr8in+4), nr8, ier )
		    CALL UT_C2R8 ( bbb,    8, r8ary(nr8in+5), nr8, ier )
                    r8ary ( nr8in +  6 ) = FLOAT ( 0 )
                    r8ary ( nr8in +  7 ) = FLOAT ( irundt (1) )
                    r8ary ( nr8in +  8 ) = FLOAT ( irundt (2) )
                    r8ary ( nr8in +  9 ) = FLOAT ( irundt (3) )
                    r8ary ( nr8in + 10 ) = FLOAT ( irundt (4) )
                    r8ary ( nr8in + 11 ) = FLOAT ( irundt (5) )
                    r8ary ( nr8in + 12 ) = corn 
                    nr8ot = nr8in + 12 
C
C*                  Do not create BUFR output for reports that are
C*                  more than NHOURS before or more than 3 hours
C*                  after the run time.
C
                    rptyr = UT_BMRI ( r8ary (idxyear) )
                    rptmo = UT_BMRI ( r8ary (idxyear+1) )
                    rptdy = UT_BMRI ( r8ary (idxyear+2) )
                    rpthr = UT_BMRI ( r8ary (idxyear+3) )
                    rptmi = UT_BMRI ( r8ary (idxyear+4) )
                    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, bfstot, ibfdt )
C
C*                      Write all of the data values for this report.
C
                        CALL UFBSEQ  ( iubfmn, r8ary, nr8ot, 1, ierusq,
     +                                 bfstot )
		        IF ( ( satstg(1:5) .eq. 'CRYOS' ) .or.
     +                       ( satstg(1:5) .eq. 'SNTNL' ) ) THEN
			  CALL AT_CKST ( cpcid )
                          CALL UT_CIBF ( iubfmn, 'PCID', cpcid, 6, ier )
                        END IF
                        CALL UT_WBFR ( iubfmn, 'altm', 0, ierwbf )
			CALL AT_CKST ( cstaq )
			CALL WRITLC ( iubfmn, cstaq, 'STAQ' )
			CALL AT_CKST ( csoftv )
			CALL WRITLC ( iubfmn, csoftv, 'SOFTV' )
                        IF ( ( satstg(1:5) .eq. 'JASON' ) .or.
     +                       ( satstg(1:5) .eq. 'SARAL' ) ) THEN
			  CALL AT_CKST ( cnumid )
			  CALL WRITLC ( iubfmn, cnumid, 'NUMID' )
			END IF
                    END IF
                END IF
            END DO
        END DO
C*
        RETURN
        END