SUBROUTINE LS_AST0 ( lszrpt, lsfrpt, yyggi, istarr, ipt, iret ) C************************************************************************ C* LS_AST0 * C* * C* This subroutine gets the block/station ID, the report GMT obs time * C* and the indicator for the source and units of wind speed. * C* * C* LS_AST0 ( LSZRPT, LSFRPT, IAAXX, ISTARR, IPT, IRET ) * C* * C* Input parameters: * C* LSZRPT INTEGER Report size * C* LSFRPT CHAR* Report array * C* YYGGI CHAR* YYGGi(w) group in AAXX line * C* ISTARR (*) INTEGER System time - YYYY,MM,DD,HH,MM * C* * C* Output parameters: * C* CIVALS(ICSTID) CHAR* Report ID * C* RIVALS(IRISWS) REAL Indicator for source and * C* units of wind speed * C* (WMO Code Table 1855) * C* IHOUR INTEGER Hour of observation of report * C* IRPTDT (*) INTEGER Report date-time * C* (YYYY, MM, DD, HH, MM) * C* IPT INTEGER Pointer to start of next group * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C** * C* Log: * C* R. Hollern/NCEP 07/96 * C* R. Hollern/NCEP 09/96 Added RCTS to the receipt time data * C* R. Hollern/NCEP 10/96 Added corrected report indicator logic * C* R. Hollern/NCEP 01/98 Changed interface, LS_RTIM -> DC_RTIM * C* A. Hardy/GSC 01/98 Added GEMINC, cleaned up * C* R. Hollern/NCEP 08/99 Added date/time data to interface array * C* R. Hollern/NCEP 04/00 Removed code to save report correction * C* indicator * C* J. Ator/NCEP 01/02 Remove iuwind, SUWS -> ISWS * C* R. Hollern/NCEP 06/02 Moved decoding of iaaxx data to routine * C* LS_AAXX * C* R. Hollern/NCEP 08/02 Renamed array iaaxx to yyggi * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) lsfrpt, yyggi INTEGER istarr(*) C* CHARACTER stnid*8 LOGICAL more C------------------------------------------------------------------------ iret = 0 more = .true. jp = 0 ip = 0 stnid = ' ' C C* Get block/station ID. C* ip points to start of ID. Locate next space, the end of ID. C DO WHILE ( more ) C ip = ip + 1 IF ( lsfrpt ( ip:ip ) .ne. ' ' ) THEN jp = jp + 1 IF ( jp .lt. 6 ) stnid ( jp:jp ) = lsfrpt ( ip:ip ) ELSE more = .false. END IF C END DO C C* Save report ID. C civals ( icstid ) = stnid C ipt = ip C C* Decode the data in the yyggi array (YYGGi(w) group). C CALL LS_YYGG ( yyggi, istarr, nret ) C IF ( nret .ne. 0 ) THEN ierrno = 3 CALL LS_ERRS ( ierrno, lsfrpt, kret ) iret = 1 RETURN END IF C* RETURN END