SUBROUTINE DESTRCT
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,ISHIP
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
	REAL*8 IPASS,AITEM
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE(SHIP,ISHIP)
      IF(DAMAGE(11) .EQ. 0) GO TO 5 
      CALL PROUT( 
     +   51HCOMPUTER DAMAGED; CANNOT EXECUTE DESTRUCT SEQUENCE.,51)
      RETURN
 5    CALL SKIP(1)
      CALL PROUT(13H---WORKING---,13)
      CALL PROUT(24HIDENTIFICATION-POSITIVE;,24) 
      CALL PROUT(32HSELF-DESTRUCT-SEQUENCE-ACTIVATED,32) 
      CALL PROUT( 5H   10,5)
      CALL PROUT( 8H       9,8) 
      CALL PROUT(11H          8,11)
      CALL PROUT(14H             7,14) 
      CALL PROUT(17H                6,17)
      CALL PROUT(35HENTER-CORRECT-PASSWORD-TO-CONTINUE-,35)
      CALL PROUT(33HSELF-DESTRUCT-SEQUENCE-OTHERWISE-,33)
      CALL PROMPT(40HSELF-DESTRUCT-SEQUENCE-WILL-BE-ABORTED: ,40) 
      CALL SCAN
      IF(AITEM .NE. PASSWD) GO TO 30
      CALL PROUT(17HPASSWORD-ACCEPTED,17)
      CALL PROUT(11H          5,11)
      CALL PROUT(14H             4,14) 
      CALL PROUT(17H                3,17)
      CALL PROUT(20H                   2,20) 
      CALL PROUT(23H                      1,23)
      IF(RANF(0) .LT. 0.05) CALL PROUT(19HGOODBYE-CRUEL-WORLD,19)
      CALL SKIP(2)
	CALL KABOOM
	RETURN
 30   CALL PROUT(18HPASSWORD-REJECTED;,18) 
      CALL PROUT(19HCONTINUITY-EFFECTED,19)      
      CALL SKIP(2)
      RETURN
	END
C* 
      SUBROUTINE KABOOM
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,ISHIP
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
	REAL*8 IPASS,AITEM
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE(SHIP,ISHIP)
C* 
      CALL STARS
      IF(ISHIP .EQ. IHE) CALL CRAM3AS
      CALL CRAM(21H********* ENTROPY OF ) 
      CALL CRAMSHP
      CALL CRAMDMP(20H MAXIMIZED *********) 
      CALL STARS
      CALL SKIP(1)
      IF(NENHERE .EQ. 0) GO TO 20 
      WHAMMO=25.0*ENERGY
      DO 10 L=1,NENHERE 
      IF(KPOWER(L)*KDIST(L) .GT. WHAMMO) GOTO 10 
      II=KX(1)		!DEADKL SORTS THE KX AND KY ARRAYS AND
      JJ=KY(1)		!REDUCES THE SIZE
      CALL DEADKL(II,JJ,QUAD(II,JJ),II,JJ)
 10   CONTINUE
 20   CALL FINISH(10) 
      RETURN
      END