SUBROUTINE LS_TEMP ( lsfrpt, iparam, ipt, iret ) C************************************************************************ C* LS_TEMP * C* * C* This subroutine decodes the air temperature group 1sTTT, the dew * C* point temperature group 2sTTT, the sea surface temperature group * C* 0sTTT, the wet bulb temperature group 8sTTT, the maximum temperature * C* group 1sT(x)T(x)T(x), or the minimum temperature group * C* 2sT(n)T(n)T(n). The temperature is saved in the appropriate units. * C* IPARAM is the flag for the type of temperature as follows: * C* 1 - air temp * C* 2 - dew point * C* 3 - sea surface temp * C* 4 - wet bulb temp * C* 5 - max temperature * C* 6 - min temperature * C* * C* LS_TEMP ( LSFRPT, IPARAM, IPT, IRET ) * C* * C* Input parameters: * C* LSFRPT CHAR* Report array * C* IPARAM INTEGER Flag value for temperature type * C* IHOUR INTEGER Hour of observation * C* KWMO INTEGER WMO Region number * 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(IRMSST) REAL Indicator for sea surface temp * C* RIVALS(IRSTWC) REAL Indicator for wet bulb temp * 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* RIVALS(IRTMWC) REAL Wet bulb temperature, degrees C * C* RIVALS(IRDTV1) REAL Time period for max temperature * C* RIVALS(IRMXTM) REAL Maximum temperature, degrees C * C* RIVALS(IRDTV2) REAL Time period for min temperature * C* RIVALS(IRMITM) REAL Minimum temperaure, degrees C * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C* * C** * C* Log: * C* R. Hollern/NCEP 6/96 * C* R. Hollern/NCEP 10/96 Added calls to PR_TMCK * C* R. Hollern/NCEP 12/96 Replaced ST_C2R with ST_INTG * C* R. Hollern/NCEP 1/98 Changes based on MA_TEMP * C* A. Hardy/GSC 1/98 Reordered calling sequence,cleaned prolog* C* D. Kidwell/NCEP 3/98 Fixed documentation * C* D. Kidwell/NCEP 5/98 TDXC --> MXTM, TDNC --> MITM, for max/min* C* C. Caruso Magee/NCEP 3/07 Correct indicators for sign of wet-bulb * C* for values 2 and 7 (iced bulb) to * C* negative (were positive previously). * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) lsfrpt C* INTEGER mintbl (4,7), maxtbl (4,7) CHARACTER fld3*3, fld1*1 C* DATA mintbl / 99, 12, 99, 99, + 12, 12, 12, 12, + 99, 99, 12, 99, + 18, 24, 12, 24, + 24, 99, 99, 99, + 99, 12, 99, 99, + 12, 99, 12, 99/ C* DATA maxtbl / 99, 99, 99, 12, + 12, 12, 12, 12, + 12, 99, 99, 99, + 12, 24, 24, 12, + 99, 99, 24, 99, + 99, 99, 99, 12, + 12, 99, 12, 99/ 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 .or. + iparam .eq. 5 .or. iparam .eq. 6 .or. + iparam .eq. 7 ) THEN IF ( lsfrpt ( ipt:ipt ) .eq. '0' ) THEN xsign = 1.0 ELSE IF ( lsfrpt ( 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 = lsfrpt ( 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 rivals ( irmsst ) = rval ELSE ipt = ipt + 3 RETURN END IF END IF C C* Get indicator for sign and type of measurement of C* wet bulb temperature. Reference WMO Code Table 3855. C IF ( iparam .eq. 4 ) THEN fld1 = lsfrpt ( ipt:ipt ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rval = FLOAT ( ival ) IF ( fld1 .eq. '0' .or. fld1 .eq. '5' ) THEN xsign = 1.0 ELSE IF ( fld1 .eq. '1' .or. fld1 .eq. '2' .or. + fld1 .eq. '6' .or. fld1 .eq. '7' ) THEN xsign = -1.0 ELSE ipt = ipt + 3 RETURN END IF rivals ( irstwc ) = rval ELSE ipt = ipt + 3 RETURN END IF END IF C C* Get temperature value. C ipt = ipt + 1 j1 = ipt + 2 IF ( lsfrpt ( j1:j1 ) .eq. '/' ) lsfrpt ( j1:j1 ) = '0' fld3 = lsfrpt ( 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 xtmpk = PR_TMCK ( rval ) rivals ( irtmpc ) = rval ELSE IF ( iparam .eq. 2 ) THEN rivals ( irdwpc ) = rval ELSE IF ( iparam .eq. 3 ) THEN rivals ( irsstc ) = rval ELSE IF ( iparam .eq. 4 ) THEN rivals ( irtmwc ) = rval ELSE IF ( iparam .eq. 5 ) THEN rivals ( irdtv1 ) = RMISSD rivals ( irmxtm ) = rval ELSE IF ( iparam .eq. 6 ) THEN rivals ( irdtv2 ) = RMISSD rivals ( irmitm ) = rval END IF C C* Determine the duration of period for max/min temperatures. C IF ( iparam .eq. 5 .or. iparam .eq. 6 ) THEN C IF ( ihour .ge. 0 .and. ihour .lt. 5 ) THEN ii = 1 ELSE IF ( ihour .eq. 23 ) THEN ii = 1 ELSE IF ( ihour .ge. 5 .and. ihour .lt. 11 ) THEN ii = 2 ELSE IF ( ihour .ge. 11 .and. ihour .lt. 17 ) THEN ii = 3 ELSE IF ( ihour .ge. 17 .and. ihour .lt. 23 ) THEN ii = 4 ELSE RETURN END IF C C* Get WMO Region Number. C If ( kwmo .lt. 1 .or. kwmo .gt. 7 ) RETURN C IF ( iparam .eq. 5 ) THEN C C* Get period of max temperature. C ipr = maxtbl ( ii, kwmo ) IF ( ipr .eq. 99 ) RETURN rivals ( irdtv1 ) = FLOAT ( ipr ) ELSE IF ( iparam .eq. 6 ) THEN C C* Get period of min temperature. C ipr = mintbl ( ii, kwmo ) IF ( ipr .eq. 99 ) RETURN rivals ( irdtv2 ) = FLOAT ( ipr ) END IF END IF C* RETURN END