SUBROUTINE LRSCAN
C** LONG RANGE SCAN
       COMMON /QUAD/IQAD(8,8),IQX,IQY
       COMMON/GENDTA/SDATE,COND(2),KLING,TMLEFT,ITORP,ENERGY,SHELDS
        COMMON /DAMAGS/IRPARS(10,2),IRAND,IRATE,IDMGD,TSTRT,GTIME
       COMMON /GALAX/IGALX(8,8)
       DIMENSION IXS(3),IYS(3)
       EQUIVALENCE (I1,IXS(1)),(I2,IXS(2)),(I3,IXS(3))
       IF(IRPARS(5,1) .LE. 0)GO TO 19
       TYPE *,'**L.R. SENSORS DAMAGED - NO REPORT AVAILABLE.'
       GO TO 999
C** LOAD LOCATIONS
19    IXST = IQX -1
       IYST = IQY -1
       IF(IXST .LE. 0)IXST=8 + IXST
       IF(IYST .LE. 0)IYST=8 + IYST
       DO 10 I=1,3
       IXS(I)=IXST
       IYS(I)=IYST
       IXST=IXST+1
       IYST=IYST+1
       IF(IXST .GT. 8)IXST= IXST - 8
       IF(IYST .GT. 8)IYST= IYST - 8
 10    CONTINUE
C** WRITE HEADER
       TYPE *,' LONG RANGE SCAN'
       TYPE 1001,IXS
 1001  FORMAT(7X,3(' -- ',I1),' --')
       DO 100 I=1,3
       ISUB = IYS(I)
       TYPE 1002,ISUB,IQAD(I1,ISUB),IQAD(I2,ISUB),IQAD(I3,ISUB),ISUB
 1002  FORMAT(6X,I2,':',3(1X,I3,1X),':',I2)
C** UPDATE GALACTIC RECORD; CHECK IF ALREADY UPDATED
       IF(IGALX(I1,ISUB) .LT. 100)IGALX(I1,ISUB) = IQAD(I1,ISUB)
       IF(IGALX(I2,ISUB) .LT. 100)IGALX(I2,ISUB) = IQAD(I2,ISUB)
       IF(IGALX(I3,ISUB) .LT. 100)IGALX(I3,ISUB) = IQAD(I3,ISUB)
 100   CONTINUE
C** RESET CONDITION
        IF(COND(1) .EQ. 'DOCK')GO TO 999
        COND(1) = 'GREE'
        COND(2) = 'N   '
       DO 90 K=1,3
       J1=IYS(K)
       J2=IXS(K)
       IF(IQAD(J2,J1) .LT. 100)GO TO 90
       COND(1)='YELL'
       COND(2)='OW  '
 90    CONTINUE
       IF(IQAD(IQX,IQY) .LT. 100)GO TO 999
       COND(1)='RED '
       COND(2)='    '
 999   RETURN
       END