SUBROUTINE BT_TSC4 ( lenrpt, report, istrs2, iret ) C************************************************************************ C* BT_TSC4 * C* * C* This subroutine decodes the 1ZZZZ total water depth group in * C* section 4 of the tesac report. * C* * C* BT_TSC4 ( LENRPT, REPORT, ISTRS2, IRET ) * C* * C* Input parameters: * C* LENRPT INTEGER Length of report minus section 5* C* REPORT CHAR* Report array * C* ISTRS2 INTEGER Pointer set to start of sect 2 * C* 888k(1)k(2) group * C* Output parameters: * C* LENRPT INTEGER Length of report through * C* section 3 * C* RIVALS(IRTOWD) REAL Total water depth in meters * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C* * C** * C* Log: * C* R. Hollern/NCEP 01/99 * C************************************************************************ INCLUDE 'btcmn.cmn' C* CHARACTER*(*) report C* CHARACTER fld1*1, fld4*4 C------------------------------------------------------------------------ iret = 0 ip = istrs2 C ii = index ( report(ip:lenrpt), '55555' ) C IF ( ii .eq. 0 ) THEN C C* No section 4 data. C RETURN END IF C lenrpt = ip + ii - 2 ip = ip + ii + 5 C C* Get the group indicator C fld1 = report ( ip:ip ) C IF ( fld1 .eq. '1' ) THEN C C* Total water depth in meters. C ip = ip + 1 fld4 = report ( ip:ip+3 ) ip = ip + 5 CALL ST_INTG ( fld4, ival, ier ) IF ( ier .eq. 0 ) THEN rivals ( irtowd ) = FLOAT ( ival ) END IF END IF C* RETURN END