SUBROUTINE  LS_CLD4 (  lsfrpt, ipt, iret )
C************************************************************************
C* LS_CLD4                                                              *
C*                                                                      *
C* This subroutine decodes the section 4 cloud groups N'C'H'H'C(t).     *
C* This group contains the amount of cloud whose base is below the level*
C* of the station, the genus of cloud whose base is below the level of  *
C* the station, the altitude of the upper surface of clouds reported by *
C* C', in hundreds of meters, and the description of the top of cloud   *
C* whose base is below the level of the station.                        *
C*                                                                      *
C* LS_CLD4  ( LSFRPT, IPT, IRET )                                       *
C*                                                                      *
C* Input parameters:                                                    *
C*      LSFRPT          CHAR*           Report array                    *
C*      IPT             INTEGER         Pointer to start of cloud group *
C*                                                                      *
C* Input and Output parameters:                                         *
C*	IPT		INTEGER		On input, points to N' in cloud *
C*                                      group; on output, points to     *
C*                                      C(t)                            *
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 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(IRCTDS)  REAL		Description of top of cloud as  *
C*                                      defined in FM94 BUFR Table      *
C*                                      0 20 017                        *
C*	RIVALS(IRHOCT)  REAL            Altitude of upper surface of    *
C*                                      clouds reported by C'           *
C*      RIVALS(IRCSEC)  REAL		Section number in FM12 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      8/99                                            *
C* R. Hollern/NCEP      1/00    Modified to use simplified cloud        *
C*                              interface variable set                  *
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*      Determine where to store section 4 cloud data in interface 
C*      arrays.
C
        lvl = 0
        xly = rivals ( irnclo ) 
C
        IF ( xly .gt. 0.0 .and. xly .lt. 9.0 ) THEN
            lvl = xly + .5
        END IF
C
        lvl = lvl + 1
C
C*      Get cloud amount whose base is below the level of the station,
C*      referencing WMO Code Table 2700.
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
        END IF
C
C*      Get genus of cloud whose base is below the level of the station,
C*      referencing WMO code table 500.
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 ( ircltp ( lvl ) ) = FLOAT ( ival )
                rivals ( irvsso ( lvl ) ) = yverts ( ival )
C
C*              Check to see if it is a cumulonimbus layer.
C
                IF ( ival .eq. 9 ) THEN
                    rivals ( irvsso ( lvl ) ) = 4.0
                END IF
            END IF
        END IF
C
C*      Get altitude of the upper surface of clouds in hundreds
C*      of meters.
C
        ipt = ipt + 1
        fld2 = lsfrpt ( ipt:ipt+1 )
        IF ( fld2 .ne. '//' ) THEN
            CALL  ST_INTG ( fld2, ival, ier )
            IF ( ier .eq. 0 ) THEN
                xval = 100. * FLOAT ( ival )
                rivals ( irhoct ( lvl ) ) = xval
            END IF
        END IF
C
C*      Get description of the top of cloud whose base is
C*      below the level of the station, referencing WMO
C*      Code Table 0552.
C
        ipt = ipt + 2
        fld1 = lsfrpt ( ipt:ipt )
        IF ( fld1 .ne. '/' ) THEN
            CALL  ST_INTG ( fld1, ival, ier )
            IF ( ier .eq. 0 ) THEN
                rivals ( irctds ( lvl ) ) =  float ( ival )
            END IF
        END IF
C
C*      FM12 report section.
C
        rivals ( ircsec ( lvl ) ) =  4.0
        
C*      Get number of cloud layers.
C
        rivals ( irnclo ) = lvl
C*
        RETURN
        END