SUBROUTINE ZAP
C*BEGIN COMMON 
      COMMON SNAP,SNAPSHT(226), 
     +   DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL,
     +   KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), 
     +   NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM,
     +   NSCKILL,ICRYSTL,NPLANKL, 
     +   QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20),  
     +   INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD,
     +   INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, 
     +   QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), 
     +   LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, 
     +   KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8),FUTURE(10), 
     +   DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,
     +   DAMFAC,SHLDCHG,THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT,
     +   LANDED,IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT,
     +   IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE,IPHWHO,BATX,BATY, 
     +   CRACKS(12) 
      INTEGER CF,CI,SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS,
     +   REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, 
     +   SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, 
     +   ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, 
     +   THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS
      REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD,   
     +   INENRG,INLSR 
	BYTE QUAD
	REAL*8 DEVICE,PASSWD
C*END COMMON 
	LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB
	1 ,IHSTAR,IHT,IHQUEST,IHNUM
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
      INTEGER CDAM(5) 
      EQUIVALENCE (CRACKS(1),HIT),(CRACKS(3),IHURT),(CRACKS(4),L) 
      PFAC=1.0/INSHLD 
      CHGFAC=1.0
      IF(SHLDCHG .EQ. 1) CHGFAC=0.25+0.50*RANF(0) 
      IF(SHLDUP .EQ. 0 .AND. SHLDCHG .EQ. 0) GO TO 10 
      PROPOR=AMAX1(PFAC*SHLD,0.10)
      HITSH=PROPOR*CHGFAC*HIT+1.0 
      ABSORB=0.8*HITSH
      IF(ABSORB .GT. SHLD) ABSORB=SHLD
      SHLD=SHLD-ABSORB
      IF(SHLD .LE. 0.0) SHLDUP=0
      HIT=HIT-HITSH 
      IF(PROPOR .GT. 0.1 .AND. HIT .LT. (0.005*ENERGY)) RETURN
C--------IT'S A HIT!  PRINT OUT HIT SIZE
 10   IHURT=1 
      CALL CRAMF(HIT,8,2) 
      CALL CRAM(9H UNIT HIT)
      IF(L .EQ. 0) GO TO 15 
      CALL CRAM(6H FROM ) 
      JX=KX(L)
      JY=KY(L)
      CALL CRAMENA(QUAD(JX,JY),0,JX,JY) 
 15   CALL CREND
C--------DECIDE IF HIT IS CRITICAL
      IF(HIT .LT. (275.0-25.0*SKILL)*(1.0+0.5*RANF(0))) GO TO 60
      NCRIT=1.0 + HIT/(500.0+100.0*RANF(0)) 
      CALL CRAM(17H***CRITICAL HIT--) 
C--------SELECT DEVICE(S) AND CAUSE DAMAGE
      KTR=1 
      DO 50 LL=1,NCRIT
 20   J=NDEVICE*RANF(0)+1.0 
      IF(DAMAGE(J) .LT. 0) GO TO 20 
C*--------CHEAT TO PREVENT DEATHRAY FROM BEING DAMAGED.    
      IF(J.EQ.14) GOTO 20   
C--------CHEAT TO PREVENT SHUTTLE DAMAGE UNLESS ON SHIP.
      IF((J .EQ. 10) .AND. (ISCRAFT .NE. 1)) GO TO 20 
      CDAM(LL)=J
      EXTRADM=(HIT*DAMFAC)/(NCRIT*(75.0+25.0*RANF(0)))
      DAMAGE(J)=DAMAGE(J)+EXTRADM 
      IF(LL .EQ. 1) GO TO 40
      DO 30 LLL=2,LL
      IF(J .EQ. CDAM(LLL-1)) GO TO 50 
 30   CONTINUE
      KTR=KTR+1 
      IF(KTR .EQ. 3) CALL CREND 
      CALL CRAM(5H AND )
 40   CALL CRAMS(DEVICE(1,J),16)
 50   CONTINUE
      CALL CRAMDMP(9H DAMAGED.) 
C--------PRINT MESSAGE IF SHIELDS WERE UP AND GOT KNOCKED DOWN
      IF(DAMAGE(8) .EQ. 0) GO TO 60 
      IF(SHLDUP.NE.0) CALL PROUT(24H***SHIELDS KNOCKED DOWN.,24) 
      SHLDUP=0
 60   ENERGY=ENERGY-HIT 
      RETURN      
      END