SUBROUTINE DB_PRES ( dburpt, iparam, ipt, iret ) C************************************************************************ C* DB_PRES * C* * C* This subroutine decodes the station pressure group 3P(0)P(0)P(0)P(0),* C* if IPARAM is 0, or the mean sea level pressure group 4PPPP, if IPARAM* C* is 1. * C* * C* DB_PRES ( DBURPT, IPARAM, IPT, IRET ) * C* * C* Input parameters: * C* DBURPT CHAR* Report array * C* IPARAM INTEGER Flag value for group type * C* * C* Input and Output parameters: * C* IPT INTEGER On input, points to first P in * C* group nPPPP; on output, points * C* to last P * C* * C* Output parameters passed via common: * C* RIVALS(IRPRES) REAL Station pressure in mb * C* RIVALS(IRPMSL) REAL Mean sea level pressure in mb * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C* * C** * C* Log: * C* R. Hollern/NCEP 12/99 * C* C. Caruso Magee/NCEP 03/2000 fixed docblock comments. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) dburpt C* CHARACTER fld4*4 C------------------------------------------------------------------------ iret = 0 C C* Check for missing value. C IF ( dburpt (ipt:ipt+3) .eq. '////' ) THEN ipt = ipt + 3 RETURN END IF C IF ( dburpt (ipt+3:ipt+3) .eq. '/' ) + dburpt (ipt+3:ipt+3) = '0' C C* Get pressure value. C fld4 = dburpt (ipt:ipt+3) CALL ST_INTG ( fld4, ival, ier ) IF ( ier .eq. 0 ) THEN ipt = ipt + 3 xp = .1 * FLOAT ( ival ) IF ( xp .lt. 100. ) xp = 1000. + xp ELSE ipt = ipt + 1 RETURN END IF C C* Determine which type of pressure value to store. C IF ( iparam .eq. 0 ) THEN rivals ( irpres ) = xp ELSE IF ( iparam .eq. 1 ) THEN rivals ( irpmsl ) = xp END IF C* RETURN END