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 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