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