SUBROUTINE DB_S4AN ( dburpt, ipt, iret ) C************************************************************************ C* DB_S4AN * C* * C* This subroutine decodes the drifting buoy section 4 group * C* 6A(h)A(h)A(h)A(t) This group gives the anemometer height and 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(IRANHT) REAL Anemometer height (decimeters) * C* RIVALS(IRANTP) REAL Anemometer 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 6 * C************************************************************************ INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) dburpt C* CHARACTER fld1*3, fld2*1 C------------------------------------------------------------------------ iret = 0 C ipt = ipt + 2 C C* Get anemometer height. /// = unknown. 999 = hgt was artificially C* corrected to 10 meters by applying a formula. C fld1 = dburpt ( ipt:ipt+2 ) IF ( fld1 .ne. '///' ) THEN CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( iranht) = FLOAT ( ival ) ELSE iret = 1 RETURN END IF END IF C C* Get anemometer type. / = missing. 0 = cup rotor. 1 = propeller C* rotor. 2 = WOTAN (wind obs thru ambient noise). C ipt = ipt + 3 C fld2 = dburpt ( ipt:ipt ) IF ( fld2 .ne. '/' ) THEN CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN rivals( irantp ) = FLOAT ( ival ) ELSE iret = 1 RETURN END IF END IF C* RETURN END