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
