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