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