SUBROUTINE LS_IIHV ( lsfrpt, ipt, iret ) C************************************************************************ C* LS_IIHV * C* * C* This subroutine decodes the precipitation indicator, the type * C* of station (manned or automatic) and WX indicator, the base of the * C* lowest cloud, and the horizontal surface visibility. * C* * C* LS_IIHV ( LSFRPT, IPT, IRET ) * C* * C* Input parameters: * C* LSFRPT CHAR* Report array * C* * C* Input and Output parameters: * C* IPT INTEGER On input, points to start of * C* i(R)i(X)hVV group; on output, * C* points to space before next * C* group in lsfrpt * C* * C* Output parameters: * C* IPREC INTEGER Indicator for inclusion or * C* omission of precip data * C* IXIND INTEGER Indicator for type of station * C* operation and WX data * C* RIVALS(IRINPC) REAL Precipitation indicator * C* RIVALS(IRITSO) REAL Type of station operation * C* RIVALS(IRTOST) REAL Manned or automatic station * C* RIVALS(IRHBLC) REAL Height of base of lowest cloud * C* RIVALS(IRVSBK) REAL Horizontal visibility, km * 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 1/98 Changes based on MA_IIHV * C* A. Hardy/GSC 1/98 Reordered calling sequence,cleaned up * C* R. Hollern/NCEP 2/98 Changed check on minimum size of sec 1 * C* R. Hollern/NCEP 8/99 Modified station indicator logic * C* R. Hollern/NCEP 1/00 Removed cloud base height interface var * C* C. Caruso Magee/NCEP 1/02 Adding hblc to represent height of * C* lowest cloud base. Using actual code * C* table 1600 values for hblc, and removing* C* cloudh array (which set hgt of cloud * C* base using midpoint of code table 1600 * C* ranges). * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) lsfrpt C* REAL hvis(0:99) INTEGER ivv(0:99) CHARACTER fld2*2, fld1*1 C* C* Horizontal visibility in meters at surface. Code Table 4377. C* DATA ivv / 0, 100, 200, 300, 400, 500, 600 , 700, + 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, + 1700, 1800, 1900, 2000, 2100, 2200, 2300, 2400, 2500, + 2600, 2700, 2800, 2900, 3000, 3100, 3200, 3300, 3400, + 3500, 3600, 3700, 3800, 3900, 4000, 4100, 4200, 4300, + 4400, 4500, 4600, 4700, 4800, 4900, 5000, -9999, -9999, + -9999, -9999, -9999, 6000, 7000, 8000, 9000, 10000, 11000, + 12000, 13000, 14000, 15000, 16000, 17000, 18000, 19000, 20000, + 21000, 22000, 23000, 24000, 25000, 26000, 27000, 28000, 29000, + 30000, 35000, 40000, 45000, 50000, 55000, 60000, 65000, 70000, + 71000, 0, 50, 200, 500, 1000, 2000, 4000, 10000, + 20000, 50000 / C* C* Horizontal visibility in km at surface. Code Table 4377. C* DATA hvis / 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, + 0.8, 0.9, 1.0, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, + 1.8, 1.9, 2.0, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, + 2.8, 2.9, 3.0, 3.1, 3.2, 3.3, 3.4, 3.5, 3.6, 3.7, + 3.8, 3.9, 4.0, 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, + 4.8, 4.9, 5.0, -9999., -9999., -9999., -9999., -9999., + 6.0, 7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., + 16., 17., 18., 19., 20., 21., 22., 23., 24., 25., + 26., 27., 28., 29., 30., 35., 40., 45., 50., 55., + 60., 65., 70., 71., 0.0, .05, 0.2, 0.5, 1.0, 2.0, + 4.0, 10., 20., 50. / C------------------------------------------------------------------------ iret = 0 C C* There is at most one space before start of group. C IF ( lsfrpt (ipt:ipt) .eq. ' ' ) ipt = ipt + 1 C C* Check that length of section 1 is large enough. C IF ( lsec1 .lt. 11 ) THEN iret = 1 RETURN END IF C C* Get indicator for inclusion or omission of precipitation data. C fld1 = lsfrpt ( ipt:ipt ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN iprec = ival rivals ( irinpc ) = FLOAT ( iprec ) IF ( iprec .eq. 3 ) THEN C C* The 6RRRt group is omitted, but precip amount is 0.0. C iparam = 0 CALL LS_PREC ( lsfrpt, iparam, ipt, jret ) END IF END IF C C* Get indicator for type of station operation (manned or C* automatic) and for present and past weather data (WMO C* Code Table 1860). C ipt = ipt + 1 fld1 = lsfrpt ( ipt:ipt ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN ixind = ival rivals ( iritso ) = FLOAT ( ixind ) C IF ( ixind .ge. 1 .and. ixind .le. 3 ) THEN C C* It is a manned station. C rivals ( irtost ) = 1.0 ELSE IF ( ixind .ge. 4 .and. ixind .le. 7 ) THEN C C* It is an automatic station. C rivals ( irtost ) = 0.0 END IF END IF C C* Get WMO Code Table 1600 value for height in meters of the C* base of the lowest cloud. If '/' was encoded, set hblc to C* value of 14 (see local BUFR table 0 20 201). C* ipt = ipt + 1 fld1 = lsfrpt ( ipt:ipt ) IF ( fld1 .ne. '/' ) THEN CALL ST_INTG ( fld1, ival, ier ) IF ( ier .eq. 0 ) THEN rivals ( irhblc ) = FLOAT ( ival ) END IF ELSEIF ( fld1 .eq. '/' ) THEN rivals ( irhblc ) = 14.0 END IF C C* Get horizontal visibility in kilometers. C ipt = ipt + 1 IF ( lsfrpt ( ipt:ipt ) .ne. '/' .and. + lsfrpt ( ipt+1:ipt+1 ) .ne. '/' ) THEN fld2 = lsfrpt ( ipt:ipt+1 ) CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN IF ( .not. ( ival .ge. 51 .and. ival .le. 55 ) ) + rivals ( irvsbk ) = hvis ( ival ) END IF END IF C ipt = ipt + 2 C* RETURN END