SUBROUTINE DB_S4BD ( dburpt, ipt, iret ) C************************************************************************ C* DB_S4BD * C* * C* This subroutine decodes the drifting buoy section 4 group * C* 5B(t)B(t)X(t)X(t) This group gives the buoy type and drogue type. * C* * C* DB_S4BD ( DBURPT, IPT, IRET ) * C* * C* Input parameters: * C* DBURPT CHAR* Report array * C* * C* Input and Output parameters: * C* IPT INTEGER On input, points to a character* C* in group preceding the group * C* 5BtBtXtXt. On output, points to* C* first of last two characters * C* decoded. * C* * C* Output parameters passed via common: * C* RIVALS(IRBUYT) REAL Buoy type. * C* RIVALS(IRDROT) REAL Drogue type. * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C** * C* Log: * C* R. Hollern/NCEP 12/99 * C* C. Caruso Magee/NCEP 03/2000 Fixed docblock comments. * C* C. Caruso Magee/NCEP 07/2001 New subroutine to decode Section 4 * C* group 5 * C************************************************************************ INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) dburpt C* CHARACTER fld1*2, fld2*2 C------------------------------------------------------------------------ iret = 0 C ipt = ipt + 2 C C* Get buoy type. C fld1 = dburpt ( ipt:ipt+1 ) IF ( fld1 .ne. '//' ) THEN CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( irbuyt) = FLOAT ( ival ) ELSE iret = 1 RETURN END IF END IF C C* Get drogue type. C ipt = ipt + 2 C fld2 = dburpt ( ipt:ipt+1 ) IF ( fld2 .ne. '//' ) THEN CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( irdrot) = FLOAT ( ival ) ELSE iret = 1 RETURN END IF END IF C RETURN END