SUBROUTINE DB_TEMP ( dburpt, iparam, ipt, iret ) C************************************************************************ C* DB_TEMP * C* * C* This subroutine decodes the air temperature group 1sTTT, the dew * C* point temperature group 2sTTT, and the sea surface temperature group * C* 0sTTT, and saves the temperature in the appropriate units. * C* * C* DB_TEMP ( DBURPT, IPARAM, IPT, IRET ) * C* * C* Input parameters: * C* DBURPT CHAR* Report array * C* IPARAM INTEGER Flag value * C* = 1 - air temp * C* = 2 - dew point * C* = 3 - sea surface temp * C* * C* Input and Output parameters: * C* IPT INTEGER On input, points to s in nsTTT * C* group; on output, points to * C* last T in group * C* * C* Output parameters: * C* RIVALS(IRTMPC) REAL Air temperature, degrees C * C* RIVALS(IRDWPC) REAL Dew point temperature, degrees C* C* RIVALS(IRSSTC) REAL Sea surface temp, degrees C * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C* * C** * C* Log: * C* R. Hollern/NCEP 12/99 * C* R. Hollern/NCEP 07/02 Removed msst reference * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'dbcmn.cmn' C* CHARACTER*(*) dburpt C* CHARACTER fld3*3, fld1*1 C------------------------------------------------------------------------ iret = 0 C C* Get sign of air temperature, dew point temp, maximum temp, C* or minimum temp. C IF ( iparam .eq. 1 .or. iparam .eq. 2 ) THEN IF ( dburpt ( ipt:ipt ) .eq. '0' ) THEN xsign = 1.0 ELSE IF ( dburpt ( ipt:ipt ) .eq. '1' ) THEN xsign = -1.0 ELSE ipt = ipt + 3 RETURN END IF END IF C C* Get indicator for sign and type of measurement of C* sea-surface temperature. Reference WMO Code Table 3850. C IF ( iparam .eq. 3 ) THEN fld1 = dburpt ( ipt:ipt ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rval = FLOAT ( ival ) IF ( fld1 .eq. '0' .or. fld1 .eq. '2' .or. + fld1 .eq. '4' .or. fld1 .eq. '6' ) THEN xsign = 1.0 ELSE IF ( fld1 .eq. '1' .or. fld1 .eq. '3' .or. + fld1 .eq. '5' .or. fld1 .eq. '7' ) THEN xsign = -1.0 ELSE ipt = ipt + 3 RETURN END IF ELSE ipt = ipt + 3 RETURN END IF END IF C C* Get temperature value. C ipt = ipt + 1 j1 = ipt + 2 IF ( dburpt ( j1:j1 ) .eq. '/' ) dburpt ( j1:j1 ) = '0' fld3 = dburpt ( ipt:ipt+2 ) CALL ST_INTG ( fld3, ival, ier ) ipt = ipt + 2 IF ( ier .eq. 0 ) THEN rval = .1 * xsign * FLOAT ( ival ) ELSE RETURN END IF C IF ( iparam .eq. 1 ) THEN rivals ( irtmpc ) = rval ELSE IF ( iparam .eq. 2 ) THEN rivals ( irdwpc ) = rval ELSE IF ( iparam .eq. 3 ) THEN rivals ( irsstc ) = rval END IF C* RETURN END