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