SUBROUTINE LS_CLD1( lsfrpt, ipt, iret )
C************************************************************************
C* LS_CLD1 *
C* *
C* This subroutine decodes the section 1 cloud group 8N(h)C(L)C(M)C(H). *
C* The height of the lowest cloud level observed is determined from *
C* the three levels. *
C* *
C* LS_CLD1 ( LSFRPT, IPT, IRET ) *
C* *
C* Input parameters: *
C* *
C* LSFRPT CHARACTER Report array *
C* IPT INTEGER Points to 'N' in 8NCCC group *
C* *
C* Input and Output parameters: *
C* IPT INTEGER On input, points to 'N' in 8NCCC*
C* group; on output, to the last C *
C* *
C* Output parameters: *
C* RIVALS(IRNCLO) REAL Number of layers of cloud data *
C* RIVALS(IRVSSO) REAL Vertical significance as defined*
C* in FM94 BUFR Table 0 08 002 *
C* RIVALS(IRCLAM) REAL Cloud amount as defined in FM94 *
C* BUFR Table 0 20 011 *
C* RIVALS(IRCLTP) REAL Cloud type as defined in FM94 *
C* BUFR Table 0 20 012 *
C* RIVALS(IRCSEC) REAL Section number in FM13 report *
C* of location of cloud data *
C* IRET INTEGER Return code *
C* 0 = normal return *
C* 1 = problems *
C* *
C** *
C* Log: *
C* R. Hollern/NCEP 4/96 *
C* R. Hollern/NCEP 12/96 Replaced ST_C2R with ST_INTG *
C* R. Hollern/NCEP 1/98 Changed interface *
C* R. Hollern/NCEP 1/00 Changed cloud interface variable set *
C* C. Caruso Magee/NCEP 01/02 Remove code which was setting *
C* rivals(irhocb). For Sec. 1 clouds, only *
C* the hgt of base of lowest cloud is set *
C* (now in mnemonic HBLC). rivals(irhocb) *
C* is set to missing by default for Sec. 1 *
C* clouds. *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'lscmn.cmn'
C*
CHARACTER*(*) lsfrpt
C*
CHARACTER fld1*1
C------------------------------------------------------------------------
iret = 0
C
IF ( lsfrpt ( ipt:ipt+3 ) .ne. '////' ) THEN
C
C* Define the vertical significance for the cloud data
C* in section 1 of the report.
C
rivals ( irvsso ( 1 ) ) = 7.
rivals ( irvsso ( 2 ) ) = 8.
rivals ( irvsso ( 3 ) ) = 9.
C
C* Indicate the report section of these cloud data.
C
rivals ( ircsec ( 1 ) ) = 1.
rivals ( ircsec ( 2 ) ) = 1.
rivals ( ircsec ( 3 ) ) = 1.
ELSE
ipt = ipt + 3
RETURN
END IF
C
C* Get amount of the low clouds or middle clouds present.
C
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt (ipt:ipt)
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
xcfrl = FLOAT ( ival )
END IF
ELSE
C
C* Cloud amount is indiscernible.
C* Set to 15.0 (see WMO BUFR table 0 20 011).
C
xcfrl = 15.
END IF
C
iflag = 0
C
C* Get low-level cloud type.
C
ipt = ipt + 1
C
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt ( ipt:ipt )
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( ircltp ( 1 ) ) = FLOAT ( ival ) + 30.
IF ( lsfrpt ( ipt:ipt ) .ne. '0' ) THEN
iflag = 1
rivals ( irclam ( 1 ) ) = xcfrl
END IF
END IF
ELSE
C
C* Clouds are invisible owing to darkness, fog, or etc.
C* Set type to 62.0 (see WMO BUFR table 0 20 012).
C
rivals ( ircltp ( 1 ) ) = 62.
END IF
C
C
C* Get middle-level cloud type.
C
ipt = ipt + 1
C
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt ( ipt:ipt )
CALL ST_INTG ( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( ircltp ( 2 ) ) = FLOAT ( ival ) + 20.
IF ( lsfrpt (ipt:ipt) .ne. '0' .and. iflag .eq. 0 ) THEN
iflag = 1
rivals ( irclam ( 2 ) ) = xcfrl
END IF
END IF
ELSE
C
C* Clouds are invisible owing to darkness, fog, or etc.
C* Set type to 61.0 (see WMO BUFR table 0 20 012).
C
rivals ( ircltp ( 2 ) ) = 61.
END IF
C
C* Get high-level cloud type.
C
ipt = ipt + 1
rivals ( irvsso ( 3 ) ) = 9.0
C
IF ( lsfrpt ( ipt:ipt ) .ne. '/' ) THEN
fld1 = lsfrpt ( ipt:ipt )
CALL ST_INTG( fld1, ival, ier )
IF ( ier .eq. 0 ) THEN
rivals ( ircltp ( 3 ) ) = FLOAT ( ival ) + 10.
IF ( lsfrpt (ipt:ipt) .ne. '0' .and. iflag .eq. 0 ) THEN
END IF
END IF
ELSE
C
C* Clouds are invisible owing to darkness, fog, or etc.
C* Set type to 60.0 (see WMO BUFR table 0 20 012).
C
rivals ( ircltp ( 3 ) ) = 60.
END IF
C
C* Store number of layers of cloud data.
C
rivals ( irnclo ) = 3
C*
RETURN
END