SUBROUTINE DAMAGE(K,EN,D)
C
C     * CALCULATE DAMAGE DONE
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,MAXDAM,LPCNT
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE
	BYTE MESSAG,INITLS
C
C
	MAXDAM=20
	LPCNT=1
	IF (EN.LT.1) LPCNT=4
	IF (EN.LT.1) MAXDAM=75
	IF (EN.LT.1) EN = EN * -1
	SABS=SHIELD(K)/1000.
	IF (SABS .LT. 1. ) SABS = 1.
C
C     * CALCULATE FACTOR FOR DIRECTIONAL SHIELDING
C
	IF (D .GT. 360. )  GO TO 10005
	GO TO  10003
10005 	CONTINUE
	DEL=180.
	GO TO  10004
10003	CONTINUE
	DEL=ABS(DIR(K)-D)
	IF (DEL .GT. 180. )  GO TO 10008
	GO TO  10006
10008	CONTINUE
	DEL=360. - DEL
10006	CONTINUE
10004	CONTINUE
	SABS = SABS *(.5 + DEL/360.)
	SHIELD(K)=SHIELD(K)-SABS*EN
	IF (SHIELD(K).GT.1) GOTO 10009
	SHIELD(K)=0.
C
C	DO DAMAGE TO COMPONENTS IF NO SHIELDS
C
	ISEED4=0
	ISEED5=0
	DO 20000 II=1,LPCNT
	CALL TICKS (ISEED3)
	IF (ISEED3.EQ.ISEED4) ISEED3 = ABS(ISEED3-ISEED2)
	ISEED4=ISEED3
	ICOMP=IFIX(8.*RAN(DFLOAT(ISEED3)))+1
	CALL TICKS (ISEED2)
	IF (ISEED2.EQ.ISEED5) ISEED2 = ABS(ISEED2-ISEED3)
	ISEED5=ISEED2
	IAMT=IFIX(MAXDAM*RAN(DFLOAT(ISEED2)))+1
	IDAMGE(K,ICOMP) = IDAMGE(K,ICOMP)+IAMT
	IF (IDAMGE(K,ICOMP).GT.100) IDAMGE(K,ICOMP) = 100
20000	CONTINUE
10009	IF (IDAMGE(K,5).GT.0) IHOME(K) = 0
	SCAN (K) = 10 - (IDAMGE(K,3)/10)
	IF (IDAMGE(K,6).GT.50.AND.WARP(K).GT..2) CALL SENT(K,42)
	IF (IDAMGE(K,6).GT.50.AND.WARP(K).GT..2) WARP(K)=.2
C
	RETURN
	END