	SUBROUTINE PHOTON
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
	+ ,IHSTAR,IHT,IHQUEST,IHNUM,IQUAD,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 AITEM
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE (FNUM,AITEM),(SHIP,ISHIP)
      DIMENSION TARG(3,2), COURSE(3)
      EQUIVALENCE (CRACKS(1),HIT),(CRACKS(4),KSHOT) 
C--------CHECK TORPEDO COUNT AND STATUS OF PHOTON TUBES 
	IDIDIT=1
	KSHOT=0
      IF(DAMAGE(4) .EQ. 0)GO TO 10
      CALL PROUT(21HPHOTON TUBES DAMAGED.,21)
      GO TO 3005
10    IF(TORPS .NE.0)GO TO 15 
      CALL PROUT(18HNO TORPEDOES LEFT.,18) 
      GO TO 3005
C--------SCAN AND MAKE SENSE OF COMMAND INPUT LINE
 15   CALL SCAN 
	TEMP=FNUM
      N = TEMP + 0.5
      IF(KEY .EQ. IHREAL) GO TO 30
 16   CALL CRAMI(TORPS,0) 
      CALL CRAMDMP(16H TORPEDOES LEFT.) 
      CALL PROMPT(30HNUMBER OF TORPEDOES TO FIRE:   ,30)
      GO TO 15
 30   IF(N .LE. 0) GO TO 3005 
      IF(N .LE. 3) GO TO 31 
      CALL PROUT(33HMAXIMUM OF 3 TORPEDOES PER BURST.,33)
      GO TO 16
 3004 CALL BEGPARD
 3005 IDIDIT=0
      RETURN
 31   IF(N .LE. TORPS) GO TO 32 
      GO TO 16
C--------ALL TORPEDOES FIRED AT SAME SPOT.
 3101 DO 3102 I=2,N 
      TARG(I,1)=TARG(1,1) 
 3102 TARG(I,2)=TARG(1,2) 
      GO TO 36
C--------READ IN TARGET SECTORS 
 32   DO 33 I=1,N 
      CALL SCAN 
	TARG(I,1)=FNUM
      IF((I.EQ.1) .AND. (KEY.EQ.IHEOL)) GO TO 34
      IF((I .EQ. 2) .AND. (KEY .EQ. IHEOL))  GO TO 3101 
      IF (KEY .NE. IHREAL) GO TO 3004 
      CALL SCAN 
	TARG(I,2)=FNUM
      IF (KEY .NE. IHREAL) GO TO 3004 
 33	CONTINUE
      GO TO 36
 34   DO 35 I=1,N 
	CALL CHEW
      CALL CRAM (33HTARGET SECTOR FOR TORPEDO NUMBER )
      CALL CRAMI(I,0) 
	CALL CRAM(3H:  )
	CALL CRENDNO
	DO 35 J=1,2
      CALL SCAN 
	TARG(I,J)=FNUM
      IF (KEY .NE. IHREAL) GO TO 3004 
35	CONTINUE
C--------CHECK FOR INVALID TARGETS. 
 36   DO 37 I=1,N 
      DO 37 J=1,2 
      TEMP = TARG(I,J)
	IF(TEMP.EQ.-1.) GO TO 3005
      IF ((TEMP .LT. 0.999) .OR. (TEMP .GT. 10.001)) GO TO 3004 
 37	CONTINUE
C--------COMPUTE COURSE FOR EACH TORPEDO. 
      DO 40 I=1,N 
      DELTX = 0.1*(TARG(I,2)-SECTY) 
      DELTY=0.1*(SECTX-TARG(I,1)) 
C--------DO NOT ALLOW ENTERPRISE TO SHOOT A TORPEDO AT ITSELF.
      IF((DELTX .NE. 0) .OR. (DELTY .NE. 0)) GO TO 40 
      CALL SKIP(1)
      CALL PROUT(41HSPOCK:  "BRIDGE TO SICKBAY.  DR. MC COY,  ,41)   
      CALL PROUT(36H  I RECOMMEND AN IMMEDIATE REVIEW OF,36) 
      CALL PROUT(41H  THE CAPTAIN'S PSYCHOLOGICAL PROFILE."   ,41)   
      GO TO 3005
 40   COURSE (I) = 1.90985932*ATAN2(DELTX,DELTY)
C--------BEGIN OUTER LOOP FOR MOVING <N> TORPEDOES
      I=0 
 50   I=I+1 
      IF(I .GT. N) GO TO 115
      IF(CONDIT .NE. IHDOCKD ) TORPS=TORPS-1
      J=I 
	STARTX=SECTX
	STARTY=SECTY
      R=(RANF(0)+RANF(0))*0.5 -0.5
      IF(ABS(R) .LT. 0.49) GO TO 58 
      R=(RANF(0)+1.2)*R 
C-------- TORPEDO MISFIRES
      CALL CRAM(10H***TORPEDO)   
	IF(N.EQ.1) GO TO 55
	CALL CRAM(8H NUMBER )
      CALL CRAMI(I,0) 
55      CALL CRAMDMP(10H MISFIRES.) 
      IF(I . LT.  N) CALL PROUT(31H   REMAINDER OF BURST ABORTED. ,31) 
      I=N 
	IF(RANF(0.) .GT. .200000)GO TO 58 
C------- CHECK IF MISFIRE DOES SHIP DAMAGE. IF SO DON'T GIVE TRACK. 
      CALL PROUT(35H***PHOTON TUBES DAMAGED BY MISFIRE.,35)
      DAMAGE(4)=DAMFAC*(1.0+2.0*RANF(0))
      GO TO 115 
58	IF(SHLDUP.NE.0 .OR. CONDIT.EQ.IHDOCKD ) R=R+0.001*SHLD*R
      AC=COURSE(I)+0.25*R 
	CALL SKIP(1)
	IF(N .GT. 1) GO TO 60
	CALL CRAM(15HTORPEDO NUMBER )
	CALL CRAMI(I,0)
	CALL CRAMDMP(1H:)
60	CALL PHOTNT(0, SECTX, SECTY, AC)
	IF(ALLDONE.NE.0 .OR. GALAXY(QUADX,QUADY).EQ.1000) RETURN
	GO TO 50
115	IF(REMKL .EQ. 0) CALL FINISH(1)
	CALL SORTKL
	RETURN
	END
