SUBROUTINE LS_CLD3 ( lsfrpt, lvl, ipt, iret )
C************************************************************************
C* LS_CLD3 *
C* *
C* This subroutine decodes the section 3 cloud group 8N(s)Ch(s)h(s). *
C* This group contains the height of the base of the cloud, the cloud *
C* type, and the height of the cloud. *
C* *
C* LS_CLD3 ( LSFRPT, LVL, IPT, IRET ) *
C* *
C* Input parameters: *
C* LSFRPT CHAR* Report array *
C* LVL REAL Subscript for indicating cloud *
C* layer *
C* *
C* Input and Output parameters: *
C* IPT INTEGER On input, points to 'N' in 8NChh*
C* group; on output, to last 'h' *
C* *
C* Output parameters: *
C* RIVALS(IRNCLO) REAL Number of layers of cloud data *
C* in sections 1 and 3 *
C* RIVALS(IRVSSO) REAL Vertical significance as defined*
C* in FM94 BUFR Table 0 08 002 *
C* RIVALS(IRCLAM) REAL Cloud amount in oktas as defined*
C* in FM94 BUFR Table 0 20 011 *
C* RIVALS(IRCLTP) REAL Cloud type as defined in FM94 *
C* BUFR Table 0 20 012 *
C* RIVALS(IRHOCB) REAL Cloud height in meters *
C* RIVALS(IRCSEC) REAL Section number in FM13 report *
C* of location of cloud data *
C* RIVALS(IRVRTM) REAL Vertical visibility in meters *
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 8/96 Added check on number of cloud levels *
C* R. Hollern/NCEP 12/96 Replaced ST_C2R with ST_INTG *
C* R. Hollern/NCEP 1/98 Changes based on MA_CLDS *
C* A. Hardy/GSC 1/98 Reordered calling sequence *
C* R. Hollern/NCEP 8/99 Added vertical visibility logic *
C* R. Hollern/NCEP 1/00 Renamed routine to CLD3; modified to use*
C* simplified cloud interface array set *
C* C. Caruso Magee/NCEP 1/02 Fix error in setting of rivals(ircltp) *
C* for cloud type = '/'. Was erroneously *
C* setting rivals(irvsso) to 59 instead of *
C* setting rivals(ircltp) to 59. *
C* C. Caruso Magee/NCEP 1/02 Replace code which sets hght of base of *
C* clouds (or vert. vis) w/ new function *
C* PR_HCDM. *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'lscmn.cmn'
C*
CHARACTER*(*) lsfrpt
C*
CHARACTER fld2*2, fld1*1
REAL yverts(0:9)
C*
C* Vertical significance from WMO BUFR table 0 08 002
C*
DATA yverts / 9., 9., 9., 8., 8., 8., 7., 7., 7., 4. /
C------------------------------------------------------------------------
iret = 0
C
C* Number of cloud layers decoded in sections 1 and 3.
C
rivals ( irnclo ) = FLOAT ( LVL )
C
C* Define the section in report of location of these cloud data.
C
rivals ( ircsec ( lvl ) ) = 3.
C
C* Get cloud amount.
C
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt ( ipt:ipt )
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( irclam ( lvl ) ) = FLOAT ( ival )
END IF
ELSE
C
C* Cloud amount is indiscernible.
C* Set to 15.0 (see WMO BUFR table 0 02 011).
C
rivals ( irclam ( lvl ) ) = 15.
END IF
C
C* Get cloud type.
C
ipt = ipt + 1
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt ( ipt:ipt )
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( irvsso ( lvl ) ) = yverts ( ival )
rivals ( ircltp ( lvl ) ) = FLOAT ( ival )
C
C* Check to see if it is a cumulonimbus layer.
C* If so, set to 4 (see WMO BUFR table 0 08 002).
C
IF ( ival .eq. 9 ) THEN
rivals ( irvsso ( lvl ) ) = 4.0
END IF
END IF
ELSE
C
C* Clouds are not visible because of darkness, fog, etc.
C* Set type to 59 (see WMO BUFR table 0 20 012).
C
rivals ( ircltp ( lvl ) ) = 59.
END IF
C
C* Get height of base of cloud in meters. See WMO code table 1677.
C
ipt = ipt + 1
fld2 = lsfrpt ( ipt:ipt+1 )
IF ( fld2 .ne. '//' ) THEN
IF ( lsfrpt ( ipt-2:ipt-2) .eq. '9' ) THEN
C
C* The sky is obscured, and hence, the h(s)h(s) is
C* the vertical visibility in meters.
C
rivals ( irvrtm ) = PR_HCDM ( fld2 )
ELSE
rivals ( irhocb ( lvl ) ) = PR_HCDM ( fld2 )
END IF
END IF
C
ipt = ipt + 1
C*
RETURN
END