SUBROUTINE TG_SC2B ( kray, mxrpt, mxrptsz, mxdatv,
     +                       expdesc, nmrpts, lenrpts, nmdatval,
     +                       dataval, nr, iret )
C************************************************************************
C* TG_SC2B                                                              *
C*                                                                      *
C* This subroutine gets the sea surface temperature group, the automated*
C* and manual water level check groups, and the time displacement and	*
C* the short time increment groups from the arrays holding the decoded	*
C* Section 2 data and stores these data into the interface arrays.	*
C*                                                                      *
C*                                                                      *
C* TG_SC2B ( KRAY, MXRPT, MXRPTSZ, MXDATV, EXPDESC, NMRPTS, LENRPTS, 	*
C*           NMDATVAL, DATAVAL, NR, IRET )				*
C*                                                                      *
C* INPUT PARAMETERS:                                                    *
C*	KRAY ( MXDATV)	INTGEGER	Array locations indicate which	*
C*					descriptors in expdesc have	*
C*					already been processed		*
C*	MXNDESC		INTEGER		Maximum number of descriptors	*
C*					expected in Section 1 of msg	*
C*	MXRPTSZ		INTEGER		Maximum report size expected	*
C*	MXRPT		INTEGER		Maximum number of reports	*
C*					expected in message		*
C*	MXDATV		REAL		Maximum number of data values	*
C*					expected in report 		*
C*	EXPDESC	(MXDATV)						*
C*			CHAR*		List of descriptors which are	*
C*				        close to a one-to-one		*
C*				        correspondece with the data	*
C*					values in dataval array		*
C*									*
C*	NMRPTS		INTEGER		Number of reports in CREX msg	*
C*									*
C*	LENRPTS (NMRPTS)						*
C*	                INTEGER		Array to store the length of	*
C*					each report			* 
C*                                                                      *
C*	NMDATVAL	INTEGER		Number of data values in	*
C*					Section 2 of CREX message	*
C*									*
C*	DATAVAL (MXRPT,MXDATV)						*
C*			INTEGER		Array to hold the Section 2	*
C*					decoded data values		*
C*	NR		INTEGER		Pointer to where to get the data*
C*					in arrays for current report	*
C*									*
C* OUTPUT PARAMETERS:                                                   *
C*	RIVALS(IRSSTK)	REAL		Sea surface temperature in deg K*
C*	RIVALS(IRAWCK)	REAL		Tide station automated water	*
C*					level check			*
C*	RIVALS(IRMWCK)	REAL		Tide stn manual water level chk	*
C*	RIVALS(IRTIMI)	REAL		Time displacement in minutes	*
C*	RIVALS(IRSTMI)	REAL		Short time increment in minutes	*
C*	IRET		INTEGER		Return code			*
C*					0 = Normal return		*
C*					1 = Problems			*
C*                                                                      *
C**                                                                     *
C* Log:                                                                 *
C* R. Hollern/NCEP	8/00						*
C* J. Ator/NCEP		8/13	If B04025 is missing, check for B04075.	*
C************************************************************************
        INCLUDE 	'tgcmn.cmn'
C* 
        REAL*8    	dataval ( mxrpt, mxdatv )
C*
        INTEGER   	lenrpts ( mxrpt )
        INTEGER   	kray ( mxdatv )
C*
        CHARACTER       expdesc ( mxdatv )*6
C*
        REAL            rval
        INTEGER         ival
        CHARACTER       cval*8,  misng*8
        CHARACTER   	mdescr*6
C*
	DATA  misng / '////////' /
C------------------------------------------------------------------------
        iret = 0
	irepflg = 0
C
C*      Table B units for parameters are numeric.
C
        idatty = 0
C
C*      Get the sea/water temperature in Kelvin.
C
        mdescr = 'B22042'
C
        CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +                mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +                dataval, idatty, rval, cval, iret )
C
        IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN
           rivals(irsstk) =  rval
	END IF
C
C*      Get the tide station automated water level check data.
C
        mdescr = 'B22120'
C
        CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +                mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +                dataval, idatty, rval, cval, iret )
C
        IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN
            rivals(irawck) = rval
        END IF
C
C*      Get the tide station manual water level check data.
C
        mdescr = 'B22121'
C
        CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +                mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +                dataval, idatty, rval, cval, iret )
C
        IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN
            rivals(irmwck) = rval
        END IF
C
C*      Get the (short) time period or displacement.
C
C*      NOTE: In the data corresponding to sequence D06020 (subsequence
C*	      of D06024), the initial time offset is reported using 4
C*	      characters, even though it should only be 2 characters
C*	      according to B04075.  To get around this problem, D06020
C*	      is defined in our local Table D as containing B04025
C*	      instead of B04075.
C
        mdescr = 'B04025'
C
        CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +                mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +                dataval, idatty, rval, cval, iret )
C
        IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN
            rivals(irtpmi) = rval
	ELSE
C
C*      NOTE: In the data corresponding to sequence D06019 (subsequence
C*	      of D06025), the initial time offset is reported using 2
C*	      characters.  This is correct because a C01002 operator is
C*	      included in D06019, but our CREX decoder doesn't honor
C*	      this operator.  So to get around this problem, D06019 is
C*	      defined in our local Table D as containing B04075 instead
C*	      of B04015.
C
	    mdescr = 'B04075'
	    CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +			  mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +			  dataval, idatty, rval, cval, iret )
            IF ( iret .eq. 0 .AND. cval .ne. misng )
     +		rivals(irtpmi) = rval
        END IF
C
C*      Get the short time increment.          
C
        mdescr = 'B04065'
C
        CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, 
     +                mxrptsz, mxdatv, nmrpts, expdesc, nmdatval,
     +                dataval, idatty, rval, cval, iret )
C
        IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN
            rivals(irstmi) = rval
        END IF
C*
	RETURN
	END