C C C ******************************************************* C * * C * SUBROUTINE TO CHECK IF DISABLED ALIEN VESSEL * C * HAS INITIATED SELF-DESTUCT * C * * C ******************************************************* C SUBROUTINE CHKASD 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/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/TESTS2/TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO, &TBOSS INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,DLN,CMD REAL*8 COND,KL,RM,GRN,RED,DCKD,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TLOOS, &TBALEN,TALSD,TEST,TBOSS,TINTRD,TEST1 LOGICAL*1 SHIP C IF(RANK.LT.3.)RETURN IF(TALTOW .AND. ICAPV(5).EQ.0)GOTO 8 IF(TALTOW .AND. ICAPV(5).EQ.1)RETURN DO 7 NA=1,7 IF(K(NA,1).EQ.0)GOTO 7 IF(K(NA,3).LT.100 .AND. K(NA,4).EQ.0)GOTO 8 7 CONTINUE RETURN 8 IF(RAN(II,JJ).GT.0.1)RETURN IF(.NOT.TALTOW .AND. N3.GT.1)RETURN IF(STATUS(4).LT.0.)GOTO 12 IF(TALTOW)GOTO 26 KR=K(NA,1) KC=K(NA,2) K(NA,4)=2 GOTO 130 26 KR=ICAPV(1) KC=ICAPV(2) IF(IABS(A-ICAPV(1)).GT.3 .OR. IABS(B-ICAPV(2)).GT.3)RETURN ICAPV(5)=2 130 TYPE 131 131 FORMAT(/1X) 13000 WRITE(3,131) DO 9 I=1,3 140 TYPE 141,IBELL 141 FORMAT(1H+,A1,20(1H*),' WARNING ',20(1H*)) CALL PAUSE(1) TYPE 11 11 FORMAT(1H+,51X) CALL PAUSE(1) C IF(I.LE.5)CALL BACKSP(51) C IF(I.GT.5)TYPE 231 C 231 FORMAT(1H+,1X) 9 CONTINUE TYPE 141,IBELL WRITE(3,141)"0 150 TYPE 151,KR,KC 151 FORMAT(//1X,'** REPORT FROM SCIENCE OFFICER:'/1X,'Sensors have det &ected that the disabled enemy vessel'/1X,'in Sector',I3,',',I3,' h &as initiated SELF-DESTRUCT sequence.'/1X,'WE HAVE APPROX. 0.15 STA &RDATES BEFORE IT SELF-DESTRUCTS.') WRITE(3,151)KR,KC IF(COND.EQ.DCKD)GOTO 12 TEST1=.FALSE. IHIT=SIZHIT(KR,KC,2106,A,B) IF(STATUS(6).LT.0.)GOTO 190 CALL FDSHLD(NS,TEST,KR,KC,A,B) IF(NS.EQ.0)GOTO 12 N=1 IF(TEST)N=2 15 IF(SHLD(NS).GE.IHIT/N)GOTO 13 IF(POW+SHLD(5).LE.25)GOTO 190 POW=POW+SHLD(5) SHLD(5)=POW-125 IF(POW.LE.SHLD(5))SHLD(5)=POW-25 ISHLD=SHLD(5) IF(MOD(ISHLD,4).NE.0)ISHLD=SHLD(5)-MOD(ISHLD,4)*4 IF(ISHLD.GT.4000)ISHLD=4000 POW=POW-ISHLD SHLD(5)=0 DO 28 I=1,4 SHLD(I)=ISHLD/4 SHLD(5)=SHLD(5)+SHLD(I) 28 CONTINUE IF(SHLD(5).LT.IHIT)GOTO 220 23 IF(N.EQ.1 .AND. SHLD(NS).GE.IHIT/N)GOTO 220 IF(N.EQ.1)GOTO 29 NS2=NS+1 IF(NS2.EQ.5)NS2=1 IF(SHLD(NS).GE.IHIT/N .AND. SHLD(NS2).GE.IHIT/N)GOTO 220 29 IPREQ=IHIT/N IX=(SHLD(5)-IPREQ*N)/(4-N) SHLD(NS)=IPREQ IF(N.EQ.2)SHLD(NS2)=IPREQ IY=N 24 DO 25 J=1,4 IF(J.EQ.NS)GOTO 25 IF(N.EQ.2 .AND. J.EQ.NS2)GOTO 25 IY=IY+1 IF(IY.LT.4)SHLD(J)=IX IF(IY.EQ.4)SHLD(J)=SHLD(5)-(IPREQ*N+IX*(3-N)) 25 CONTINUE 220 TYPE 221 221 FORMAT(/1X,'*** REPORT FROM WEAPONS OFFICER:'/1X, &'Shields raised and adjusted.') WRITE(3,221) TEST1=.TRUE. GOTO 190 13 IF(.NOT.TEST)GOTO 190 TEST=.FALSE. NS=NS+1 IF(NS.EQ.5)NS=1 IF(TEST1)GOTO 23 GOTO 15 190 TYPE 191 191 FORMAT(1X,'Shields are ',$) WRITE(3,191) IF(SHLD(5).GE.IHIT)GOTO 210 C 100 TYPE 101 C 101 FORMAT(1H+,1X) C10000 WRITE(3,101) C DO 32 I=1,5 !N245 VERSION FOR NOW 200 TYPE 201,IBELL 201 FORMAT(1H+,A1,'** NOT ** ',$) WRITE(3,201)"0 C 32 CONTINUE C 110 TYPE 111 C 111 FORMAT(1H+,22X,$) C11000 WRITE(3,111) 210 TYPE 211 211 FORMAT(1H+,'strong enough to withstand the explosion') WRITE(3,211) IF(STATUS(6).GE.0.)GOTO 36 170 TYPE 171 171 FORMAT(1X,'** REPORT FROM WEAPONS OFFICER:'/1X, &'UNABLE TO RAISE SHIELDS DUE TO INOPERATIVE SHIELD CONTROL') WRITE(3,171) 36 IF(POW.GT.100)GOTO 12 180 TYPE 181 181 FORMAT(/1X,'*** REPORT FROM ENGINEERING:'/1X, &'POWER RESERVES INSUFFICIENT FOR ATTEMPTING HYPERSPACE MANEUVER') WRITE(3,181) 12 TALSD=.TRUE. TSHLD=.TRUE. IF(CMD.EQ.8)CMD=0 IF(TALTOW .AND. TEST1)TLOOS=.TRUE. 22 RETURN END C C C ******************************************************************* C * * C * SUBROUTINE TO PROCESS SELF-DESTRUCTION OF DISABLED ALIEN VESSEL * C * * C ******************************************************************* C SUBROUTINE ASELFD 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/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 INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,CMD,RBAS,CBAS,STBS INTEGER D9,E9,S9,B9,R9,DLN REAL*8 KL,RM,GRN,RED,DCKD,COND,ALIEN,VICTIM,ACOND(2),DEST,DISAB, &STRBS LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TDAMC,TLOOS,TBALEN,TALSD,TINTRD,TDEAD LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,EE,ENDB,ENDS,SHIP DATA STRBS,ENDB,ENDS/'STARBASE',' ','S'/ C ALIEN=KL IF(.NOT.TALTOW .OR. ICAPV(5).NE.2)GOTO 8 KR=ICAPV(1) KC=ICAPV(2) IF(ICAPV(4).EQ.1)ALIEN=RM DO 7 I=1,5 ICAPV(I)=0 7 CONTINUE TALTOW=.FALSE. GOTO 15 8 DO 9 NA=1,7 IF(K(NA,1).NE.0 .AND. K(NA,4).EQ.2)GOTO 14 9 CONTINUE GOTO 13 14 KR=K(NA,1) KC=K(NA,2) IF(SECT(KR,KC).EQ.R9)ALIEN=RM DO 12 I=1,5 K(NA,I)=0 12 CONTINUE IF(ALIEN.EQ.RM)GOTO 15 QUAD(R1,C1)=QUAD(R1,C1)-100 NGAL(R1,C1)=QUAD(R1,C1) N3=N3-1 15 IF(ALIEN.EQ.RM)TROM1=.FALSE. SECTOR(KR,KC)=DOT SECT(KR,KC)=D9 N4=N4-1 30 TYPE 31,ALIEN,KR,KC 31 FORMAT(/1X,'******** ',A8,'VESSEL IN SECTOR',I3,',',I3,' HAS SELF- &DESTRUCTED ********'/) 3000 WRITE(3,31)ALIEN,KR,KC CALL PAUSE(2) DO 16 NA=1,7 IF(K(NA,1).EQ.0)GOTO 16 VICTIM=KL IF(SECT(K(NA,1),K(NA,2)).EQ.R9)VICTIM=RM IHIT=SIZHIT(K(NA,1),K(NA,2),2106,KR,KC) 40 TYPE 41,IHIT,VICTIM,K(NA,1),K(NA,2) 41 FORMAT(1X,I5,' UNIT HIT FROM BLAST ON ',A8,' IN SECTOR',I3,',',I3/ &) 4000 WRITE(3,41)IHIT,VICTIM,K(NA,1),K(NA,2) K(NA,3)=K(NA,3)-IHIT IF(VICTIM.EQ.RM)SECTOR(K(NA,1),K(NA,2))=ROM IF(K(NA,3).GE.100)GOTO 16 ACOND(1)=DEST(1) ACOND(2)=DEST(2) IF(K(NA,3).GT.0)ACOND(1)=DISAB(1) IF(K(NA,3).GT.0)ACOND(2)=DISAB(2) 50 TYPE 51,VICTIM,ACOND 51 FORMAT(1X,'**** ',A8,' VESSEL ',A8,A1,' ****'/) 5000 WRITE(3,51)VICTIM,ACOND IF(K(NA,4).EQ.1)GOTO 23 IF(VICTIM.EQ.RM .AND. K(NA,3).GT.0)TROM2=.TRUE. IF(K(NA,3).GT.0)GOTO 16 IF(VICTIM.EQ.RM)GOTO 17 QUAD(R1,C1)=QUAD(R1,C1)-100 NGAL(R1,C1)=QUAD(R1,C1) N3=N3-1 17 IF(VICTIM.EQ.RM)TROM1=.FALSE. N4=N4-1 N5=N5-1 23 SECTOR(K(NA,1),K(NA,2))=DOT SECT(K(NA,1),K(NA,2))=D9 K(NA,1)=0 IF(TROM1 .OR. N3.GT.0)GOTO 16 IF(COND.NE.DCKD)COND=GRN 16 CONTINUE IF(M2.EQ.0)GOTO 18 DO 19 I=1,10 DO 19 J=1,10 IF(SECT(I,J).NE.M9)GOTO 19 SECT(I,J)=D9 SECTOR(I,J)=DOT 19 CONTINUE EE=ENDS IF(M2.EQ.1)EE=ENDB 60 TYPE 61,M2,EE,DEST 61 FORMAT(1X,I2,' MINE',A1,1X,A8,A1,' BY BLAST'/) 6000 WRITE(3,61)M2,EE,DEST M2=0 18 IF(N6.EQ.0)GOTO 22 IHIT=SIZHIT(RBAS,CBAS,1053,KR,KC) 70 TYPE 41,IHIT,STRBS,RBAS,CBAS 7000 WRITE(3,41)IHIT,STRBS,RBAS,CBAS STBS(N6,3)=STBS(N6,3)-IHIT IF(STBS(N6,3).LT.0)GOTO 80 IF(STBS(N6,4).NE.1)GOTO 22 STBS(N6,4)=0 TRESC=.TRUE. GOTO 22 80 TYPE 81,STRBS,N6 81 FORMAT(1X,10(1H*),1X,A8,I2,2X,10(1H*)/) 8000 WRITE(3,81)STRBS,N6 IF(COND.EQ.DCKD)TDEST=.TRUE. QUAD(R1,C1)=QUAD(R1,C1)-10 NGAL(R1,C1)=QUAD(R1,C1) STBS(N6,1)=0 N6=0 NBASRM=NBASRM-1 SECTOR(RBAS,CBAS)=DOT SECT(RBAS,CBAS)=D9 22 IF(COND.EQ.DCKD)RETURN TDEAD=.FALSE. CALL ALHITS(.TRUE.,0,KR,KC,TDEAD) IHIT=SIZHIT(KR,KC,2106,A,B) 90 TYPE 91,IHIT,SHIP 91 FORMAT(1X,I5,' UNIT HIT FROM BLAST ON ',16A1/) 9000 WRITE(3,91)IHIT,SHIP IF(.NOT.TDEAD)GOTO 13 100 TYPE 101 101 FORMAT(1X,10(1H*),' ALL SHIELDS PENETRATED BY BLAST ',10(1H*)/) 10000 WRITE(3,101) CALL PAUSE(3) 13 TALSD=.FALSE. RETURN END