      SUBROUTINE PHASERS
C*BEGIN COMMON 
      COMMON SNAP,SNAPSHT(247), 
     +   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,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY,
     +   QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20),  
     +   FUTURE(10),MESSAGE(5,10),
     +   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),
     +   DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,
     +   DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET,
     +   IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT,
     +   IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO,
     +   CRACKS(12) 
      INTEGER 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,IENM
	LOGICAL CROP
      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 AITEM
	BYTE ITM
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE (FNUM,AITEM)
	EQUIVALENCE (ITM,AITEM)
      REAL HITS(20) 
	BYTE IHN
	INTEGER HNO
	REAL*8 MANUAL,AUTOMATIC
	DATA HNO,MANUAL,AUTOMATIC/'NO','MANUAL','AUTOMAT'/
	DATA IHN/'N'/
	DATA PHASFAC/2.0/
      IFAST=0
	NO=0
      IDIDIT=1
	IPOOP=1
      IF(DAMAGE(1)+DAMAGE(11) .GT. 0.0) IPOOP=0 
C--------ENSURE PHASERS CAN BE FIRED
      IF(CONDIT .NE.IHDOCKD  )GO TO 5 
      CALL PROUT( 
     +  44HPHASERS CAN'T BE FIRED THROUGH BASE SHIELDS.,44)
      GO TO 15
5     IF(DAMAGE(3) .EQ. 0)GO TO 10
      CALL PROUT(23HPHASER CONTROL DAMAGED.,23)
      GO TO 15
C--------DO CHECKS FOR HI-SPEED SHIELD CONTROL
 10   IF(SHLDUP .EQ. 0)GO TO 20 
      IF(DAMAGE(13) .EQ. 0.) GO TO 13 
      CALL PROUT(34HHIGH-SPEED SHIELD CONTROL DAMAGED.,34) 
      GO TO 15
 13   IF(ENERGY .GT. 200.) GO TO 16 
      CALL PROUT(58HINSUFFICIENT ENERGY TO ACTIVATE HIGH-SPEED SHIELD CO
     CNTROL.   ,58)
15	IDIDIT=0
	IF(IFAST.NE.0) ENERGY=ENERGY+200.0
	RETURN
 16   ENERGY=ENERGY-200.
      IFAST = 1 
C--------READ IN AMOUNT OF ENERGY TO EXPEND ON PHASER FIRE
 20   CALL SCAN
	POW=FNUM
      IF(NENHERE .EQ. 0) GO TO 35 
      K=1 
      IF(KEY.EQ.IHALPHA) GOTO 23      
	IF(KEY.EQ.IHREAL) GOTO 28
      IF(.NOT.CROP(AITEM,HNO)) GOTO 23 
	NO=1
	CALL SCAN
	POW=FNUM
 23   IF(KEY .EQ. IHALPHA .AND.CROP(AITEM,MANUAL))GO TO 90
      IF(DAMAGE(11).NE.0)GO TO 80 
      IF(DAMAGE(1).NE.0) GO TO 81 
C------- IS KEY EOL,AUTO OR PHAS POWER? 
      IF(KEY .NE. IHALPHA)GO TO 2301
      IF(CROP(AITEM,AUTOMATIC))GO TO 27 
      GO TO 24
C-------- DIFFERENTIATE BETWEEN EOL AND PHASER POWER(COMMAND MODE)
 2301 IF(KEY .NE. IHEOL)GO TO 30
C------ REQUEST MANUAL OR AUTO
 24   CALL PROMPT(26HMANUAL OR AUTOMATIC ?     ,26) 
      CALL SCAN 
	IF(FNUM.EQ.-1.) GO TO 15
      IF(KEY .NE. IHALPHA) GO TO 24 
      IF(CROP(AITEM,MANUAL))GO TO 90 
      IF( .NOT.CROP(AITEM,AUTOMATIC))GO TO 24
C-------- INFORM USER OF AVAIL ENERGY AND READ IN DESIRED PHASER POWER
 2409 IF(NENHERE .EQ. 0) GO TO 26 
      CALL CRAM(27HPHASERS LOCKED ON TARGET.  )
25	CALL CRAM(19HENERGY AVAILABLE = )
	CALL CRAMF(ENERGY,0,2)
	CALL CREND
      CALL CRAM(1H()
	IREC=0
	DO 2510 K=1,NENHERE
2510	IREC=ABS(KPOWER(K))/(PHASFAC*0.9**KDIST(K))*(1.01+0.05*RANF(0))+1.
	1 +IREC
      CALL CRAMI(IREC,0)
      CALL CRAM(3H)  )
      CALL CRAMDMP(22HUNITS TO FIRE AT ENEMY) 
 26   CALL PROMPT(15HUNITS TO FIRE= ,15)
 27   CALL SCAN
	POW=FNUM
28	KEY1=KEY
      IF(KEY .EQ. IHEOL) GO TO 2409 
 30   CALL SCAN 
C*** READ IN ITM FIRST CHAR IN COMMON SCANBRF
	KEY2=KEY
	KEY=KEY1
      IF(KEY2 .EQ. IHEOL)GO TO 35 
	IF(ITM.NE.IHN) GOTO 34
	NO=1
	GO TO 35
 34   CALL BEGPARD
      GO TO 15
 35   IF(KEY .NE. IHREAL) GO TO 26
      IF(POW .GE. ENERGY)GO TO 25     
	IF(POW .LE. 0)GO TO 15
C--------ALLOCATE ENERGY AMONG KLINGONS ACCORDING TO NEAREST FIRST
C        STRATEGY AND COMPUTE HITS
      IF(IFAST .EQ. 0) GO TO 47 
      ASSIGN 47 TO IWHERE 
C--------PRINT MESSAGE FOR SHIELD CONTROL, AND DECIDE IF MALFUNCTION OCCURS.
 42   CALL SKIP(1)
      IF(RANF(0.).LT.0.995) GO TO 45
C--------SOMETHING BAD HAS HAPPENED.
      CALL REDALRT
      CALL SKIP(1)
      CALL PROUT(36HSULU:  "SHIELD CONTROL MALFUNCTION!"  ,36)       
      CALL SKIP(1)
      CALL PROUT(35HSAFETY INTERLOCK OVERRIDES PHASERS.   ,35) 
      RETURN
 45   CALL PROUT(16HSHIELDS LOWERED.  ,16) 
      GO TO IWHERE
 47   ENERGY=ENERGY-POW 
      EXTRA=POW 
      IF(NENHERE.EQ. 0)GO TO 75 
C--------- LOOP THAT DISTRIBUTES HITS IN AUTO MODE IS HERE. 
	EXTRA=0.0
	POWREM=POW
      DO 50 I=1,NENHERE 
	HITS(I)=0.
	IF (POWREM .LE. 0.) GO TO 50
      HITS(I)=ABS(KPOWER(I))/(PHASFAC*0.90**KDIST(I))
      OVER=(.01+.05*RANF(0))*HITS(I)
	TEMP=POWREM
	POWREM=POWREM-HITS(I)-OVER
      IF(POWREM .LE. 0.) HITS(I)=AMIN1(TEMP,HITS(I))
      IF(POWREM .LE. 0.) OVER=0.
      EXTRA=EXTRA+OVER
 50   CONTINUE
      IF(POWREM .GT. 0.) EXTRA=EXTRA+POWREM 
      CALL HITEM(HITS)      
      IF(EXTRA.EQ.0 .OR. ALLDONE.NE.0) GO TO 200
C--------- INFORM OF OVERKILL.
75    IF(ITHERE.EQ.0) GO TO 78
      CALL CRAM3AS
      CALL CRAM(19HTHOLIAN WEB ABSORBS  )       
      IF(NENHERE.GT.0) CALL CRAM(7H EXCESS  )   
	CALL CRAMDMP(16H PHASER ENERGY.  ) 
      GO TO 200   
78    CALL CRAMF(EXTRA,0,2) 
      CALL CRAMDMP(25H EXPENDED ON EMPTY SPACE.)
      GO TO 200 
C-------- MANUAL SECTION BEGINS HERE. 
C-------- INFORM OF IMPOSED MANUAL CONDITION. 
 80   CALL PROUT(42HBATTLE COMPUTER DAMAGED; MANUAL FIRE ONLY.,42) 
      GO TO 84
 81   CALL SKIP(1)
      CALL PROUT(13H---WORKING---,13)
      CALL PROUT(27HSHORT-RANGE-SENSORS-DAMAGED,27)
      CALL PROUT(43HINSUFFICIENT-DATA-FOR-AUTOMATIC-PHASER-FIRE,43)
      CALL PROUT(24HMANUAL-FIRE-MUST-BE-USED,24) 
      CALL SKIP(1)
 84   CALL CRAM(18HENERGY AVAILABLE= )
      CALL CRAMF(ENERGY-0.006,0,2)
      CALL CREND
C--------- LOOP FOR DESIRED INDIVIDUAL HITS.
      K=1 
 87   IF(IPOOP .EQ. 0) GO TO 88 
C--------PRINT BATTLE-COMPUTER RECOMMENDATION 
      CALL CRAM(1H()
      IREC=ABS(KPOWER(K))/(PHASFAC*0.9**KDIST(K))*(1.01+0.05*RANF(0))+1.
      CALL CRAMI(IREC,0)
      CALL CRAM(3H)  )
 88   CALL CRAM(17HUNITS TO FIRE AT ) 
      II=KX(K)
      JJ=KY(K)
      IENM=QUAD(II,JJ)
      CALL CRMENA(IENM,2,II,JJ)
      CALL CRAM(3H:  )
      CALL CRENDNO
 90   IF(K .EQ. 1)POW=0 
      CALL SCAN
	HITS(K)=FNUM
	IF(KEY.EQ.IHALPHA .AND. ITM.EQ.IHN)  NO=1 
      IF(KEY .EQ. IHREAL)GO TO 95 
      IF(KEY .EQ. IHALPHA) GO TO 90 
      IF(K .EQ. 1) GO TO 84
	GO TO 87
C-------- IF HIT LESS THAN ZERO, ABORT PHASERS. 
 95   IF(HITS(K) .LT. 0)GO TO 15
      POW=POW+HITS(K) 
C-------- IF TOTAL AMOUNT OF POWER REQUESTED IS TOO MUCH, INFORM
C-------- AND START OVER. 
      IF(POW .LT. ENERGY)GO TO 97 
      CALL PROUT(26HAVAILABLE ENERGY EXCEEDED.,26) 
      GO TO 84
 97   K=K+1 
      IF(K .LE. NENHERE) GO TO 90 
C--------IF TOTAL REQUESTED IS ZERO, ABORT PHASERS
      IF(POW .EQ. 0.0) GO TO 15 
      CALL SCAN 
      IF(KEY.EQ.IHALPHA .AND. ITM.EQ.IHN) NO = 1
	ENERGY=ENERGY-POW 
      IF(IFAST .EQ. 0) GO TO 98 
      ASSIGN 98 TO IWHERE 
      GO TO 42
C-------- GO DELIVER THE HITS.
 98   CALL HITEM(HITS)
      IDIDIT=1
C--------SAY SHIELDS RAISED OR MALFUNCTION, IF NECESSARY. 
 200  IF(ALLDONE.NE.0) RETURN 
      IF(IFAST .EQ. 0) GO TO 210
      IF(NO.NE.0) GO TO 202 
      CALL SKIP(1)
      IF(RANF(0) .LT. 0.99) GO TO 205 
      CALL PROUT(66HSULU:  "SIR, THE HIGH-SPEED SHIELD CONTROL HAS MALFU
     CNCTIONED . . .,66) 
      CALL PROUT( 
     +51H        CLICK  CLICK  POP . . . NO RESPONSE, SIR!"   ,51)   
 202  SHLDUP =0 
      GO TO 210 
 205  CALL PROUT(15HSHIELDS RAISED.,15)
C--------CHECK FOR PHASER OVERHEAT
210	CHEKBRN=(POW-1500.)*.00038
      IF(RANF(0.) .GT. CHEKBRN) RETURN
C--------DO YOU SMELL SMOKE?
      CALL SKIP(1)
      CALL PROUT(48HWEAPONS OFFICER SULU: "PHASERS OVERHEATED, SIR.",48)
	DAMAGE(3) = DAMFAC*(1.0 + RANF(0))*(1.+CHEKBRN)
      RETURN
      END 
