C====================================================================
C                                                                   *
C                            TREK7 MODULE G                         *
C                                                                   *
C            -- CONVERTED TO PC BY: DAN GAHLINGER --                *
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C                                                                   *
C         MISCALLANEOUS ROUTINES                                    *
C                                                                   *
C         ENTEMP    BALOK    TALOS    ENEMY    MOLOCH    DONE       *
C         THOLIA    KNUTH    BLISH    FINNEY   SAURON    MCCOY      *
C         RPAIR                                                     *
C                                                                   *
C====================================================================

C            -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C
C                               - ENTEMP -
C
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C DG NOV. 15/1999 - CALL_LIB$EOL AND SO FORTH ARE NOT PART OF ORIG PRINTOUT
C CALL_LIB$EOL AND SO FORTH HAVE THUS BEEN REMOVED TO REFLECT ORIG SOURCE
C
      SUBROUTINE ENTEMP(MOVE)
      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),ITCCL(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)
        COMMON /TOM/ITOM
      IF(MOVE.GT.0)GO TO 3331
      IF(ITEMP(IT).EQ.4000)GO TO 546
      ITEMP(IT)=ITEMP(IT)-600
      GO TO 3332
3331  CALL RANDO(I7,75,125)
      IF(WARP(IT).GT.6.)GO TO 3333
      ITEMP(IT)=ITEMP(IT)+(WARP(IT)-6.)*I7
      GO TO 3332
3333  ITEMP(IT)=ITEMP(IT)+(WARP(IT)-6.)*FLOAT(I7)*(FLOAT(MA(IT,29))/9.+
     *1.)*(FLOAT(MA(IT,30))/9.+1.)
3332  IF(ITEMP(IT).LT.4000)ITEMP(IT)=4000
      WRITE(L,3334)ITEMP(IT)
3334  FORMAT(' ENGINE TEMP. = ',I5,' DEGREES')
      IF(ITEMP(IT).LT.5500)GO TO 546
      IF(ITEMP(IT).GT.6200)GO TO 3335
3336  FORMAT(' ENGINES OVERHEATING -TEMPERATURES ARE NEAR CRITICAL')
      GO TO 546
3335  WRITE(L,3337)
3337  FORMAT(' TEMPERATURES ARE BOYOND CRITICAL POINT')
      IF(ITEMP(IT).GE.7500)WRITE(L,3338)
3338  FORMAT(' EXPLOSION IMMINENT!!!')
      CALL RANDO(I7,1,100)
      IF(I7.GT.(ITEMP(IT)-6200)/100)GO TO 546
      I8=MA(IT,29)+MA(IT,30)+1
      CALL RANDO(I7,0,I8)
      J=1
      IF(I7.GT.MA(IT,29))J=2
      IF(MA(IT,28+J).EQ.9)J=3-J
      IF(MA(IT,28+J).GT.0)MANUM(IT)=MANUM(IT)-1
      MA(IT,28+J)=9
      TWARP(IT)=TWARP(IT)-4.5+K(IT,3+J)/2
      IF(TWARP(IT).LT.0)TWARP(IT)=0
      K(IT,3+J)=9
      WRITE(L,3339)J,J
3339  FORMAT(' ENGINEERING HERE SIR - MATTER AND ANTI-MATTER ARE NO WIT
     *HIN RED-ZONE PROXIMITY'/' AUTOMATIC RELAYS CUTTING IN..... NACELLE
     *',I2,' JETTISONNED'/' NACELLE',I2,' HAS EXPLODED - DAMAGE REPORT D
     *UE TO PROXIMITY OF BLAST-')
      DO 162 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 162
      IF(I7.EQ.IT)GO TO 162
      I8=I7+4
      WRITE(I8,1630)(INAME(IQ0,IT),IQ0=1,3),J
1630  FORMAT(1X,3A4,' NACELLE',I2,' HAS EXPLODED - DAMAGE REPORT-')
162   CONTINUE
      IVV=10
      CALL GRUP1(IVV,IT)
546   RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C           TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C - BALOK -
C
      SUBROUTINE BALOK
      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 /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      I7=IBPSS(I)
      IF(IJ(I7).EQ.0)I7=0
      CALL PIKE(IBASR(I),IBASC(I),I7)
      IF(MMIN.EQ.0)GO TO 1
      IF(DISTP.GT.20.)GO TO 1
      DFLCB(I)=DFLCB(I)-5.0
      CALL RANDO(IVV,1,100)
      IF(IVV.LE.DISTP*2.5)GO TO 1
      IF(MMIN.GT.14)GO TO 2
      IF(MMIN.GT.4)GO TO 3
      DO 4 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 4
      I8=I7+4
      WRITE(I8,5)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),
     *(INAME(IQ0,MMIN),IQ0=1,3)
5     FORMAT(/1X,3A4,' STARBASE',I3,' HAS SCORED A HIT ON THE ',3A4,'-DA
     *MAGE REPORT-')
4     CONTINUE
      CALL GRUP1(LIRPA(DFLCT(MMIN),50),MMIN)
      GO TO 1
3     IF(MMIN.GT.6)GO TO 6
      MMIN=MMIN-4
      DO 7 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 7
      I8=I7+4
      WRITE(I8,8)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),
     *(ISIDE(IQ0,MMIN),IQ0=1,3),IBASE(MMIN)
8     FORMAT(/1X,3A4,' STARBASE',I3,' HIT ',3A4,' STARBASE',I3,
     *'-DAMAGE REPORT-')
7     CONTINUE
      CALL GRUP2(LIRPA(DFLCB(MMIN)/3.,50),MMIN)
      GO TO 1
6     MMIN=MMIN-6
      IF(MMIN.NE.7)GO TO 15
      CALL RANDO(I7,1,3)
      IF(I7.EQ.2)GO TO 15
      DO 16 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 16
      I8=I7+4
      WRITE(I8,17)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
17    FORMAT(/1X,3A4,' STARBASE',I3,' PHASERS BOUNCED OFF DOOMSDAY
     * MACHINE')
16    CONTINUE
      GO TO 1
15    DO 9 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 9
      I8=I7+4
      WRITE(I8,18)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),
     *(IENM2(IV,MMIN),IV=1,4)
18    FORMAT(/1X,3A4,' STARBASE',I3,' HIT ',4A4,'-DAMAGE REPORT-')
9     CONTINUE
      CALL GRUP3(LIRPA(DFLCK(MMIN),50),MMIN)
      GO TO 1
2     MMIN=MMIN-14
      DFLCB(I)=DFLCB(I)+4.9
      DO 10 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 10
      I8=I7+4
      WRITE(I8,11)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),MMIN
11    FORMAT(/1X,3A4,' STARBASE',I3,' DESTROYED EAGLE',I3)
10    CONTINUE
      CALL BOOM(MMIN)
1     RETURN
      END


C- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 ---
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C          TYPE-EXACT CHCEK 04/25/2000 BY: D.G.
C- TALOS -
C
      SUBROUTINE TALOS
      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 /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      DO 13 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 13
      I8=I7+4
      WRITE(I8,14)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
14    FORMAT(/' ION STORM DAMAGE TO ',3A4,' STARBASE',I3,' AS FOLLOWS-')
13    CONTINUE
      CALL RANDO(IV,1,20)
      IVV=ALOG((101.-DFLCB(I)/3.)*IV)/0.700619195-3.
      CALL GRUP2(IVV,I)
      RETURN
      END


C - DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C          TYPE-EXACT CHCEK 04/25/2000 BY: D.G.
C
C EEEEE   N   N EFEEE M   M Y   Y
C E       NN  N E     MM MM  Y Y
C EEEE    N N N EEEE  M M M   Y
C E       N  NN E     M   M   Y
C EEEEE   N   N EEEEE M   M   Y
C
      SUBROUTINE ENEMY
      LOGICAL BLISH
      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 /K/IWHO(8),DIST(8),KILLZ,KILLR,KILLD,KILLG,IGOCO(8)
      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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
        COMMON /TOM/ITOM
      LOGICAL MOLOCH
      KOENIG=0
      JTK=0
1101  DO 1100 I=1,8
      ISTAT=0
      IF(I.NE.8)GO TO 11010
      CALL DUNE
11010 IF(ICHOS(I).EQ.0)GO TO 1100
107   GO TO (1103,1104,1105,1106,1107,1109,1108,11090),I
1103  CALL RANDO(IV,45,110)
      GO TO 1109
1104  CALL RANDO(IV,30,100)
      GO TO 1109
1105  CALL RANDO(IV,60,90)
      GO TO 1109
1106  CALL RANDO(IV,35,90)
      GO TO 1109
1107  CALL RANDO(IV,50,100)
      GO TO 1109
1108  CALL RANDO(IV,100,200)
      GO TO 1109
11090 IV=50
1109  CALL PIKE(IKLNR(I),IKLNC(I),IBPSB(I))
      IF(MMIN.EQ.0)GO TO 232
      IF(DIST(I).GE.DISTP)GO TO 3390
      IF(MOLOCH(IWHO(I)))GO TO 3390
      DISTP=DIST(I)
      MMIN=IWHO(I)
      ISTAT=6
3390  IF(I.NE.2)GO TO 378
      DO 360 I7=1,4
      IF(ICHOE(I7).NE.1)GO TO 380
      IF(DI(IENTR(I7),IENTC(I7),IKLNR(2),IKLNC(2)).GT.5.)GO TO 380
      INVIS(I7)=1
      I8=I7+4
      WRITE(I8,381)
381   FORMAT(' THE ROMULAN SHIP IS NOW WITHIN SENSOR RANGE')
      KILLR=2
380   CONTINUE
      IF(KILLR.NE.1)GO TO 339
      IF(DISTP.GT.10.)GO TO 1100
      KILLR=2
      GO TO 339
378   IF(I.EQ.3)CALL THOLIA
      IF(I.NE.7)GO TO 379
      IF(KILLD.EQ.1.AND.DISTP.GT.7.)GO TO 1100
      KILLD=1
      GO TO 339
379   IF(I.NE.6)GO TO 339
      IF(DISTP.GT.KILLZ.AND.DFLCK(6).EQ.100.)GO TO 1100
      CALL KNUTH
339   IF(MMIN.EQ.0)GO TO 1100
      IF(DISTP.GT.25.)GO TO 1100
      IF(I.NE.6)GO TO 33900
360   IF(BLISH(JTK))GO TO 1100
33900 CALL RANDO(IVV,1,100)
      IF(IVV.LE.DISTP*3.)GO TO 232
      IF(MMIN.GT.4)GO TO 340
      MI=MMIN
      DO 341 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 341
      I8=I7+4
      WRITE(I8,342)(IENM2(J,I),J=1,4),(INAME(IQ0,MI),IQ0=1,3)
342   FORMAT(/1X,4A4,' HAS SCORED A HIT ON THE ',3A4,'-DAMAGE REPORT-')
341   CONTINUE
      CALL GRUP1(LIRPA(DFLCT(MI),IV),MI)
      GO TO 232
340   IF(MMIN.GT.6)GO TO 343
      MI=MMIN-4
      DO 344 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 344
      I8=I7+4
      WRITE(I8,330)(IENM2(J,I),J=1,4),(ISIDE(IQ0,MI),IQ0=1,3),IBASE(MI)
330   FORMAT(/1X,4A4,' HAS HIT ',3A4,' STARBASE',I3,'-DAMAGE REPORT-')
344   CONTINUE
      CALL GRUP2(LIRPA(DFLCB(MI)/3.,IV),MI)
      GO TO 232
343   IF(MMIN.GT.14)GO TO 345
      MI=MMIN-6
      IF(MI.NE.7)GO TO 3460
      CALL RANDO(I8,1,3)
      IF(I8.EQ.2)GO TO 3460
      DO 3461 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 3461
      I8=I7+4
      WRITE(I8,3462)(IENM2(J,I),J=1,4)
3462  FORMAT(/1X,4A4,' FIRE BOUNCED OFF DOOMSDAY MACHINE')
3461  CONTINUE
      GO TO 232
3460  DO 346 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 346
      I8=I7+4
      WRITE(I8,347)(IENM2(J,I),J=1,4),(IENM2(J,MI),J=1,4)
347   FORMAT(/1X,4A4,' HAS SCORED A HIT ON ',4A4,'-DAMAGE REPORT-')
346   CONTINUE
      CALL GRUP3(LIRPA(DFLCK(MI),IV),MI)
      GO TO 232
345   MI=MMIN-14
      DO 348 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 348
      I8=I7+4
      WRITE(I8,349)(IENM2(J,I),J=1,4),MI
349   FORMAT(/1X,4A4,' DESTROYED EAGLE',I3)
348   CONTINUE
338   CALL BOOM(MI)
232   IF(I.EQ.6)GO TO 360
1100  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/25/2000 BY: D.G.
C
C - MOLOCH -
C
      LOGICAL FUNCTION MOLOCH(MMIN)
      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 /T/ICHOE(4),ICHOS(8),ICHOB(2)
      MOLOCH=.FALSE.
      IF(MMIN.GT.4)GO TO 1
      IF(ICHOE(MMIN).NE.0.AND.ICHOE(MMIN).NE.3)RETURN
10    MOLOCH=.TRUE.
      RETURN
1     IF(MMIN.GT.6)GO TO 2
      IF(ICHOB(MMIN-4).NE.0)RETURN
      GO TO 10
2     IF(MMIN.GT.14)GO TO 3
      IF(ICHOS(MMIN-6).EQ.1)RETURN
      GO TO 10
3     IF(IGLER(MMIN-14).NE.0)RETURN
      GO TO 10
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C    TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C - DUNE -
C
      SUBROUTINE DUNE
      DIMENSION ISID(3,3)
      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),IBABC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
        COMMON /TOM/ITOM
      DATA ISID/'FEDE','RATI','ON  ','KLIN','GON ','    ',
     *'MOON','BASE','    '/

      IF(NUMOUT.EQ.0)KOENIG=3
1110  KOENIG=KOENIG+1
      GO TO (315,318,316),KOENIG
      GO TO 1100
315   CALL RANDO(IS,1,2)
323   IV=NUME(IS)
320   IF(NUME(IS).EQ.0)GO TO 1110
322   DO 319 I7=1,LAUNCH
      IF(IGLER(I7).NE.0.AND.IBPSE(I7).EQ.IS)GO TO 321
319   CONTINUE
318   IS=3-IS
      GO TO 323
316   IS=0
      IV=NUMOUT-NUME(1)-NUME(2)
      IF(IV.EQ.0)GO TO 1110
      GO TO 322
321   CALL PIKE(IGLER(I7),IGLEC(I7),IBPSE(I7))
      IF(MMIN.EQ.0)GO TO 1110
      IV=FLOAT(IV)*20.*(1.0-DISTP*0.045)
      IF(IV.LE.0)GO TO 1110
      IF(KOENIG.EQ.3)IS=3
      IF(MMIN.GT.4)GO TO 324
      MI=MMIN
      DO 325 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 325
      I8=I7+4
      WRITE(I8,326)(ISID(IQ0,IS),IQ0=1,3),(INAME(IQ0,MI),IQ0=1,3)
326   FORMAT(/1X,3A4,' BOARDED EAGLES HIT ',3A4,'-DAMAGE REPORT-')
325   CONTINUE
      CALL GRUP1(LIRPA(DFLCT(MI),IV),MI)
      GO TO 1110
324   IF(MMIN.GT.6)GO TO 328
      MI=MMIN-4
      DO 329 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 329
      I8=I7+4
      WRITE(I8,3300)(ISID(IQ0,IS),IQ0=1,3),(ISIDE(IQ0,MI),IQ0=1,3),
     *IBASE(MI)
3300  FORMAT(/1X,3A4,' BOARDED EAGLES HIT ',3A4,' STARBASE',I3,'-DAMAGE
     *REPORT-')
329   CONTINUE
      CALL GRUP2(LIRPA(DFLCB(MI)/3.,IV),MI)
      GO TO 1110
328   IF(MMIN.GT.14)GO TO 332
      MI=MMIN-6
      IF(MI.EQ.7)IV=IV/3
      DO 333 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 333
      I8=I7+4
      WRITE(I8,334)(ISID(IQ0,IS),IQ0=1,3),(IENM2(J,MI),J=1,4)
334   FORMAT(/1X,3A4,' BOARDED EAGLES HIT ',4A4,'-DAMAGE REPORT-')
333   CONTINUE
      CALL GRUP3(LIRPA(DFLCK(MI),IV),MI)
      GO TO 1110
332   MI=MMIN-14
      DO 336 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 336
      I8=I7+4
      WRITE(I8,337)(ISID(IQ0,IS),IQ0=1,3),MI
337   FORMAT(/1X,3A4,' BOARDED EAGLES DESTROYED EAGLE ',I2)
336   CONTINUE
      CALL BOOM(MI)
      GO TO 1110
1100  RETURN
      END


C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C TYPE-EXACT CHECKED 04/25/2000 BY: D.G.
C
C - THOLIA -
C
      SUBROUTINE THOLIA
      DIMENSION IWHE(3,2),IIDIM(2)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      DATA IWHE/'THOL','IAN ','    ','KZIN','TI  ','    '/,IIDIM(1)/8/
      IIDIM(2)=IWEBZ
      NN=I/3
      IF(IWEB(NN).NE.0)GO TO 232
      IF(ISTAT.EQ.6)GO TO 232
      IF(DISTP.GT.IIDIM(NN))GO TO 232
      IF(MMIN.GT.4)GO TO 229
      IF(IWEB(3-NN).EQ.MMIN)GO TO 232
      DO 228 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 228
      I8=I7+4
      WRITE(I8,1102)(INAME(IQ0,MMIN),IQ0=1,3),(IWHE(IQ0,NN),IQ0=1,3)
1102  FORMAT(' THE ',3A4,' IS TRAPPED IN A',3A4,'WEB')
228   CONTINUE
      IWEB(NN)=MMIN
      GO TO 232
229   IV=MMIN-6
      IF(IV.LT.1)GO TO 232
      IF(IV.EQ.7)GO TO 232
      IF(IV.GT.8)GO TO 232
      IF(IWEB(3-NN).EQ.MMIN-2)GO TO 232
      DO 227 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 227
      I8=I7+4
      WRITE(I8,314)(IENM2(J,IV),J=1,4),(IWHE(IQ0,NN),IQ0=1,3)
314   FORMAT(' THE ',4A4,' IS TRAPPED IN A',3A4,'WEB')
227   CONTINUE
      IWEB(NN)=MMIN-2
232   RETURN
      END


C DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C - KNUTH -
C
      SUBROUTINE KNUTH
      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 /K/IWHO(8),DIST(8),KILLZ,KILLR,KILLD,KILLG,IGOCO(8)
      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 /Q/IARMZ(6),INDUZ,IXRYZ,IMAGZ,IMAGRZ,IABSZ,ISTAZ,INVIZ(4),
     *ICLOZ,IONNO,IPLANZ,IRUNZ,IDEVZ,IDRIZ,IMAXZ
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      KILLZ=100
      IF(IARMZ(5).EQ.0)GO TO 363
      DO 382 I7=1,4
      INVIZ(I7)=0
      IF(ICHOE(I7).NE.1)GO TO 382
      IF(DI(IENTR(I7),IENTC(I7),IKLNR(6),IKLNC(6)).GT.ICLOZ)GO TO 382
      INVIZ(I7)=1
      I8=I7+4
      WRITE(I8,383)
383   FORMAT(' THE KZINTI SHIP IS NOW WITHIN SENSOR RANGE')
382   CONTINUE
363   IF(IARMZ(3).EQ.0.OR.IWEB(2).NE.0)GO TO 364
      CALL THOLIA
364   IF(IARMZ(6).EQ.0)GO TO 1100
      IF(DISTP.GT.IABSZ)GO TO 1100
      IF(MMIN.GT.14)GO TO 1100
      IF(MMIN.GT.4)GO TO 367
      DO 365 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 365
      I8=I7+4
      WRITE(I8,366)(INAME(IQ0,MMIN),IQ0=1,3)
366   FORMAT(/1X,3A4,' IS WITHIN RANGE OF KZINTI STASIS FIELD')
365   CONTINUE
      PHASR(MMIN)=PHASR(MMIN)-ISTAZ
      DFLCT(MMIN)=DFLCT(MMIN)-ISTAZ/100.
      TWARP(MMIN)=TWARP(MMIN)-ISTAZ/1000.
      IF(PHASR(MMIN).LT.0)PHASR(MMIN)=0
      IF(TWARP(MMIN).LT.0)TWARP(MMIN)=0
      GO TO 1100
367   IF(MMIN.GT.6)GO TO 368
      MI=MMIN-4
      DO 369 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 369
      I8=I7+4
      WRITE(I8,370)(ISIDE(IQ0,MI),IQ0=1,3),IBASE(MI)
370   FORMAT(/1X,3A4,' STARBASE',I3,' IS WITHIN RANGE OF KZINTI STASIS F
     *IELD')
369   CONTINUE
      DFLCB(MI)=DFLCB(MI)-ISTAZ/100.
      GO TO 1100
368   MI=MMIN-6
      IF(MI.EQ.7)GO TO 1100
      DO 372 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 372
      I8=I7+4
      WRITE(I8,373)(IENM2(J,MI),J=1,4)
373   FORMAT(/1X,4A4,' IS WITHIN RANGE OF KZINTI STASIS FIELD')
372   CONTINUE
      DFLCK(MI)=DFLCK(MI)-ISTAZ/100.
1100  RETURN
      END


C       -- DONALD ECCLESTONE SUBPROGRAM FOR     T R E K 7
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C                       - BLISH -
C DG: NOTE - THIS MODULE IS DEDICATED IN MEMORY OF THE LATE JAMES BLISH
C
      LOGICAL FUNCTION BLISH(JT)
      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 /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 /T/ICHOE(4),ICHOS(8),ICHOB(2)
      BLISH=.FALSE.
360   JT=JT+1
      GO TO (359,356,1100),JT
359   IF(IARMZ(1).EQ.0)GO TO 360
      IV=INDUZ
      DO 357 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 357
      I8=I7+4
      WRITE(I8,358)
358   FORMAT(/' KZINTI WARSHIP FIRING INDUCTION BEAM')
357   CONTINUE
      GO TO 33900
356   IF(IARMZ(2).EQ.0)GO TO 360
      IF(.NOT.MOLOCH(MMIN))GO TO 355
      CALL PIKE(IKLNR(6),IKLNC(6),IBPSB(6))
      IF(MMIN.EQ.0)GO TO 360
355   IV=IXRYZ
      DO 361 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 361
      I8=I7+4
      WRITE(I8,362)
362   FORMAT(/' KZINTI WARSHIP FIRING X-RAY LASER CANNON')
361   CONTINUE
      GO TO 33900
1100  BLISH=.TRUE.
33900 RETURN
      END


C DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C              TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
C - FINNEY -
C
      SUBROUTINE FINNEY(MI)
      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 /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      DATA FUDGE/0.700619195/
      ION(MI)=0
      DO 376 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 376
      I8=I7+4
      WRITE(I8,377)(INAME(IQ0,MI),IQ0=1,3)
377   FORMAT(/' ION STORM DAMAGE TO ',3A4)
376   CONTINUE
      CALL RANDO(IV,1,20)
      IVV=ALOG((101.-DFLCT(MI))*IV)/FUDGE-3.
      CALL GRUP1(IVV,MI)
      RETURN
      END


C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C - SAURON -
C
      SUBROUTINE SAURON
      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 /J/KODE(2,8),STATIC(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 /P/IPULL(4),IPUSH(4),PULL(4),PUSH(4),IPULLR(4),IPULLC(4),
     *IPUSHR(4),IPUSHC(4)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      IDOK=0
      DO 131 J=1,4
      IF(ICHOE(J).EQ.0)GO TO 131
      IF(IBPSC(IT).EQ.J)GO TO 131
      I=J+4
      WRITE(I,132)(INAME(IQ0,IT),IQ0=1,3)
132   FORMAT(' PLEASE STANDBY WHILE THE ',3A4,' TAKES ITS TURN')
131   CONTINUE
      DO 1 I=1,2
      IF(ICHOB(I).NE.1)GO TO 1
      IF(IBPSS(I).NE.IS)GO TO 1
      IF(DI(IENTR(IT),IENTC(IT),IBASR(I),IBASC(I)).GE.2)GO TO 1
      IDOK=1
      CALL MCCOY
1     CONTINUE
2330  IF(TWARP(IT).GE.0.5)GO TO 422
      IF(NOMOV(IT).EQ.1)GO TO 423
      NOMOV(IT)=1
      WRITE(L,421)
421   FORMAT(' WARP ENERGY IS UNDER 0.5 SO THE WARP ENGINES HAVE BEEN SH
     *UT DOWN'/' TO CONSERVE POWER')
      ITEMP(IT)=0
      GO TO 423
422   IF(NOMOV(IT).EQ.0)GO TO 423
      NOMOV(IT)=0
      ITEMP(IT)=4000
      WRITE(L,424)
424   FORMAT(' ENGINEERING HERE SIR - WE''VE ENGAGED ENGINE RESTART CYCL
     *E'/' AND SHOULD BE ABLE TO MOVE NOW')
423   IF(IGO(IT).EQ.0)GO TO 23302
      IF(NDEAD(IT).LT.100)GO TO 23302
      IF(IDOK.EQ.1)GO TO 23302
      IF(MANUM(IT).EQ.0)GO TO 23303
      CALL RANDO(I7,1,4*IGO(IT))
      WRITE(L,425)
425   FORMAT(' DAMAGE CONTROL PARTIES COMMENCING REPAIRS')
429   IF(MANUM(IT).GT.8)GO TO 426
428   DO 427 I=1,33
      IF(MA(IT,I).EQ.0)GO TO 427
      I7=I7-1
      IF(I7.LT.0)GO TO 23303
      CALL RPAIR
      IF(MANUM(IT).EQ.0)GO TO 23303
427   CONTINUE
      GO TO 23303
426   CALL RANDO(I,1,33)
      IF(MA(IT,I).EQ.0)GO TO 426
      I7=I7-1
      IF(I7.LT.0)GO TO 23303
      CALL RPAIR
      IF(MANUM(IT).LT.8)GO TO 426
      GO TO 426
23303 IF(IGO(IT).EQ.1)GO TO 23302
      IF(PHASR(IT)+DFLCT(IT)*100.+TWARP(IT)*1000.0.GE.26000.)GO TO 23302
      IF(PHASR(IT).LT.6000.)PHASR(IT)=PHASR(IT)+500.
      DFLCT(IT)=DFLCT(IT)+10.
      TWARP(IT)=TWARP(IT)+1.
      IF(DFLCT(IT).GT.100.)DFLCT(IT)=100.
      IF(TWARP(IT).GT.10.)TWARP(IT)=10.
23302 DO 405 I=1,2
      HIVEL(IT,I)=10.-MA(IT,I+30)
      IF(MA(IT,I+30).EQ.0.OR.MA(IT,I+26).EQ.9)GO TO 405
      WRITE(L,406)1,HIVEL(IT,I)
406   FORMAT(' ** NOTE **- NACELLE',I2,' MAY RIP OFF IF WARP SPEED EXCEE
     *DS',F6.2)
405   CONTINUE
      K(IT,4)=MA(IT,29)
      K(IT,5)=MA(IT,30)
      K(IT,6)=MA(IT,28)
      IF(JS.EQ.2)GO TO 144
      K(IT,1)=MA(IT,23)
      K(IT,2)=MA(IT,14)
      K(IT,14)=MA(IT,3)
      NOMAP(IT)=15-MA(IT,33)
      GO TO 145
144   K(IT,1)=MA(IT,13)
      K(IT,2)=MA(IT,14)
      K(IT,14)=MA(IT,29)+MA(IT,30)
      NOMAP(IT)=15-MA(IT,13)
145   IF(ICOIL(IT).EQ.0)GO TO 234
      CALL RANDO(I7,1,7-IGO(IT))
      IF(I7.GT.2)GO TO 234
      ICOIL(IT)=0
      WRITE(L,4020)
4020  FORMAT(' REPAIRS COMPLETE - PHASERS ARE NOW OPERATIVE')
234   RETURN
      END


C            -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C                                - MCCOY -
C -- NOV./1999 -DG: I WOULD LIKE TO DEDICATE THIS COMMENT IN MEMORY OF THE
C LATE DEFOREST KELLEY WHO PASSED AWAY ONLY SOME MONTHS AGO.  OUR THOUGHTS
C AND OUR HEARTS WILL BE WITH YOU ALWAYS.  MR. KELLEY WILL BE SADLY MISSED.
C I THINK MR. KELLEY PASSED AWAY AUG/1999 AT THE AGE OF 78

      SUBROUTINE MCCOY
      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 /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)
      WRITE(L,2)INAME(1,IT),INAME(2,IT),IBASE(I)
2     FORMAT(' THE ',2A5,' IS DOCKED AT STARBASE ',I2/' REPAIRS COMMENCI
     *NG-')
      DO 3 I7=1,33
      MA(IT,I7)=MA(IT,I7)-3
      IF(MA(IT,I7).GT.0)GO TO 3
      IF(MA(IT,I7).EQ.-3)GO TO 4
      MANUM(IT)=MANUM(IT)-1
4     MA(IT,I7)=0
3     CONTINUE
      IF(MA(IT,29).EQ.6)MANUM(IT)=MANUM(IT)+1
      IF(MA(IT,30).EQ.6)MANUM(IT)=MANUM(IT)+1
      IF(PHASR(IT)+DFLCT(IT)*100.+TWARP(IT)*1000.0.GE.26000.)GOTO 5
      DFLCT(IT)=DFLCT(IT)+10.
      IF(PHASR(IT).LT.6000.)PHASR(IT)=PHASR(IT)+500.
      TWARP(IT)=TWARP(IT)+1.
      IF(DFLCT(IT).GT.100.)DFLCT(IT)=100.
      IF(TWARP(IT).GT.10.)TWARP(IT)=10.
5     IF(ICOIL(IT).EQ.0)GO TO 7
      ICOIL(IT)=0
      WRITE(L,14)
14    FORMAT(' PHASERS NOW OPERATIVE')
7     RETURN
      END

C            -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C
C                                - RPAIR -
C
C THIS WAS HAND-TYPED 21/APR/2000 BY: D.G.

      SUBROUTINE RPAIR
      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 /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      IF(I.EQ.29.AND.MA(IT,29).EQ.9)RETURN
      IF(I.EQ.30.AND.MA(IT,30).EQ.9)RETURN
      CALL RANDO(I8,1,5)
      MA(IT,I)=MA(IT,I)-I8
      IF(MA(IT,I).GT.0)RETURN
      MA(IT,I)=0
      MANUM(IT)=MANUM(IT)-1
      RETURN
      END
