SUBROUTINE DB_S4PL ( dburpt, ipt, iret ) C************************************************************************ C* DB_S4PL * C* * C* This subroutine decodes the drifting buoy section 4 groups * C* 3Z(h)Z(h)Z(h)Z(h) 4Z(c)Z(c)Z(c)Z(c). These groups give the hydro- * C* static pressure at the lower end of the cable (1000 Pa) and the * C* length of the cable in meters (thermistor string). * C* * C* DB_S4PL ( 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* 3ZhZhZhZh. On output, points to* C* first of last two characters * C* decoded. * C* * C* Output parameters passed via common: * C* RIVALS(IRHPLE) REAL Hydrostatic pressure at lower * C* end of cable (units of 1000 * C* Pa (centibars)). * C* RIVALS(IRCALT) REAL Length of cable in meters * C* (thermistor string). * 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* groups 3 and 4. Use ircalt for length * C* of cable (thermistor string). * C************************************************************************ INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) dburpt C* CHARACTER fld1*4, fld2*4 C------------------------------------------------------------------------ iret = 0 C ipt = ipt + 2 C C* Get hydrostatic pressure at lower end of cable. C fld1 = dburpt ( ipt:ipt+3 ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( irhple) = FLOAT ( ival ) ELSE iret = 1 RETURN END IF C C* Get length of cable in meters (thermistor string). C* NOTE: this is different from rivals (irdrod), which is the C* length of the cable (in meters) at which the drogue is attached. C ipt = ipt + 4 C IF ( dburpt (ipt:ipt+1) .eq. ' 4' ) THEN ipt = ipt + 2 fld2 = dburpt ( ipt:ipt+3 ) CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( ircalt) = FLOAT ( ival ) ipt = ipt + 2 ELSE iret = 1 RETURN END IF ELSE ipt = ipt - 2 END IF C RETURN END