C C C ************************************************************* C * * C * SUBROUTINE TO CALCULATE & PROCESS TORPEDO FIRING ANGLES * C * * C ************************************************************* C SUBROUTINE TORANG 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/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/ALPHA/ALPH(30) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/TRPS/IFANGL(7),FANGL(7),M(7),N(7),IG(7),L(7),IH(7),NTARG,NT &,NS,IT2,ID3,IG3,IG4,IG6,IG7,IG8,IG9,IR5,TABORT,TAUTOF INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TEST1,TABORT,TLOOS,TBALEN,TALSD,TINTRD,TAUTOF LOGICAL*1 IMAGE(72),DUMMY(4),ALPH,ENDB,SHIP DATA ENDB/1H / C RADCON(ANG)=ANG/0.017453293 C IT2=0 IF(TAUTOF)GOTO 1 IF(COND.EQ.GRN)GOTO 60 140 TYPE 141 141 FORMAT(1X,'COMPUTED FIRING ANGLES: ',$) WRITE(3,141) 1 DO 47 I=1,7 FANGL(I)=0. IF(K(I,1).EQ.0 .OR. K(I,4).EQ.1)GOTO 47 IF(I.LT.7)GOTO 52 IF(.NOT.TROM2)GOTO 47 52 FANGL(I)=ANGLE(K(I,1),K(I,2),A,B) 2 IFANGL(I)=FANGL(I)+0.5 IT2=IT2+1 IF(TAUTOF)GOTO 47 130 TYPE 131,IFANGL(I) 131 FORMAT(1H+,I4,$) WRITE(3,131)IFANGL(I) 47 CONTINUE WRITE(3,11) IF(TAUTOF)RETURN TYPE 11 11 FORMAT(1X) 60 TYPE 61,NTORP 61 FORMAT(1X,'NUMBER OF PHOTON TORPEDOES AVAILABLE:',I3/ +1X,'FIRING ANGLES? ',$) 70 READ(5,71,ERR=60)IMAGE 71 FORMAT(72A1) TEST1=.FALSE. J=1 IT2=1 N1=0 DO 4 I=1,71 IF(IMAGE(I).NE.ALPH(27))GOTO 6 80 TYPE 81 81 FORMAT(1X,'*** INPUT ERROR - Integer variables only ***') GOTO 60 6 IF(IMAGE(I).EQ.ENDB.AND.IMAGE(I+1).EQ.ENDB)GOTO 7 IF(IMAGE(I).EQ.ALPH(28).AND.N1.NE.0)GOTO 90 N1=N1+1 DUMMY(N1)=IMAGE(I) GOTO 4 7 TEST1=.TRUE. IF(I.NE.1)GOTO 90 TABORT=.TRUE. RETURN 90 DECODE(N1,91,DUMMY,ERR=80)IFANGL(J) 91 FORMAT(I4) FANGL(J)=IFANGL(J) IF(TEST1)GOTO 5 N1=0 J=J+1 IF(J.GT.5)GOTO 5 IT2=IT2+1 4 CONTINUE 5 NTORP=NTORP-IT2 IF(NTORP.GE.0)GOTO 8 IT2=NTORP+IT2 NTORP=0 8 RETURN END C C C **************************************************** C * * C * SUBROUTINE TO WRITE RESULTS OF TORPEDO SALVO * C * * C **************************************************** C SUBROUTINE TORSLT 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/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/ALPHA/ALPH(30) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN COMMON/TRPS/IFANGL(7),FANGL(7),M(7),N(7),IG(7),L(7),IH(7),NTARG,NT &,NS,IT2,ID3,IG3,IG4,IG6,IG7,IG8,IG9,IR5,TABORT,TAUTOF INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD,TABORT,TAUTOF LOGICAL TRENEG,TSLAP,TSHOOT,TBAN LOGICAL*1 ALPH,EE,ENDB,SHIP,PRANK(13) DATA INDS,INDES,INDB/'s ','es',' '/,ENDB,ENDS/' ','s'/ C 100 TYPE 101 101 FORMAT(1X/) WRITE(3,101) 32 IF(IG3.EQ.0)GOTO 37 IE=INDES IF(IG3.EQ.1)IE="0 260 TYPE 261,IG3,IE 261 FORMAT(1X,I3,' torpedo',A2,' deflected') WRITE(3,261)IG3,IE 37 IF(IG7.EQ.0)GOTO 63 IE=INDES IF(IG7.EQ.1)IE=INDB 270 TYPE 271,IG7,IE 271 FORMAT(1X,'Romulan deflected',I3,' torpedo',A2) WRITE(3,271)IG7,IE 63 IF(IG9.EQ.0)GOTO 44 EE=ENDS IF(IG9.EQ.1)EE="0 310 TYPE 311,IG9,EE 311 FORMAT(1X,I3,' mine',A1,' destroyed') WRITE(3,311)IG9,EE 44 IF(ID3.EQ.0)GOTO 38 EE=ALPH(19) IF(ID3.EQ.1)EE="0 320 TYPE 321,ID3,EE,DISAB(1) 321 FORMAT(1X,'***',I3,' ALIEN VESSEL',A1,1X,A8,' ***') WRITE(3,321)ID3,EE,DISAB(1) 38 IF(IG4.EQ.0)GOTO 39 EE=ALPH(19) IF(IG4.EQ.1)EE="0 280 TYPE 281,IG4,EE,DEST 281 FORMAT(1X'****',I3,' KLINGON VESSEL',A1,1X,A8,A1,' ****') WRITE(3,281)IG4,EE,DEST 39 IF(IG8.EQ.0)GOTO 42 290 TYPE 291,DEST 291 FORMAT(1X,'**** ROMULAN WARSHIP ',A8,A1,' ****') WRITE(3,291)DEST 42 IF(IG6.EQ.0)GOTO 43 300 TYPE 301,N6 301 FORMAT(1X,'YOU BLUNDERING IDIOT, YOU HAVE HIT STARBASE',I2,'!') WRITE(3,301)N6 IF(IR5.EQ.0)GOTO 2 IR=AMOD(RANK*100.,100.)+0.0001 CALL SETRNK(IR,PRANK,0) 110 TYPE 111,N6,DEST,N6,PRANK 111 FORMAT(1X,'Starbase shields were down'/1X,'******** STARBASE',I2,1 &X,A8,A1,' ********'//1X,'*** COMMUNICATION FROM STAR FLEET COMMAND &:'/5X,'The sensors on Starbase',I2,' relayed to us what happened b &efore'/5X,'the starbase was destroyed. ',13A1', you will face an o &fficial'/5X,'Board of Inquiry, if you return, to answer for this a &ct of') WRITE(3,111)N6,DEST,N6,PRANK IF(TRENEG)GOTO 20 TYPE 11 11 FORMAT(5X,'criminal negligence or incompetence. This will not look & good'/5X,'on your service record. Don''t let it happen again!') WRITE(3,11) GOTO 1 20 TYPE 21 21 FORMAT(5X,'criminal treachery. You have been officially desginated & as'/5X,'a possible renegade starship. All starbases have been'/5X &'warned about you.') WRITE(3,21) TSLAP=.TRUE. 1 N6=0 GOTO 43 2 IF(TSHOOT)RETURN 120 TYPE 121,N6,SHIP 121 FORMAT(1X,'Starbase shields held'//1X,'*** COMMUNICATION RECEIVED &FROM STARBASE',I2,':'/5X,'What the hell do you think you''re doing &, ',16A1,'?'/5X,'Unless you improve your aim, you''ll have to answ &er'/5X,'to Star Fleet Command for your gross incompetence!') WRITE(3,121)N6,SHIP 43 IF(TDEST)RETURN IF(N4.LE.0)TWON=.TRUE. RETURN END