C C C ******************************** C * * C * SUBROUTINE TO FIRE PHASERS * C * * C ******************************** C SUBROUTINE FIREPH(NSEC,NP,J) COMMON QUAD(8,8),SECT(10,10),NGAL(8,8),K(7,5),STATUS(13),R1,C1,R,C &,H1,POW,SHLD(5),NTORP,A,B,H(7),N1,N2,N3,N4,N5,N6,II,JJ,RANK,ITR(4) COMMON/MISC1/ICAPV(5),M1,M2,DATE,DLN,BEARNG,NCAS(2),CMD,IG2,NPRIS, &IBELL COMMON/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN COMMON/SYMBL/DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR(10,10) COMMON/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/OBJCTS/D9,S9,E9,K9,B9,R9,M9 COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN DIMENSION NSEC(6,2),NP(6) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,RBAS,CBAS,STBS,DLN INTEGER D9,E9,S9,B9,R9,CMD REAL MN REAL*8 KL,RM,GRN,RED,DCKD,COND,TARGET,STRBS,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TMOVE,TEST1,TLOOS,TBALEN,TALSD,TINTRD LOGICAL TRENEG,TSLAP,TSHOOT,TBAN LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP DATA TARGET/' '/,STR,STRBS,MN/'STAR','STARBASE','MINE'/ C 100 TYPE 101 101 FORMAT(/1X'PHASERS FIRING'/) WRITE(3,101) CALL PAUSE(4) DO 17 I=1,J IF(NSEC(I,1).EQ.0)GOTO 22 NAL=0 R=NSEC(I,1) C=NSEC(I,2) IF(ICAPV(1).NE.R .OR. ICAPV(2).NE.C)GOTO 12 NAL=2 IF(ICAPV(5).EQ.1)NAL=3 TARGET=KL IF(ICAPV(4).EQ.1)TARGET=RM GOTO 5 12 DO 2 NA=1,7 IF(K(NA,1).EQ.R .AND. K(NA,2).EQ.C)GOTO 23 2 CONTINUE 23 GOTO(5,24,22,32,18,32,25),SECT(R,C)+1 24 TARGET=STR GOTO 5 18 TARGET=STRBS TRENEG=.TRUE. TSHOOT=.TRUE. GOTO 5 25 TARGET=MN GOTO 5 32 NAL=1 TARGET=KL IF(SECT(R,C).EQ.R9)TARGET=RM IF(K(NA,4).EQ.1)GOTO 5 4 TMOVE=.FALSE. IX=K(NA,1) IY=K(NA,2) CALL ALMOVE(TMOVE,.FALSE.,NA) IF(K(NA,1).EQ.0)GOTO 130 IF(.NOT.TMOVE)GOTO 16 IF(STATUS(4).GE.0.)GOTO 90 140 TYPE 141 141 FORMAT(/1X,'Inoperative Short Range Sensors hampered computer lock &-on') WRITE(3,141) GOTO 130 90 TYPE 91,TARGET,R,C 91 FORMAT(/1X,A8,'IN SECTOR',I3,',',I3,' PERFORMED EVASIVE MANEUVER') WRITE(3,91) 130 TYPE 131 131 FORMAT(1X,'*** LOCK-ON LOST - FIRING ABORTED ***'/) WRITE(3,131) GOTO 22 16 R=K(NA,1) C=K(NA,2) IF(NA.LT.7)GOTO 15 SECTOR(R,C)=ROM TROM2=.TRUE. GOTO 5 15 IF(R.EQ.IX .AND. C.EQ.IY)GOTO 5 150 TYPE 151,TARGET 151 FORMAT(/1X,A8,'Vessel movement detected - lock-on maintained') WRITE(3,151)TARGET 5 IHIT=FLOAT(NP(I))/(SQRT(FLOAT((A-R)**2+(B-C)**2))*0.1)+0.5 IF(NAL.EQ.1)K(NA,3)=K(NA,3)-IHIT IF(NAL.EQ.2)ICAPV(3)=ICAPV(3)-IHIT POW=POW-NP(I) IF(SECT(R,C).EQ.D9)GOTO 160 110 TYPE 111,IHIT,TARGET,R,C 111 FORMAT(1X,I4,' UNIT HIT ON ',A9,' IN SECTOR ',I3,',',I3) WRITE(3,111)IHIT,TARGET,R,C IF(NAL.EQ.1 .AND. K(NA,3).GT.0)GOTO 1 IF(NAL.EQ.2 .AND. ICAPV(3).GT.0)GOTO 22 IF(SECT(R,C).EQ.M9 .OR. NAL.GE.1)GOTO 120 IF(SECT(R,C).NE.B9)GOTO 22 STBS(N6,3)=STBS(N6,3)-IHIT IF(STBS(N6,3).LT.0)GOTO 9 IF(COND.EQ.RED .OR. COND.EQ.GRN .AND. IHIT.LT.100)GOTO 22 IF(TRENEG)GOTO 22 9 IF(COND.EQ.DCKD)TDEST=.TRUE. STBS(N6,1)=0 QUAD(R1,C1)=QUAD(R1,C1)-10 NGAL(R1,C1)=QUAD(R1,C1) N6=0 NBASRM=NBASRM-1 NBASD=NBASD+1 120 TYPE 121,TARGET,DEST 121 FORMAT(1X,'**** ',A8,1X,A8,A1,' ****'/) WRITE(3,121)TARGET,DEST IF(TDEST)RETURN SECT(R,C)=D9 SECTOR(R,C)=DOT IF(SECT(R,C).EQ.M9)M2=M2-1 IF(NAL.EQ.0)GOTO 22 IF(NAL.EQ.1)GOTO 13 IF(ICAPV(5).EQ.2)TALSD=.FALSE. DO 14 NN=1,5 ICAPV(I)=0 14 CONTINUE TBOFF=.TRUE. IF(NAL.EQ.2)GOTO 26 GOTO 22 13 TEST1=.FALSE. IF(K(NA,4).EQ.1)TEST1=.TRUE. IF(K(NA,4).EQ.2)TALSD=.FALSE. DO 3 I1=1,5 K(NA,I1)=0 3 CONTINUE IF(TEST1)GOTO 22 H1=H1-H(NA) 26 N4=N4-1 IF(TARGET.EQ.KL) GOTO 6 TROM1=.FALSE. TROM2=.FALSE. NROMD=NROMD+1 GOTO 7 6 IF(NAL.EQ.2)GOTO 22 N3=N3-1 QUAD(R1,C1)=QUAD(R1,C1)-100 NGAL(R1,C1)=QUAD(R1,C1) 7 IF(NAL.EQ.2)GOTO 22 IF(N3.GT.0) GOTO 8 IF(N6.EQ.0 .OR. TROM1)GOTO 33 IF(STBS(N6,4).NE.1)GOTO 33 STBS(N6,4)=0 TRESC=.TRUE. 33 IF(TROM1)GOTO 8 IF(COND.NE.DCKD)COND=GRN IF(.NOT.TALERT)GOTO 8 IF(COND.NE.GRN .OR. STATUS(6).LT.0. .OR. SHLD(5).EQ.0)GOTO 8 POW=POW+SHLD(5) DO 34 I1=1,5 SHLD(I1)=0 34 CONTINUE 8 IF(N2.EQ.0 .OR. N4.GT.0)GOTO 22 TWON=.TRUE. GOTO 22 1 IF(K(NA,3).GE.100)GOTO 22 210 TYPE 211,TARGET,DISAB(1) 211 FORMAT(1X,'*** ',A8,'VESSEL ',A8,' ***'/) WRITE(3,211)TARGET,DISAB(1) GOTO 22 160 TYPE 161,R,C,NP(I) 161 FORMAT(1X,'Nothing in Sector',I3,',',I3,' -- units power wasted:', &I5/) WRITE(3,161)R,C,NP(I) 22 CALL PAUSE(3) 17 CONTINUE RETURN END