C===================================================== C C TREK7 MODULE C C C M-0 SHIP OPERATIONS C C SULU DUNSEL LAUREL HARDY SPOCK SAREK C MUDD HARPO TPRING CHICO ZEPPO TANRU C LARRY CURLY MOE C C===================================================== C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C SSSS U U L U U C S U U L U U C SSS U U L U U C S U U L U U C SSSS UUU LLLLL UUU LOGICAL FUNCTION SULU(J) LOGICAL CYRANO C C integer itzro,itvl1 real rtzro,rtvl1 C inserted to take care of call list problems C*** COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /F/WARP(4),ITROW(4),ITCOL(4) COMMON /I/IDNK(8),ISPOK(8),ION(4),ISPOT(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) COMMON /V/IWEB(2),IWEBZ,INVIS(4) COMMON /TOM/ITOM SULU=.FALSE. ISTAT=0 IF(ITCOL(IT).EQ.IENTC(IT).AND.ITROW(IT).EQ.IENTR(IT))GO TO 1002 IF(MA(IT,29).NE.9.OR.MA(IT,30).NE.9)GO TO 110 IF(MA(IT,28).EQ.9)GO TO 111 IF(WARP(IT).LT.2.0)GO TO 110 WARP(IT)=1.5 WRITE(L,113) 113 FORMAT(' WARP ENGINE NACELLES ARE DESTROYED AND THUS WARP GREATER * THAN 1 IS IMPOSSIBLE') GO TO 110 111 WRITE(L,112) 112 FORMAT(' ALL ENGINES ARE DESTROYED - MOVEMENT IMPOSSIBLE') WARP(IT)=0.0 RETURN 110 DO 1000 J=1,2 IF(IWEB(J).NE.IT)GO TO 1000 IF(WARP(IT).LT.10.)GO TO 1000 CALL RANDO(IV,1,7) IF(IV.GT.1)GO TO 1000 IWEB(J)=0 WRITE(L,1001)(INAME(IQ0,IT),IQ0=1,3) 1001 FORMAT(' THE ',3A4,' HAS BROKEN FREE OF THE WEB') 1000 CONTINUE IF(IWEB(1).NE.IT.AND.IWEB(2).NE.IT)GO TO 1004 WRITE(L,1003)(INAME(IQ0,IT),IQ0=1,3) 1003 FORMAT(' THE ',3A4,' IS TRAPPED IN A WEB') RETURN 1004 DO 100 J=1,2 IF(MA(IT,J+30).EQ.0.OR.MA(IT,J+28).EQ.9)GO TO 100 IF(MA(IT,J+30).EQ.9.AND.WARP(IT).GT.1.)GO TO 109 IF(HIVEL(IT,J).GE.WARP(IT))GO TO 100 I7=10*(WARP(IT)-HIVEL(IT,J)) IF(I7.GT.0)I7=I7+10 CALL RANDO(IV,1,100) IF(IV.GT.I7)GO TO 100 109 CALL LAUREL(J) 100 CONTINUE 205 IF(WARP(IT).GT.TWARP(IT))WARP(IT)=TWARP(IT) 1002 IF(WARP(IT).LE.1.)GO TO 10020 CALL RANDO(I7,1,100) IF(I7.GT.(MA(IT,20)+1)*3)GO TO 10020 J=IFIX(TWARP(IT)) IF(J.EQ.0)RETURN WRITE(L,200) 200 FORMAT(' SHORT-CIRCUIT IN WARP DRIVE ENGINEERING ROOM-'/' OUR SHIP * HAS LOST STEERING CONTROL AND IS VEERING OFF COURSE') 201 CALL RANDO(IV,0,J) CALL RANDO(I7,IENTR(IT)-IV,IENTR(IT)+IV) CALL RANDO(I8,IENTC(IT)-IV,IENTC(IT)+IV) IF(CYRANO(I7,I8))GO TO 201 NA=MMAP(I7,I8) IF(NA.NE.IBLK.AND.NA.NE.III)GO TO 201 J=0 GO TO 5327 10020 IF(ITCOL(IT).EQ.IENTC(IT).AND.ITROW(IT).EQ.IENTR(IT))GO TO 600 Q=WARP(IT) BERNG=ANG(ITROW(IT)-IENTR(IT),ITCOL(IT)-IENTC(IT)) DO 224 I7=1,4 IF(ICHOE(I7).NE.1)GO TO 224 IF(I7.EQ.IT)GO TO 224 MMIN=0 CALL DUNSEL(IENTR(IT),IENTC(IT),Q,BERNG) IF(MMIN.LT.2)GO TO 222 MMIN=MMIN-2 WRITE(L,223)(INAME(IQ0,I7),IQ0=1,3) 223 FORMAT(' THE ',3A4,' HAS US CAUGHT IN A DEFLECTOR BEAM') 222 IF(MMIN.EQ.0)GO TO 224 WRITE(L,225)(INAME(IQ0,I7),IQ0=1,3) 225 FORMAT(' THE ',3A4,' HAS US CAUGHT IN A TRACTOR BEAM') 224 CONTINUE IF(Q.LT.1.)RETURN N=1 IV=IT IGNORE=0 itzro=0 rtzro=0.0 itvl1=1 770 CALL HORTA(IENTR(IT),IENTC(IT),ITROW(IT),ITCOL(IT),Q, *rtzro,itvl1,rtzro,IGNORE,rtzro,itzro) J=0 IF(MMIN.GT.12)GO TO 532 DFLCT(IT)=-1. IF(MMIN.LT.5)GO TO 166 MMIN=MMIN-4 DO 1390 J=1,4 IF(ICHOE(J).EQ.0)GO TO 1390 N=J+4 WRITE(N,235)(INAME(IQ0,IT),IQ0=1,3),(IENM2(IV,MMIN),IV=1,4) 235 FORMAT(' THE ', 3A4, ' HAS COLLIDED WITH THE ',4A4/' WHICH HAS * EXPLODED') 1390 CONTINUE DFLCK(MMIN)=-1. GO TO 343 166 DO 167 J=1,4 IF(ICHOE(J).EQ.0)GO TO 167 N=J+4 WRITE(N,168)(INAME(IQ0,IT),IQ0=1,3),(INAME(IQ0,MMIN),IQ0=1,3) 168 FORMAT(' THE ',3A4,' HAS RAMMED THE ',3A4) 167 CONTINUE DFLCT(MMIN)=-1. 343 MMAP(I7,I8)=IBLK MMAP(IENTR(IT),IENTC(IT))=IBLK IF(ISPOT(IT).EQ.1)MMAP(IENTR(IT),IENTC(IT))=III RETURN 532 IF(MMIN.NE.13)GO TO 5330 5320 WRITE(L,535) 535 FORMAT(' OUR COURSE IS BLOCKED BY A STAR') IV1=I7 IVV=I8 rtvl1=1.5 itvl1=1 itzro=0 rtzro=0.0 CALL HORTA(IV1,IVV,IENTR(IT),IENTC(IT),rtvl1,rtzro,itzro, *rtzro,itvl1,rtzro,itzro) 5327 MMAP(IENTR(IT),IENTC(IT))=IBLK IF(ISPOT(IT).EQ.1)MMAP(IENTR(IT),IENTC(IT))=III ISPOT(IT)=0 IENTR(IT)=I7 IENTC(IT)=I8 IF(IGO(IT).EQ.2)IGO(IT)=1 IF(MMAP(IENTR(IT),IENTC(IT)).EQ.III)ISPOT(IT)=1 IF(J.EQ.1)GO TO 770 MMAP(IENTR(IT),IENTC(IT))=IEE(IT) IF(IENTR(IT).NE.ITROW(IT).OR.IENTC(IT).NE.ITCOL(IT))GO TO 550 600 WRITE(L,601) 601 FORMAT(' WE''VE REACHED TARGET COORDINATES') SULU=.TRUE. 550 DO 552 I7=1,5 IF(LI2R(I7).EQ.0)GO TO 552 IF(LI2(IT).EQ.I7)GO TO 552 IF(IABS(IENTR(IT)-LI2R(I7)).GT.5)GO TO 552 IF(IABS(IENTC(IT)-LI2C(I7)).GT.5)GO TO 552 CALL RANDO(I8,1,12) WRITE(L,553)I8,LI2C(I7),LI2R(I7) 553 FORMAT(' SENSORS DETECT A DEPOSIT OF DILITHIUM CRYSTALS ON PLANET * ',I2/' OF SYSTEM (',I2,',',I2,'). ACQUISITION OPERATIONS WILL COM *MENCE'/' IF WE CLOSE TO WITHIN 1 UNIT OF THE SYSTEM.') LI2(IT)=I7 GO TO 430 552 CONTINUE 430 DO 5520 I7=1,5 IF(LI2R(I7).EQ.0)GO TO 5520 IF(IABS(IENTR(IT)-LI2R(I7)).GT.1)GO TO 5520 IF(IABS(IENTC(IT)-LI2C(I7)).GT.1)GO TO 5520 CALL RANDO(J,3500,6500) WRITE(L,551)LI2C(I7),LI2R(I7),J 551 FORMAT(' ACQUISITION AND PROCESSING OF DILITHIUM CRYSTALS FROM SYS *TEM (',I2,',',I2,') PROCEEDING. '/' PHASER ENERGY INCREASED BY',I5, *' UNITS. ACQUISITION TERMINATED.') PHASR(IT)=PHASR(IT)+J LI2R(I7)=0 LI2C(I7)=0 5501 LI2(IT)=0 5520 CONTINUE 5321 RETURN 5322 IF(MMIN.NE.19)GO TO 5327 ION(IT)=1 IGNORE=1 Q=(Q-DISTP)/2. J=1 IF(I7.EQ.ITROW(IT).AND.I8.EQ.ITCOL(IT))J=0 GO TO 5327 5323 IF(MMIN.GT.18)GO TO 5322 DO 228 IV=1,4 IF(ICHOE(IV).EQ.0)GO TO 228 N=IV+4 WRITE(N,16)(INAME(IQ0,IT),IQ0=1,3), *(INAME(IQ0,MMIN-14),IQ0=1,3),I8,I7 16 FORMAT(1X,3A4,' COLLIDED WITH ',3A4,' MINE AT (',I2,',',I2,')') 228 CONTINUE GO TO 227 5330 IF(MMIN.NE.14)GO TO 5323 DO 5331 IV=1,LAUNCH IF(I7.EQ.IGLER(IV).AND.I8.EQ.IGLEC(IV))GO TO 5332 5331 CONTINUE 5332 DO 226 N=1,4 IF(ICHOE(N).EQ.0)GO TO 226 IVV=N+4 WRITE(IVV,5333)(INAME(IQ0,IT),IQ0=1,3),IV,I8,I7,IV, *(INAME(IQ0,IT),IQ0=1,3) 5333 FORMAT(1X,3A4,' COLLIDED WITH EAGLE',I3,' AT (',I2,',',I2,')'/' EA *GLE',I3,' DESTROYED'/' DAMAGE REPORT TO THE ',3A4) 226 CONTINUE CALL BOOM(IV) 227 CALL RANDO(IV,1,100) IVV=ALOG((101.-DFLCT(IT))*IV+10.)/0.700619195-1.8185 CALL GRUP1(IVV,IT) GO TO 5327 END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C - DUNSEL - C SUBROUTINE DUNSEL(J1,J2,Q1,Q2) COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /P/IPULL(4),IPUSH(4),PULL(4),PUSH(4),IPULLR(4),IPULLC(4), *IPUSHR(4),IPUSHC(4) IF(IPULL(I7).EQ.0)GO TO 1 IF(IPULLC(I7).NE.J2.OR.IPULLR(I7).NE.J1)GO TO 1 IPULL(I7)=0 B=ANG(IENTR(I7)-J1,IENTC(I7)-J2) IV=ABS(B-Q2) IF(IV.LT.90.OR.IV.GT.270)GO TO 1 MMIN=1 Q1=Q1/2.0**(PULL(I7)*2.0) 1 IF(IPUSH(I7).EQ.0)GO TO 2 IF(IPUSHC(I7).NE.J2.OR.IPUSHR(I7).NE.J1)GO TO 2 IPUSH(I7)=0 B=ANG(J1-IENTR(I7),J2-IENTC(I7)) IV=ABS(B-Q2) IF(IV.LT.90.OR.IV.GT.270)GO TO 2 Q1=Q1/2.0**(PUSH(I7)/5.) MMIN=MMIN+2 2 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C - LAUREL - C SUBROUTINE LAUREL(J) integer itzro,itvl1 real rtzro,rtvl1 COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /F/WARP(4),ITROW(4),ITCOL(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) 109 WRITE(L,102)J 102 FORMAT(' NACELLE',I2,' HAS RIPPED FREE OF THE SECONDARY HULL') IF(IGO(IT).EQ.2)IGO(IT)=1 IF(MA(IT,J+28).GT.0)MANUM(IT)=MANUM(IT)-1 MANUM(IT)=MANUM(IT)+1 MA(IT,J+28)=9 MA(IT,J+30)=9 TWARP(IT)=TWARP(IT)-FLOAT(MA(IT,J+28)-K(IT,J+3))/2. IF(TWARP(IT).LT.0)TWARP(IT)=0. K(IT,J+3)=MA(IT,J+28) N=2 itzro=0 rtzro=0. rtvl1=85.0 itvl1=1 IV=IT CALL HORTA(IENTR(IT),IENTC(IT),ITROW(IT),ITCOL(IT), *rtvl1,rtzro,itzro,rtzro,itvl1,rtzro,itzro) IF(MMIN.GT.4)GO TO 202 DO 203 N=1,4 IF(ICHOE(N).EQ.0)GO TO 203 IV=N+4 WRITE(IV,204)(INAME(IQ0,IT),IQ0=1,3),J,(INAME(IQ0,MMIN),IQ0=1,3) 204 FORMAT(1X,3A4,' NACELLE',I2,' HIT THE ',3A4) 203 CONTINUE CALL GRUP1(10,MMIN) CALL HARDY CALL GRUP1(10,MMIN) GO TO 205 202 IF(MMIN.GT.12)GO TO 206 MMIN=MMIN-4 DO 207 N=1,4 IF(ICHOE(N).EQ.0)GO TO 207 IV=N+4 WRITE(IV,208)(INAME(IQ0,IT),IQ0=1,3),J,(IENM2(IVV,MMIN),IVV=1,4) 208 FORMAT(1X,3A4,' NACELLE',I2,' HIT ',4A4) 207 CONTINUE CALL GRUP3(10,MMIN) CALL HARDY CALL GRUP3(10,MMIN) GO TO 205 206 IF(MMIN.NE.13)GO TO 209 DO 210 MI=1,2 IF(I7.NE.IBASR(MI))GO TO 210 IF(I8.NE.IBASC(MI))GO TO 210 DO 211 N=1,4 IF(ICHOE(N).EQ.0)GO TO 211 IV=N+4 WRITE(IV,212)(INAME(IQ0,IT),IQ0=1,3),J,(ISIDE(IQ0,MI),IQ0=1,3), *IBASE(MI) 212 FORMAT(1X,3A4,' NACELLE',I2,' HIT ',3A4,' STARBASE',I3) 211 CONTINUE CALL GRUP2(10,MI) CALL HARDY CALL GRUP2(10,MI) GO TO 205 210 CONTINUE DO 213 N=1,4 IF(ICHOE(N).EQ.0)GO TO 213 IV=N+4 WRITE(IV,214)(INAME(IQ0,IT),IQ0=1,3),J,I8,I7 214 FORMAT(1X,3A4,' NACELLE',I2,' HIT STAR AT (',I2,',',I2,')') 213 CONTINUE GO TO 205 209 IF(MMIN.NE.14)GO TO 216 DO 217 MI=1,LAUNCH IF(I7.NE.IGLER(MI))GO TO 217 IF(I8.NE.IGLEC(MI))GO TO 217 DO 218 N=1,4 IF(ICHOE(N).EQ.0)GO TO 218 IV=N+4 WRITE(IV,219)(INAME(IQ0,IT),IQ0=1,3),J,MMIN 219 FORMAT(1X,3A4,' NACELLE',I2,' DESTROYED EAGLE',I3) 218 CONTINUE CALL BOOM(MMIN) GO TO 205 217 CONTINUE 216 IF(MMIN.GT.18)GO TO 205 MMAP(I7,I8)=IBLK DO 220 N=1,4 IF(ICHOE(N).EQ.0)GO TO 220 WRITE(IV,221)(INAME(IQ0,IT),IQ0=1,3),J,I8,I7 221 FORMAT(1X,3A4,' NACELLE',I2,' DESTROYED MINE AT (',I2,',',I2,')') 220 CONTINUE 205 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C - HARDY - SUBROUTINE HARDY COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) DO 1 I=1,4 IF(ICHOE(I).EQ.0)GO TO 1 J=I+4 WRITE(J,2) 2 FORMAT(' DAMAGE FROM SECONDARY EXPLOSIONS-') 1 CONTINUE RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C SSSS PPPP OOO CCCC K K C S P P O O C K K C SSS PPPP O O C KKK C S P O O C K K C SSSS P OOO CCCC K K LOGICAL FUNCTION SPOCK(J) integer itzro,itvl1 real rtzro,rtvl1 DIMENSION IBOLT(4,2),KPLOT(10) COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /H/ANGLE(4),RANG(4),LOCKT(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) COMMON /V/IWEB(2),IWEBZ,INVIS(4) COMMON /TOM/ITOM DATA IBOLT/'PHOT','ON T','ORPE','DO ','DISR','UPTO','R BO','LT'/ DATA FUDGE/0.700619195/ IWOW(X)=IFIX(ALOG((101.-X)*IV1)/FUDGE-1.8185) SPOCK=.FALSE. 74 CALL RANDO(IV1,1,100) LOCKT(IT)=0 IF(IGO(IT).EQ.2)IGO(IT)=1 IF(IV1.GT.7)GO TO 76 IF(JS.EQ.2)GO TO 100 WRITE(L,78) 78 FORMAT(' PHOTON TORPEDO BANKS HAVE SHORT-CIRCUITED.') GO TO 101 100 WRITE(L,102) 102 FORMAT(' DISRUPTOR BANKS HAVE SHORT-CIRCUITED.') 101 WRITE(L,103) 103 FORMAT(5X,'THEIR NUMBER HAS DIMINISHED BY ONE-QUARTER') IPHOT(IT)=FLOAT(IPHOT(IT))*0.75 GO TO 50 76 IF(IWEB(1).NE.IT.AND.IWEB(2).NE.IT)GO TO 761 CALL RANDO(IV,1,4) IF(IV.EQ.1)GO TO 761 WRITE(L,1001)(IBOLT(J,JS),J=1,4) 1001 FORMAT(1X,4A4,'FAILED TO PIERCE THE WEB') IF(IV.NE.4)GO TO 50 DO 104 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 104 I8=I7+4 WRITE(I8,105)(IBOLT(J,JS),J=1,4),(INAME(IQ0,IT),IQ0=1,3) 105 FORMAT(1X,4A4,'BOUNCED OFF THE WEB AND HAS STRUCK THE ',3A4/' DAMA *GE REPORT-') 104 CONTINUE IVV=IWOW(DFLCT(IT)) CALL GRUP1(IVV,IT) GO TO 50 761 N=3 ANGLE(IT)=ANGLE(IT)*3.14159265/180. IV=0 AJUST=0.0 itzro=0 itvl1=1 rtzto=0.0 CALL HORTA(IENTR(IT),IENTC(IT),itzro, *itzro,RANG(IT),ANGLE(IT),J,AJUST,iitvl1,itzro,KPLOT) ANGLE(IT)=ANGLE(IT)*180./3.14159265 J=J-1 IF(J.LE.1)GO TO 529 WRITE(L,528)(KPLOT(IV),IV=1,J) 528 FORMAT(10(I3,',',I2)) 529 IF(MMIN.GT.4)GO TO 106 DO 107 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 107 I8=I7+4 WRITE(I8,108)(INAME(IQ0,IT),IQ0=1,3),(IBOLT(J,JS),J=1,4), *(INAME(IQ0,MMIN),IQ0=1,3) 108 FORMAT(1X,3A4,1X,4A4,' HAS SCORED A HIT ON THE ',3A4) 107 CONTINUE IVV=IWOW(DFLCT(MMIN)) CALL GRUP1(IVV,MMIN) SPOCK=.TRUE. GO TO 50 106 IF(MMIN.GT.12)GO TO 109 MMIN=MMIN-4 DO 110 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 110 I8=I7+4 WRITE(I8,111)(INAME(IQ0,IT),IQ0=1,3),(IBOLT(J,JS),J=1,4),(IENM2(J, *MMIN),J=1,4) 111 FORMAT(1X,3A4,1X,4A4,'HIT ',4A4) 110 CONTINUE IVV=IWOW(DFLCK(MMIN)) CALL GRUP3(IVV,MMIN) SPOCK=.TRUE. GO TO 50 109 IF(MMIN.NE.13)GO TO 112 DO 119 IV=1,2 IF(IBASR(IV).NE.I7)GO TO 119 IF(IBASC(IV).EQ.I8)GO TO 120 119 CONTINUE WRITE(L,526)(IBOLT(J,JS),J=1,4) 526 FORMAT(1X,4A4,'HAS SCORED A HIT ON A STAR') GO TO 50 120 DO 121 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 121 I8=I7+4 WRITE(I8,122)(INAME(IQ0,IT),IQ0=1,3),(IBOLT(J,JS),J=21,4), *(ISIDE(IQ0,IV),IQ0=1,3),IBASE(IV) 122 FORMAT(1X,3A4,1X,4A4,' HAS HIT ',3A4,' STARBASE',I3) 121 CONTINUE IVV=IWOW(DFLCB(IV)/3.) CALL GRUP2(IVV,IV) SPOCK=.TRUE. GO TO 50 112 IF(MMIN.NE.14)GO TO 113 DO 5541 IV=1,LAUNCH IF(IGLER(IV).NE.I7)GO TO 5541 IF(IGLEC(IV).EQ.I8)GO TO 5542 5541 CONTINUE 5542 DO 114 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 114 I8=I7+4 WRITE(I8,115)(INAME(IQ0,IT),IQ0=1,3),(IBOLT(J,JS),J=1,4),IV 115 FORMAT(1X,3A4,1X,4A4,' DESTROYED EAGLE',I3) 114 CONTINUE CALL BOOM(IV) SPOCK=.TRUE. GO TO 50 113 IF(MMIN.GT.18)GOTO 116 WRITE(L,117)(IBOLT(J,JS),J=1,4),I8,I7 117 FORMAT(1X,4A4,'DETONATED MINE AT (',I2,',',I2,')') MMAP(I7,I8)=IBLK GO TO 50 116 IF(MMIN.NE.20)GO TO 118 555 J=I7 IVV=I8 N=2 IV=0 rtvl1=1.5 CALL HORTA(J,IVV,IENTR(IT),IENTC(IT), *rtvl1,itzro,itzro,itzro,itvl1,itzro,itzro) IF(MMIN.EQ.20)GO TO 555 118 IF(I8.EQ.IENTC(IT).AND.I7.EQ.IENTR(IT))GO TO 557 WRITE(L,81)(IBOLT(J,JS),J=1,4),I8,I7 81 FORMAT(1X,4A4,'FAILED TO HIT ANYTHING'/' NOW A MINE AT (',I2,',', *I2,')') MINES=MINES+1 MMAP(I7,I8)=IM(IT) GO TO 50 557 WRITE(L,806)(IBOLT(J,JS),J=1,4) 806 FORMAT(1X,4A4,'LOST') 50 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7-- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - SAREK - C LOGICAL FUNCTION SAREK(J) LOGICAL MUDD COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /G/ZAP(4),ICOLA(4),IROWA(4),LOCK(4),ICOIL(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) DATA FUDGE/0.700619195/ IWOX(X)=IFIX(ALOG((101.-X)*IV*ZAP(IT)/FLOAT(N)/FUDGE-10.4915)) SAREK=.FALSE. 520 CALL RANDO(IV,1,100) LOCK(IT)=0 IF(IGO(IT).EQ.2)IGO(IT)=1 IF(IV.GT.4)GO TO 29 PHASR(IT)=PHASR(IT)*0.75 WRITE(L,31) 31 FORMAT(' PHASER BANKS HAVE SHORT-CIRCUITED AND ARE REDUCED'/' TO 3 */4 THEIR ORIGINAL ENERGY') GO TO 50 29 IF(IV.GT.8)GO TO 1010 ICOIL(IT)=1 WRITE(L,1011) 1011 FORMAT(' MAIN COIL BURNOUT IN THE PHASER BANKS-'/' PHASERS ARE NOW *INOPERATIVE UNTIL REPAIRS ARE COMPLETE') GO TO 50 1010 N=DI(IENTR(IT),IENTC(IT),IROWA(IT),ICOLA(IT)) IF(N.EQ.0)GO TO 125 J=IROWA(IT)-IENTR(IT) IV1=ICOLA(IT)-IENTC(IT) IVV=0 DO 123 I=1,4 IF(ICHOE(I).EQ.0)GO TO 123 IF(I.EQ.IT)GO TO 123 I7=IENTR(I)-IENTR(IT) I8=IENTC(I)-IENTC(IT) IF(MUDD(J,IV1,I7,I8,N))IVV=I 123 CONTINUE DO 780 I=1,8 IF(ICHOS(I).EQ.0)GO TO 780 I7=IKLNR(I)-IENTR(IT) I8=IKLNC(I)-IENTC(IT) IF(MUDD(J,IV1,I7,I8,N))IVV=I+4 780 CONTINUE DO 124 I=1,2 IF(ICHOB(I).EQ.0)GO TO 124 I7=IBASR(I)-IENTR(IT) I8=IBASC(I)-IENTC(IT) IF(MUDD(J,IV1,I7,I8,N))IVV=I+12 124 CONTINUE IF(NUMOUT.EQ.0)GO TO 34 DO 760 I=1,LAUNCH IF(IGLER(I).EQ.0)GO TO 760 I7=IGLER(I)-IENTR(IT) I8=IGLEC(I)-IENTC(IT) IF(MUDD(J,IV1,I7,I8,N))IVV=I+14 760 CONTINUE 34 I=IVV IF(I.GT.0.AND.2.5*FLOAT(N).LE.IV)GO TO 801 125 WRITE(L,33) 33 FORMAT(' PHASER BEAM MISSED') GO TO 50 801 IF(I.GT.4)GO TO 1250 DO 126 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 126 I8=I7+4 WRITE(I8,127)(INAME(IQ0,IT),IQ0=1,3),(INAME(IQ0,I),IQ0=1,3) 127 FORMAT(1X,3A4,' PHASER BEAM HIT ',3A4) 126 CONTINUE IVV=IWOX(DFLCT(I)) CALL GRUP1(IVV,I) GO TO 500 1250 IF(I.GT.12)GO TO 128 I=I-4 IF(I.NE.7)GO TO 135 CALL RANDO(IV1,1,3) IF(IV1.EQ.1)GO TO 135 WRITE(L,776) 776 FORMAT(' PHASER BEAM BOUNCED OFF DOOMSDAY MACHINE') GO TO 50 135 DO 129 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 129 I8=I7+4 WRITE(I8,130)(INAME(IQ0,IT),IQ0=1,3),(IENM2(J,I),J=1,4) 130 FORMAT(1X,3A4,' PHASER BEAM HIT ',4A4) 129 CONTINUE IVV=IWOX(DFLCK(I)) CALL GRUP3(IVV,I) GO TO 500 128 IF(I.GT.14)GO TO 131 I=I-12 DO 132 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 132 I8=I7+4 WRITE(I8,133)(INAME(IQ0,IT),IQ0=1,3),(ISIDE(IQ0,I),IQ0=1,3), *IBASE(I) 133 FORMAT(1X,3A4,' PHASER BEAM HIT ',3A4,' STARBASE',I3) 132 CONTINUE DISTP=DFLCB(I)/3. IVV=IWOX(DISTP) CALL GRUP2(IVV,I) GO TO 500 131 I=I-14 DO 134 I7=1,4 IF(ICHOE(I7).EQ.0)GO TO 134 I8=I7+4 WRITE(I8,1350)(INAME(IQ0,IT),IQ0=1,3),I 1350 FORMAT(1X,3A4,' PHASER BEAM DESTROYED EAGLE',I3) 134 CONTINUE CALL BOOM(I) 500 SAREK=.TRUE. 50 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/26/2000 BY: D.G. C C - MUDD C LOGICAL FUNCTION MUDD(J,IV1,I7,I8,N) MUDD=.FALSE. IF(IV1.EQ.0)GO TO 1014 IF(I8.NE.0)GO TO 1015 1014 IF(IV1.NE.I8)GO TO 780 IF(IABS(J)/J.EQ.IABS(I7)/I7)GO TO 1016 GO TO 780 1015 IF(J.EQ.0)GO TO 1013 IF(I7.NE.0)GO TO 1017 1013 IF(J.NE.I7)GO TO 780 IF(IABS(IV1)/IV1.EQ.IABS(I8)/I8)GO TO 1016 GO TO 780 1017 IF(FLOAT(IV1)/FLOAT(J).NE.FLOAT(I8)/FLOAT(I7))GO TO 780 IF(IABS(IV1)/IV1.NE.IABS(I8)/I8)GO TO 780 1016 MMIN=SQRT(FLOAT(I8**2+I7**2)) IF(MMIN.GT.N)GO TO 780 J=I7 IV1=I8 N=MMIN MUDD=.TRUE. 780 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - HARPO - C LOGICAL FUNCTION HARPO(IBORD,NUM,IROW,ICOL) LOGICAL CHICO COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /B/NDEAB(2),IPHOB(2),IONB(2),IGOB(2),IFIB(2) COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /Q/IARMZ(6),INDUZ,IXRYZ,IMAGZ,IMAGRZ,IABSZ,ISTAZ,INVIZ(4), *ICLOZ,IONNO,IPLANZ,IRUNZ,IDEVZ,IDRIZ,IMAXZ COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25) COMMON /S/IBPOB(8),IBPOE(25) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) COMMON /V/IWEB(2),IWEBZ,INVIS(4) HARPO=.FALSE. IBORD=0 JTK=7 IF(JS.EQ.2)JTK=26 I8=0 IF(MA(IT,JTK).LT.9)GO TO 100 2 WRITE(L,3) 3 FORMAT(' TRANSPORTER ROOMS DESTROYED - CANNOT BEAM A BOARDING * PARTY') 5 RETURN 100 IF(NUM.EQ.0)RETURN IF(NUM.LE.NDEAD(IT))GO TO 301 119 WRITE(L,118) 118 FORMAT(' NUMBER IN PARTY GREATER THAN CREW ONBOARD -OPERATION CANC *ELLED') RETURN 301 IF((IENTC(IT)-ICOL)**2+(IENTR(IT)-IROW)**2.LE.25)GO TO 302 102 WRITE(L,103) 103 FORMAT(' BOARDING TARGET OUT OF TRANSPORTER RANGE -OPERATION CANCE *LLED') RETURN 302 IF(IGO(IT).EQ.2)IGO(IT)=1 WRITE(L,101) 101 FORMAT(' BOARDING PARTY OPERATION NOW COMMENCING') DO 104 I=1,8 IF(IROW.EQ.IKLNR(I).AND.ICOL.EQ.IKLNC(I))GO TO 105 104 CONTINUE DO 215 I=1,4 IF(IROW.EQ.IENTR(I).AND.ICOL.EQ.IENTC(I))GO TO 303 215 CONTINUE IF(MMAP(IROW,ICOL).EQ.IGLE)GO TO 130 IF(MMAP(IROW,ICOL).EQ.ISTAR)GO TO 107 IF(NUM.LT.0)RETURN WRITE(L,106) 106 FORMAT(' BOARDING PARTY MATERIALIZED IN DEEP SPACE -ALL HAVE PERIS *HED') NDEAD(IT)=NDEAD(IT)-NUM RETURN 105 IF(I.NE.7)GO TO 304 WRITE(L,113) 113 FORMAT('TRANSPORTER BEAM BOUNCED OFF DOOMSDAY MACHINE') 500 IF(NUM.GT.0)NDEAD(IT)=NDEAD(IT)-NUM RETURN 304 IF(.NOT.CHICO(NUM,ICOL,IROW,IBPOB(I),DFLCK(I),IBPSB(I),IBPOB(7), *NDEAD(IT),1))RETURN HARPO=.TRUE. IF(IBPOB(I).NE.0)GO TO 135 CALL TPAU(I) 135 CALL OXMYX IF(I.NE.6)GO TO 143 IPLANZ=1 IRUNZ=150 IDEVZ=0 143 RETURN 303 IF(I.NE.IT)GO TO 306 WRITE(L,111) 111 FORMAT(' BOARDING PARTY MATERIALIZED IN OUR SHIP') HARPO=.TRUE. RETURN 306 I6=(IBPSC(I)+1)/2 IF(.NOT.CHICO(NUM,ICOL,IROW,NDEAD(I),DFLCT(I),I6,I5,NDEAD(IT),2)) *RETURN HARPO=.TRUE. GO TO 135 130 DO 131 I=1,LAUNCH IF(IGLER(I).EQ.0)GO TO 131 IF(ICOL.EQ.IGLEC(I).AND.IROW.EQ.IGLER(I))GO TO 132 131 CONTINUE 132 DISTP=0. IF(.NOT.CHICO(NUM,ICOL,IROW,IBPOE(I),DISTP,IBPSE(I),NUME(IS),NDEAD *(IT),3))GO TO 137 HARPO=.TRUE. IF(IBPOE(I).LE.20)GO TO 308 WRITE(L,141)I 141 FORMAT(' SO MANY PEOPLE HAVE MATERIALIZED ONTO EAGLE',I3,' THAT IT * HAS BURST') GO TO 142 137 IF(DISTP.GE.0)RETURN 142 WRITE(L,136)I 136 FORMAT(' EAGLE',I3,' DESTROYED') HARPO=.FALSE. CALL BOOM(I) RETURN 308 IF(IBPOE(I).EQ.0)CALL TPRING(I) RETURN 107 DO 210 I=1,2 IF(IROW.EQ.IBASR(I).AND.ICOL.EQ.IBASC(I))GO TO 307 210 CONTINUE IF(NUM.LT.0)GO TO 309 WRITE(L,108) 108 FORMAT(' BOARDING PARTY MATERIALIZED IN A STAR -ALL HAVE SIZZLED') GO TO 500 309 WRITE(L,204) 204 FORMAT(' 2 TRANSPORTER TECHNICIANS KILLED WHEN PLASMA FROM STAR MA *TERIALIZED'/' IN TRANSPORTER CHAMBER') NDEAD(IT)=NDEAD(IT)-2 RETURN 307 IF(.NOT.CHICO(NUM,ICOL,IROW,NDEAB(I),DFLCB(I),IBPSS(I),I5,NDEAD(IT *),4))RETURN HARPO=.TRUE. IF(NUM.LT.0.AND.NDEAB(I).EQ.0)WRITE(L,213)ISIDE(1,I),ISIDE(2,I), *IBASE(I) 213 FORMAT(1X,2A5,' STARBASE',I3,' EVACUATED') RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C C - TPRING - C C THIS SUBROUTINE WAS HAND TYPED BY DG NOV. 17/1999 C SUBROUTINE TPRING(J) COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) DO 142 IV=1,4 IF(ICHOE(IV).EQ.0)GO TO 142 I7=IV+4 WRITE(I7,208)J 208 FORMAT(' CONTROL OF EAGLE',I3,' HAS BEEN LOST') 142 CONTINUE II(IBPSE(J))=II(IBPSE(J))-1 NUME(IBPSE(J))=NUME(IBPSE(J))-1 IBPSE(J)=0 I3=I3+1 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - CHICO - C LOGICAL FUNCTION CHICO(NUM,ICOL,IROW,IHORDE,DEFLT,ISID,ICNT, *IFROM,J) LOGICAL ZEPPO COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) CHICO=.FALSE. IF(ISID.NE.IS)GO TO 100 IF(NUM.GT.0)GO TO 50 IF(IHORDE+NUM.GE.0)GO TO 10 WRITE(L,2) 2 FORMAT(' NUMBER IN PARTY GREATER THAN CREW ONBOARD -OPERATION CANC *ELLED') RETURN 10 IF(J.NE.2)GO TO 1 I8=IBPSC(I)+4 IV=-NUM WRITE(I8,13)INAME(1,IT),INAME(2,IT),IV 13 FORMAT(' DO YOU WISH THE ',2A5,' TO BEAM OFF',I5,' OF YOUR CREW?') READ(I8,14)NA 14 FORMAT(A1) IF(NA.EQ.'Y')GO TO 1 WRITE(L,15)INAME(1,I),INAME(2,I) 15 FORMAT(1X,2A5,' CAPTAIN DOES NOT WANT TO SPARE HIS CREW') RETURN 1 IHORDE=IHORDE+NUM IFROM=IFROM-NUM CHICO=.TRUE. RETURN 50 WRITE(L,51)NUM 51 FORMAT(' CREW ON SHIP REINFORCED BY',I4) IF(J.EQ.4.AND.IHORDE.EQ.0)II(IS)=II(IS)+1 IF(J.NE.2)GO TO 1 I8=IBPSC(I)+4 IF(ICHOE(I).NE.2)GO TO 11 ICHOE(I)=1 ISURR(I)=0 II(IS)=II(IS)+1 IJ(IS)=IJ(IS)+1 WRITE(I8,52)INAME(I,IT),INAME(2,IT) 52 FORMAT(' OUR SHIP HAS BEEN REINFORCED BY THE ',2A5,' YOU ARE BACK *IN CONTROL') GO TO 1 11 WRITE(I8,12)INAME(1,IT),INAME(2,IT) 12 FORMAT(' OUR SHIP HAS BEEN REINFORCED BY THE ',2A5) GO TO 1 100 IF(NUM.GT.0)GO TO 140 WRITE(L,141) 141 FORMAT(' NONE OF OUR CREW IS ON THE TARGET SHIP -OPERATION CANCELL *ED') RETURN 140 I7=(120.-(MA(IT,JTK)+1)*DEFLT)*FLOAT(NUM)/100./DI(IENTC(IT),IENTR( *IT),ICOL,IROW) IF((DEFLT.LE.10.0.AND.MA(IT,JTK).LE.4).OR.(I7.GT.NUM))I7= *(0.95*FLOAT(NUM)) IFROM=IFROM-NUM IF(I7.LT.0)I7=0 WRITE(L,101)I7 101 FORMAT(1X,I4, ' OF THE BOARDING PARTY HAVE SURVIVED SO FAR') IF(I7.GT.0)GO TO 102 105 IF(DEFLT.LT.0)RETURN WRITE(L,103) 103 FORMAT(' THE ENEMY HAS CRUSHED THE BOARDING PARTY') RETURN 102 IF(J.NE.3)GO TO 104 IF(I7.LT.2)GO TO 105 WRITE(L,106)I 106 FORMAT(' THE BOARDING PARTY HAS SEIZED CONTROL OF EAGLE',I3) GO TO 122 104 IF(J.EQ.2)GO TO 200 IF(ISID.NE.0)GO TO 130 CALL RANDO(IV,1,200) IF(IV.GT.I7)GO TO 105 GO TO 120 130 CALL RANDO(IV,1,100) IF(IV.LE.50*I7/IHORDE)GO TO 120 CALL RANDO(IV,0,I7/2) IHORDE=IHORDE-IV GO TO 105 120 WRITE(L,121) 121 FORMAT(' THE BOARDING PARTY HAS SEIZED CONTROL OF THE ENEMY SHIP') 122 CALL RANDO(IV,1,7) IF(IV.NE.1)GO TO 123 WRITE(L,124) 124 FORMAT(' BUT AS THEIR LAST ACT, THE ENEMY HAS PLANTED A'/' SELF-DE *STRUCT DEVICE ON THEIR SHIP, WHICH HAS EXPLODED') DEFLT=-1. RETURN 123 IF(IV.NE.2)GO TO 125 204 WRITE(L,126) 126 FORMAT(' BUT THE BOARDING PARTY HAS MUTINIED AND DEFECTED TO THE E *NEMY') IF(ISID.NE.0)IHORDE=IHORDE+I7 RETURN 125 IF(ISID.NE.0)GO TO 127 I3=I3-1 ICNT=ICNT+1 GO TO 128 127 IF(J.EQ.4.AND.IHORDE.EQ.0)GO TO 128 II(ISID)=II(ISID)-1 IF(J.NE.3)GO TO 128 NUME(ISID)=NUME(ISID)-1 NUME(IS)=NUME(IS)+1 128 ISID=IS II(ISID)=II(ISID)+1 IHORDE=I7 CHICO=.TRUE. RETURN 200 I8=IBPSC(I)+4 IF(ISURR(I).EQ.1)GO TO 235 IF(ICHOE(I).EQ.2)GO TO 235 N=(I+1)/2 A=1.0 CALL RANDO(IDEKU,1,33) IDEKL=IDEKU WRITE(I8,201)I7 201 FORMAT(1X,I4,' ENEMY TROOPS HAVE MATERIALIZED ONTO WHAT''S LEFT * OF ') CALL TANRU(IDEKU) CALL RANDO(IV,1,6) IF(IV.NE.5)GO TO 202 WRITE(I8,203) 203 FORMAT(' BUT THEY HAVE DEFECTED TO JOIN YOUR CREW') GO TO 204 202 IF(.NOT.ZEPPO(IDEKU,IDEKL,DEFLT,ISID,IHORDE,IFROM))GO TO 105 235 CHICO=.TRUE. WRITE(L,121) WRITE(I8,205) 205 FORMAT(' INTRUDERS HAVE TAKEN OVER OUR SHIP') IF(ICHOE(I).EQ.2)GO TO 206 II(ISID)=II(ISID)-1 IJ(ISID)=IJ(ISID)-1 206 IBPSC(I)=IBPSC(IT) ICHOE(I)=1 ISURR(I)=0 IHORDE=I7 II(IS)=II(IS)+1 IJ(IS)=IJ(IS)+1 RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - ZEPPO - C LOGICAL FUNCTION ZEPPO(IDEKU,IDEKL,DEFLT,ISID,IHORDE,IFROM) DIMENSION KODOS(7) COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /J/KODE(2,8),STATIC(4) COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) ZEPPO=.FALSE. DO 21 IV=1,7 21 KODOS(IV)=0 NODEK=1 IF(I7.LE.15)GO TO 36 25 WRITE(I8,27) 27 FORMAT(' HERE IS A LIST OF YOUR INTRUDER CONTROL COMANDS-'/ *' 0-PRINT THESE INSTRUCTIONS'/' 1-SOUND INTRUDER ALERT'/ *' 2-EVACUATE PERSONNEL FROM ENEMY-HELD AREAS'/ *' 3-CLOSE SECTION ISOLATION DOORS/SEAL OFF ENEMY-HELD AREAS'/ *' 4-FLOOD ENEMY-HELD AREAS WITH NEURAL GAS'/ *' 5-FLUSH RADIOACTIVE WASTE INTO ENEMY-HELD AREAS'/ *' 6-DEPRESSURIZE ENEMY-HELD AREAS'/' 7-DISPATCH SECUTY TEAMS TO * ENEMY-HELD AREAS'/' 8-ACTIVATE SELF-DESTRUCT MECHANISM'/ *' 9-OFFER NO RESISTANCE - SURRENDER') WRITE(L,28) 28 FORMAT(' STANDBY WHILE THE ENEMY FORCES TRY TO DEFEND THEIR SHIP') KORAX=1 ISPRED=4 ADED=1.0 BDED=0.95 GO TO 32 34 I7=FLOAT(I7)*BDED IF(I7.GT.IHORDE)GO TO 22 IF(I7.LE.15)GO TO 36 22 IF(I7.LE.NODEK)GO TO 32 A=1.0 WRITE(I8,29) 29 FORMAT(' INTRUDERS HAVE SPREAD INTO-') DO 30 MMIN=1,ISPRED*KORAX IF(MMIN.GT.ISPRED/2)GO TO 31 IF(IDEKL.GE.33)GO TO 31 33 IDEKL=IDEKL+1 NODEK=NODEK+1 CALL TANRU(IDEKL) GO TO 30 31 IF(NODEK.GE.33)GO TO 30 IF(IDEKU.LE.1)GO TO 33 IDEKU=IDEKU-1 CALL TANRU(IDEKU) NODEK=NODEK+1 30 CONTINUE KORAX=1 32 MMIN=ISPRED*IHORDE/FLOAT(33-NODEK)+5 CALL RANDO(IV,0,MMIN) IV=IV*A*ADED IHORDE=IHORDE-IV IF(IHORDE.LE.0.OR.NODEK.GE.33)GO TO 35 39 WRITE(I8,37)IHORDE,I7 37 FORMAT(' CREW REMAINING=',I4,' INTRUDERS REMAINING=',I4/' ENTER Y *OUR INTRUDER CONTROL COMMAND:',$) READ(I8,38,ERR=410)IV 38 FORMAT(I1) IF(IV.LT.1)GO TO 41 IF(IV.EQ.9)GO TO 35 IF(IV.EQ.8)GO TO 49 IF(IV.EQ.7)GO TO 48 IF(KODOS(IV).EQ.0)GO TO 40 WRITE(I8,401) 401 FORMAT(' YOU''VE ALREADY DONE THAT') GO TO 39 41 WRITE(I8,27) GO TO 39 410 IV=L L=I8 CALL ILLDAT L=IV GO TO 39 40 KODOS(IV)=1 GO TO (42,43,44,45,46,47),IV 42 WRITE(I8,50) 50 FORMAT(' INTRUDER ALERT SOUNDED') ADED=ADED*0.8 GO TO 34 43 WRITE(I8,51) 51 FORMAT(' PERSONNEL EVACUATED') KORAX=2 ADED=ADED*0.6 GO TO 34 44 WRITE(I8,52) 52 FORMAT(' ENEMY-HELD AREAS SEALED OFF- ENEMY NOW RESORTING TO BLAS *TING THROUGH BULKHEADS') ISPRED=ISPRED/2 GO TO 34 45 WRITE(I8,53) 53 FORMAT(' ENEMY-HELD AREAS GASSED') CALL RANDO(MMIN,85,95) I7=I7*(FLOAT(MMIN)/100.) GO TO 34 46 WRITE(I8,54) 54 FORMAT(' ENEMY AREAS FLOODED WITH RADIOACTIVE WASTE') CALL RANDO(MMIN,77,85) ADED=ADED+FLOAT(MMIN)/100. BDED=BDED*FLOAT(MMIN)/100. GO TO 34 47 WRITE(I8,55) 55 FORMAT(' ENEMY AREAS DEPRESSURIZED') ADED=ADED*1.3 BDED=BDED*0.7 GO TO 34 480 IV=L L=I8 CALL ILLDAT L=IV 48 WRITE(I8,56) 56 FORMAT(' ENTER NUMBER OF CREW TO MAKE UP THE SECURITY FORCES') READ(I8,57,ERR=480)MMIN 57 FORMAT(I7) IF(MMIN.LT.0.OR.MMIN.GT.IHORDE)GO TO 48 CALL RANDO(IV,1,100) IF(IV.LE.50*MMIN/I7)GO TO 36 WRITE(I8,59) 59 FORMAT(' ENEMY FORCES HAVE WIPED OUT OUR SECURITY FORCES') IHORDE=IHORDE-MMIN CALL RANDO(IV,0,IFIX(MMIN*0.75)) I7=I7-IV GO TO 34 49 IF(KODOS(7).EQ.0)GO TO 58 WRITE(I8,60) 60 FORMAT(' THE SELF-DESTRUCT ROUTINE DOES NOT WORK') GO TO 39 58 IF(IDEKU.GT.ISID)GO TO 61 WRITE(I8,62) 62 FORMAT(' SINCE THE BRIDGE HAS BEEN CAPTURED,') WRITE(I8,60) GO TO 39 61 CALL RANDO(IV,1,3) KODOS(7)=1 IF(IV.GT.2)GO TO 63 WRITE(I8,60) GO TO 34 63 DO 75 IV=1,4 IF(ICHOE(IV).EQ.0)GO TO 75 I8=IV+4 WRITE(I8,64)INAME(1,IT),INAME(2,IT) 64 FORMAT(1X,2A5,' SELF-DESTRUCT ROUTINE ACTIVATED') 75 CONTINUE DEFLT=-1. RETURN 36 WRITE(I8,65) 65 FORMAT(' OUR FORCES HAVE VANQUISHED THE INTRUDERS') CALL RANDO(IV,1,5) IF(IV.GT.1)GO TO 69 WRITE(I8,66) 66 FORMAT(' BUT THE LAST INTRUDER DETONATED A BOMB BEFORE HIS CAPTURE *DAMAGE REPORT-') DO 67 IV=1,4 IF(ICHOE(IV).EQ.0)GO TO 67 IF(IV.EQ.I)GO TO 67 MMIN=IV+4 WRITE(MMIN,68)INAME(1,I),INAME(2,I) 68 FORMAT(' A BOMB HAS BEEN DETONATED IN THE ',2A5,'-DAMAGE REPORT-') 67 CONTINUE IVV=8 DFLCT(I)=DEFLT NDEAD(I)=IHORDE CALL GRUP1(IVV,I) DEFLT=DFLCT(I) IHORDE=NDEAD(I) 69 IF(I.GT.2)GO TO 70 WRITE(I8,71) 71 FORMAT(' USING TRUTH DRUGS, PSYCHOTRICORDERS, AND VERIFIER * SCANS,') GO TO 72 70 WRITE(I8,73) 73 FORMAT(' USING MIND-SIFTERS AND AGONIZERS,') 72 WRITE(I8,74)INAME(1,IT),INAME(2,IT),IFROM,DFLCT(IT),PHASR(IT), *TWARP(IT),IPHOT(IT),ITEMP(IT) 74 FORMAT(' WE HAVE UNCOVERED THE FOLLOWING INFORMATION FROM THE PRIS *ONERS-'/' THEY ARE FROM THE ',2A5,' THEIR SHIP''S CREW IS NOW',I4, *'DEFLECTORS= ',F11.7,' UNITS. PHASERS=',F13.7,' UNITS'/' MAX. WARP *=',F10.7,'. NO. TORPEDOES/DISRUPTORS=',I3,' ENGINE TEMP=',I5, *' DEGREES') CALL RANDO(IV,1,3) IF(IV.GT.1)RETURN CALL RANDO(IV,1,8) KODE(IS,IV)=1 RETURN 35 ZEPPO=.TRUE. RETURN END C DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C TANRU - C SUBROUTINE TANRU(NOMAD) COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) CALL FORBIN(N,NOMAD,I8,' ') IF(I.GT.2)GO TO 30 IF(NOMAD.EQ. 4)A=A+0.2 IF(NOMAD.EQ. 5)A=A+0.3 IF(NOMAD.EQ. 6)A=A+2.2 IF(NOMAD.EQ. 7)A=A+1.2 IF(NOMAD.EQ.21)A=A+0.3 IF(NOMAD.EQ.22)A=A+0.3 IF(NOMAD.EQ.23)A=A+0.2 RETURN 30 IF(NOMAD.EQ. 8)A=A+1.8 IF(NOMAD.EQ.10)A=A+0.1 IF(NOMAD.EQ.11)A=A+0.2 IF(NOMAD.EQ.17)A=A+0.4 IF(NOMAD.EQ.19)A=A+1.1 IF(NOMAD.EQ.21)A=A+0.4 IF(NOMAD.EQ.22)A=A+0.9 RETURN END C DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C LARRY - C LOGICAL FUNCTION LARRY(J) LOGICAL NOTRAC COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /P/IPULL(4),IPUSH(4),PULL(4),PUSH(4),IPULLR(4),IPULLC(4), *IPUSHR(4),IPUSHC(4) LARRY=.TRUE. IF(NOTRAC(IT))GO TO 205 200 IPULL(IT)=0 IF(DI(IENTC(IT),IENTR(IT),IPULLC(IT),IPULLR(IT)).LE.DISTP)GOTO 202 WRITE(L,201) 201 FORMAT(' TARGET OUT OF TRACTOR RANGE') GO TO 205 202 IF(PULL(IT).GT.TWARP(IT))PULL(IT)=TWARP(IT) TWARP(IT)=TWARP(IT)-PULL(IT) IF(IGO(IT).EQ.2)IGO(IT)=1 WRITE(L,203) 203 FORMAT(' TRACTOR BEAM ON') NA=MMAP(IPULLR(IT),IPULLC(IT)) IF(NA.EQ.IGLE)GO TO 2040 IF(NA.EQ.IBLK.OR.NA.EQ.III.OR.NA.EQ.ISTAR)GO TO 205 IF(NA.EQ.IEE(IT))GO TO 205 DO 269 IV=1,4 IF(NA.EQ.IM(IV))GO TO 2040 269 CONTINUE IPULL(IT)=1 GO TO 205 2040 RAD=PULL(IT)*10. BERNG=ANG(IENTR(IT)-IPULLR(IT),IENTC(IT)-IPULLC(IT))* *3.14159265/180. CALL MOE(IPULLC(IT),IPULLR(IT),RAD,BERNG) IF(DISTP/10.0.LT.PULL(IT))TWARP(IT)=TWARP(IT)+PULL(IT)-DISTP/10. RETURN 205 LARRY=.FALSE. RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 - C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - CURLY - C LOGICAL FUNCTION CURLY(J) LOGICAL NODEFL COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /P/IPULL(4),IPUSH(4),PULL(4),PUSH(4),IPULLR(4),IPULLC(4), *IPUSHR(4),IPUSHC(4) CURLY=.TRUE. IF(NODEFL(IT))GO TO 305 300 IPUSH(IT)=0 AJUST=DI(IENTC(IT),IENTR(IT),IPUSHC(IT),IPUSHR(IT)) IF(AJUST.LE.DISTP)GO TO 302 WRITE(L,301) 301 FORMAT(' TARGET OUT OF DEFLECTOR RANGE') GO TO 305 302 IF(PUSH(IT).GT.DFLCT(IT))PUSH(IT)=DFLCT(IT) DFLCT(IT)=DFLCT(IT)-PUSH(IT) IF(IGO(IT).EQ.2)IGO(IT)=1 WRITE(L,303) 303 FORMAT(' DEFLECTOR BEAM ON') NA=MMAP(IPUSHR(IT),IPUSHC(IT)) IF(NA.EQ.IGLE)GO TO 304 IF(NA.EQ.IBLK.OR.NA.EQ.III.OR.NA.EQ.ISTAR)GO TO 305 IF(NA.EQ.IEE(IT))GO TO 305 DO 284 IV=1,4 IF(NA.EQ.IM(IV))GO TO 304 284 CONTINUE IPUSH(IT)=1 GO TO 305 304 RAD=PUSH(IT) IF(AJUST+RAD.GT.DISTP)RAD=DISTP-AJUST BERNG=ANG(IPUSHR(IT)-IENTR(IT),IPUSHC(IT)-IENTC(IT))*3.141592615/ *180. CALL MOE(IPUSHC(IT),IPUSHR(IT),RAD,BERNG) IF(DISTP.LT.PUSH(IT))DFLCT(IT)=DFLCT(IT)+PUSH(IT)-DISTP RETURN 305 CURLY=.FALSE. RETURN END C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K. 7 -- C CONVERTED TO PC BY: DAN GAHLINGER C TYPE-EXACT CHECK 04/27/2000 BY: D.G. C C - MOE - C SUBROUTINE MOE(IPUC,IPUR,RAD,BERNG) COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG, *IGNORE,IO,IGOL(80) COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2) COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4) COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25), *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2) COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4), *NOMOV(4) COMMON /P/IPULL(4),IPUSH(4),PULL(4),PUSH(4),IPULLR(4),IPULLC(4), *IPUSHR(4),IPUSHC(4) COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2) COMMON /U/LAUNCH,NUMOUT,NUME(2) KLIGAT(X)=IFIX(ALOG((101.-X)*FLOAT(IV))/0.700619195-1.8185) 204 N=4 CALL RANDO(IV,20,100) IIV=1 IF(MMAP(IPUR,IPUC).EQ.IGLE)IIV=2 IGNORE=1 IF(IIV.EQ.1)GO TO 206 IGNORE=0 DO 209 IVV=1,LAUNCH IF(IPUC.EQ.IGLEC(IVV).AND.IPUR.EQ.IGLER(IVV))GO TO 206 209 CONTINUE itzro=0 206 CALL HORTA(IPUR,IPUC,itzro,itzro,RAD,BERNG,itzro, *itzro,IGNORE,itzro,itzro) IF(MMIN.GT.4)GO TO 308 DO 270 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 270 I81=I71+4 IF(IIV.EQ.2)GO TO 271 IF(MMAP(I7,I8).EQ.IEE(IT))GO TO 221 WRITE(I81,272)INAME(1,MMIN),INAME(2,MMIN) 272 FORMAT(' MINE HIT ',2A5,'-DAMAGE REPORT-') GO TO 270 271 WRITE(I81,273)IVV,INAME(1,MMIN),INAME(2,MMIN) 273 FORMAT(' EAGLE',I3,' HIT THE ',2A5,'-DAMAGE REPORT-') 270 CONTINUE CALL GRUP1(KLIGAT(DFLCT(MMIN)),MMIN) GO TO 215 308 MMIN=MMIN-4 IF(MMIN.GT.8)GO TO 205 DO 274 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 274 I81=I71+4 IF(IIV.EQ.2)GO TO 210 WRITE(I81,207)(IENM2(I,MMIN),I=1,4) 207 FORMAT(' MINE HIT ',4A4,'-DAMAGE REPORT-') GO TO 274 210 WRITE(I81,211)IVV,(IENM2(I,MMIN),I=1,4) 211 FORMAT(' EAGLE',I3,' HIT ',4A4,' -DAMAGE REPORT-') 274 CONTINUE CALL GRUP3(KLIGAT(DFLCK(MMIN)),MMIN) GO TO 215 205 IF(MMIN.GT.9)GO TO 224 DO 275 I71=1,2 IF(IBASR(I71).NE.I7)GO TO 275 IF(IBASC(I71).EQ.I8)GO TO 276 275 CONTINUE GO TO 220 276 MMIN=I71 DO 277 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 277 I81=I71+4 IF(IIV.EQ.2)GO TO 278 WRITE(I81,279)ISIDE(1,MMIN),ISIDE(2,MMIN),IBASE(MMIN) 279 FORMAT(' MINE HIT ',2A5,' STARBASE',I3,'-DAMAGE REPORT-') GO TO 277 278 WRITE(I81,280)IVV,ISIDE(1,MMIN),ISIDE(2,MMIN),IBASE(MMIN) 280 FORMAT(' EAGLE',I3,' HIT ',2A5,' STARBASE',I3,'-DAMAGE REPORT-') 277 CONTINUE CALL GRUP2(KLIGAT(DFLCB(MMIN)/3.),MMIN) GO TO 215 220 IF(IIV.EQ.2)GO TO 227 WRITE(L,228) 228 FORMAT(' MINE HAS COLLIDED WITH A STAR') GO TO 215 227 DO 282 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 282 I81=I71+4 WRITE(I81,229)IVV 229 FORMAT(' EAGLE',I3,' HAS COLLIDED WITH A STAR') 282 CONTINUE GO TO 215 221 WRITE(L,231) 231 FORMAT(' OUR SHIP HAS RECOVERED A MINE') IPHOT(IT)=IPHOT(IT)+1 GO TO 215 222 IF(MMIN.GT.15)GO TO 225 DO 283 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 283 I81=I71+4 WRITE(I81,233)IVV 233 FORMAT(' EAGLE',I3,' DESTROYED IN ION STORM') 283 CONTINUE GO TO 215 223 IF(MMIN.GT.14)GO TO 222 MMAP(I7,I8)=IBLK IF(IIV.EQ.2)GO TO 234 WRITE(L,235) 235 FORMAT(' MINE DESTROYED ON COLLISION WITH ANOTHER MINE') GO TO 215 234 DO 281 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 281 I81=I71+4 WRITE(I81,236)IVV 236 FORMAT(' EAGLE',I3,' DESTROYED WHEN HIT WITH MINE') 281 CONTINUE GO TO 215 224 IF(MMIN.GT.10)GO TO 223 DO 237 I=1,LAUNCH IF(I7.EQ.IGLER(I).AND.I8.EQ.IGLEC(I))GO TO 238 237 CONTINUE 238 DO 242 I71=1,4 IF(ICHOE(I71).EQ.0)GO TO 242 I81=I71+4 IF(IIV.EQ.1)GO TO 240 WRITE(I81,239)IVV,I 239 FORMAT(' EAGLE',I3,' COLLIDED WITH EAGLE',I3/' BOTH EAGLES * DESTROYED') GO TO 242 240 WRITE(I81,241)I 241 FORMAT(' EAGLE',I3,' DESTROYED WHEN IT HIT A MINE') 242 CONTINUE CALL BOOM(I) GO TO 215 225 IF(MMIN.GT.16)GO TO 226 N=2 243 I71=I7 I81=I8 itzro=0 itvl1=1 rtzro=0.0 rtvl1=1.5 CALL HORTA(I71,I81,IENTR(IT),IENTC(IT),rtvl1, *itzro,itzro,itzro,itvl1,itzro,itzro) IF(MMIN.EQ.20)GO TO 243 226 MMAP(IPUR,IPUC)=IBLK IF(IIV.EQ.2)GO TO 244 MMAP(I7,I8)=IM(IT) WRITE(L,245)I8,I7 245 FORMAT(' MINE MOVED TO (',I2,',',I2,')') GO TO 400 244 MMAP(I7,I8)=IGLE IGLER(IVV)=I7 IGLEC(IVV)=I8 WRITE(L,246)IVV,I8,17 246 FORMAT(' EAGLE',I3,' MOVED TO (',I2,',',I2,')') GO TO 400 215 IF(IIV.EQ.2)GO TO 247 MMAP(IPUR,IPUC)=IBLK GO TO 400 247 CALL BOOM(IVV) GO TO 400 400 RETURN END