C=======================================================================
C                                                                      *
C                              DONALD ECCLESTONE                       *
C                                     AND                              *
C                                DAN GAHLINGER                         *
C                                   PRESENT                            *
C                                      -                               *
C                        T H E   H O L Y   T E R R O R                 *
C                                                                      *
C                       TTTTT RRRR  EEEEE K   K 777777                 *
C                         T   R   R E     K  K      7                  *
C                         T   RRRR  EEEE  KKK      7                   *
C                         T   R  R  E     K  K    7                    *
C                         T   R   R EEEEE K   K  7                     *
C                                                                      *
C=======================================================================
C                                                                      *
C  COPYRIGHT (C) 1979  DONALD M. ECCLESTONE    (VAX/VMS FORTRAN)       *
C            74 HUNT VILLAGE CRESCENT, LONDON ONTARIO CANADA  N6H 4A4  *
C NOTE: THE ABOVE ADDRESS IS NO LONGER VALID, SORRY KIDDIES (01/01/93) *
C=======================================================================
C                                                                      *
C  COPYRIGHT (C) 1993  DAN GAHLINGER - (MSDOS/486/AMD-K2-400/FORTRAN)  *
C    INTERNET - DAN@ZEROFUSION.COM --- HTTP://ZEROFUSION.COM/TREK7     *
C                                                                      *
C=======================================================================
C THE FOLLOWING PUNCHES MAY BE FOUND IN THIS DECK -                    *
C THE ALPHABET -- ABCDEFGHIJKLMNOPQRSTUVWXYZ                           *
C THE DIGITS -- 0123456789                                             *
C        12-8-7    EXCLAMATION MARK              !!!!!!!!!!!!!!!!!!!!!!!
C        0-8-5     QUOTATION MARK (DOUBLE QUOTE) """""""""""""""""""""""
C        0-8-6     NUMBER SIGN (POUND SIGN)      #######################
C        11-8-3    DOLLAR SIGN                   $$$$$$$$$$$$$$$$$$$$$$$
C        0-8-7     PERCENT SIGN                  %%%%%%%%%%%%%%%%%%%%%%%
C        11-8-7    AMPERSAND                     &&&&&&&&&&&&&&&&&&&&&&&
C        8-4       APOSTROPHE (SINGLE QUOTE)     '''''''''''''''''''''''
C        0-8-4     LEFT PARNETHESIS              (((((((((((((((((((((((
C        12-8-4    RIGHT PARNETHESIS             )))))))))))))))))))))))
C        11-8-4    ASTERISK                      ***********************
C        12        PLUS SIGN                     +++++++++++++++++++++++
C        0-8-3     COMMA                         ,,,,,,,,,,,,,,,,,,,,,,,
C        11        MINUS SIGN (HYPHEN) (DASH)    -----------------------
C        12-8-3    PERIOD (DECIMAL POINT)        .......................
C        0-1       SLASH                         ///////////////////////
C        11-0      COLON                         :::::::::::::::::::::::

C        0-8-2     SEMICOLON                     ;;;;;;;;;;;;;;;;;;;;;;;
C        12-8-6    LEFT ANGLE BRACKET (LESS THAN)<<<<<<<<<<<<<<<<<<<<<<<
C        8-3       EQUAL SIGN                    =======================
C        11-8-6    RIGHT ANGLE BRACKET(GREATER THAN)  >>>>>>>>>>>>>>>>>>
C        12-0      QUESTION MARK                 ???????????????????????
C        8-5       AT SIGN                       @@@@@@@@@@@@@@@@@@@@@@@
C        11-8-5    LEFT SQUARE BRACKET           [[[[[[[[[[[[[[[[[[[[[[[
C        8-7       BACKSLASH                     \\\\\\\\\\\\\\\\\\\\\\\
C        12-8-5    RIGHT SQUARE BRACKET          ]]]]]]]]]]]]]]]]]]]]]]]
C        8-5       UP-ARROW (CIRCUMFLEX)         ^^^^^^^^^^^^^^^^^^^^^^^
C        8-2       BACK-ARROW OR UNDERSCORE      _______________________
C=======================================================================
C                                                                      *
C  A - MAINLINE AND OFT-USED ROUTINES                                  *
C  B - USER COMMAND ROUTINES                                           *
C  C - M-O SHIP OPERATIONS                                             *
C  D - SHIP INITIALIZATION                                             *
C  E - C-O SHIP OPERATIONS                                             *
C  F - SHIP DAMAGE ROUTINES                                            *
C  G - MISC. ROUTINES (C-O WEAPONRY, ION STORMS, M-O NEW TURN, REPAIR) *
C                                                                      *
C=======================================================================
C                                                                      *
C                           TREK7 MODULE A                             *
C            -- CONVERTED TO PC BY: DAN GAHLINGER --                   *
C ENTIRE MODULE TYPE-EXACT CHECK 04/26/2000 BY: D.G.                   *
C                                                                      *
C        MAINLINE AND OFT-USED ROUTINES                                *
C                                                                      *
C        MAINLINE  GAMOVR    RANDO     HORTA     CYRANO    DI          *
C        ANG       FOSTER    IXIF      LOKI      ILLDAT    OOPS        *
C        ILLDAS                                                        *
C                                                                      *
C=======================================================================
C***** MODULE NOTE: A.FOR (KLIN <- HANDWRITTEN) *****
C TYPE-EXACT CHECK 04/26/2000 BY: D.G.
      INTEGER CMAND(26)
      LOGICAL ITAKA(6)
      LOGICAL GAMOVR,SULU,SAREK,SPOCK,HARPO,LARRY,CURLY
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /G/ZAP(4),ICOLA(4),IROWA(4),LOCK(4),ICOIL(4)
      COMMON /H/ANGLE(4),RANG(4),LOCKT(4)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /J/KODE(2,8),STATIC(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 /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 /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)
      COMMON /W/IDEX(2,33,20)
        COMMON /TOM/ITOM
      EQUIVALENCE(II(1),I1),(II(2),I2)
      DATA CMAND/'IN','MA','TR','CO','PH','TO','GO','CA','EA',
     *'BO','YA','DE','HE','MI','RE','RA','CE','AT','DA','CR','SP',
     *'EN','NO','SU','HN','VE'/
      DATA NNO/'N'/
        ITOM=12345
      L=5
      LLL=6
      PRINT 9988
9988  FORMAT(/' DONALD ECCLESTONE (C)1979 AND DAN GAHLINGER (C)1993
     * PRESENT'//' T H E   H O L Y   T E R R O R   -
     *   T R E K 7'///)
      WRITE(LLL,10910)
10910 FORMAT(' TYPE IN A RANDOM NUMBER BETWEEN 1-32767')
        READ(L,*)ITOM

C***** ABOVE WRITE WAS ORIGINALLY 1-99999 *****

      CALL HARLIE
946   IGO(1)=0
94    CALL FIZBIN
      LAST=0
      LLAST=0
      NOSTOP=0
      IO=0
      IF(IGO(1).EQ.0)MINES=0
890   DO 128 I=1,4
      IGO(I)=0
      IF(ICHOE(I).EQ.0)GO TO 128
      L=I+4
800   FORMAT(' TYPE HELP FOR HELP')

C TEXT TO THIS POINT WAS HAND TYPED

128   CONTINUE
130   IT=0
      L=4
129   IT=IT+1
      IF(IT.GT.4)GO TO 23310
      IBORD=0
      L=IBPSC(IT)+4
      JS=(IT+1)/2
      IS=(IBPSC(IT)+1)/2
      IPUSH(IT)=0
      IPULL(IT)=0
      STATIC(IT)=0
      NANU=0
      IF(ICHOE(IT).NE.1)GO TO 129
      L=5
C  JUST MANUALLY SET L TO 5 (ORIGINALLY 4)
      CALL SAURON
234   WRITE(LLL,10)(INAME(IQ0,IT),IQ0=1,3)
10    FORMAT(/1X,3A4,' COMMAND: ',$)
      A=0.0
      B=0.0
      READ(L,920,ERR=3)NA,A,B
920   FORMAT(A2,1X,2F15.7)
      IGOL(1)=IBLK
      GO TO 4
3     A=0.0
      B=0.0
      CALL ILLDAS(IGOL,L)
4     DO 636 I=1,26
      IF(CMAND(I).EQ.NA)GO TO (585,517,632,15,11,13,330,670,3001,
     *680,310,320,571,666,900,700,200,210,360,352,351,
     *705,350,519,690,695),I
636   CONTINUE
      WRITE(LLL,800)
      GO TO 234
C     IN
585   CALL INFO
      GO TO 234
C             MA
517   CALL GODOT
      GO TO 234
C             TR
632   CALL SCOTT
      GO TO 234
C             CO
15    CALL AREX
      GO TO 234
C             PH
11    CALL MRESS
      GO TO 234
C             TO
13    CALL CHEKOV
      GO TO 234
C             CA
670   CALL CANCEL(IBORD)
      GO TO 234
C            EA
3001  CALL GOLLUM
      GO TO 234
C             BO
680   CALL ORWELL(IBORD,NUMBO,IRBO,ICBO)
      GO TO 234
C             YA
310   CALL TRACLC
      GO TO 234
C             DE
320   CALL DEFLOC
      GO TO 234
C             HE
571   CALL INST
      GO TO 234
C             MI
666   IF(LOCKT(IT).NE.1)GO TO 668
      DISTP=RANG(IT)
      IF(A.EQ.0)GO TO 6660
      RANG(IT)=A
      GO TO 6661
6660  WRITE(LLL,667)
667   FORMAT(' ENTER RANGE AT WHICH TORPEDO IS TO BECOME A MINE - BETWEE
     *N 1.5 AND 10')
      READ(L,*,ERR=66801)RANG(IT)
24    FORMAT(F15.7)
6661  IF(RANG(IT).LT.1.5.OR.RANG(IT).GT.10.)GO TO 6680
      GO TO 234
66801 CALL ILLDAT
6680  CALL OOPS(LLL)
      RANG(IT)=DISTP
      GO TO 234
668   WRITE(LLL,6683)
6683  FORMAT(' PLEASE USE TORPEDO COMMAND BEFORE THIS COMMAND')
      GO TO 234
C              RE
900   CALL BLOCH
      GO TO 234
C              RA
700   CALL UHURA
      GO TO 234
C              CE
200   CALL SHADOW(1)
      GO TO 234
C              AT
210   CALL SHADOW(0)
      GO TO 234
C              DA
360   I8=0
      II8=0
      WRITE(LLL,359)
359   FORMAT(' DAMAGE FACTOR-           DECK')
      DO 3611 I=1,33
      I7=MA(IT,I)+1
      IF(I7.EQ.1)GO TO 3611
      I8=1
      II8=6
      WRITE(LLL,362)I7
362   FORMAT(I3,'-',$)
      CALL FORBIN(JS,I,L,'+')
3611  CONTINUE
      IF(I8.EQ.0)WRITE(LLL,3612)
3612  FORMAT(' NO DAMAGE TO SHIP')
      GO TO 234
C                 CR
352   WRITE(LLL,1450)
1450  FORMAT(' CREW-')
      DO 1440 I=1,4
      IF(ICHOE(I).NE.1)GO TO 1440
      IF(IBPSC(I).EQ.IBPSC(IT))WRITE(LLL,353)NDEAD(I),
     *(INAME(IQ0,I),IQ0=1,3)
353   FORMAT(1X,I4,' ON ',3A4)
1440  CONTINUE
      DO 1451 I=1,2
      IF(ICHOB(I).EQ.0)GO TO 1451
      IF(IBPSS(I).EQ.IS)WRITE(LLL,146)NDEAD(I),IBASE(I)
146   FORMAT(1X,I4,' ON STARBASE',I3)
1451   CONTINUE
      IF(IBPOB(7).EQ.0)GO TO 354
      DO 355 I=1,8
      IF(I.EQ.7.OR.ICHOS(I).EQ.0)GO TO 355
      IF(IBPOB(I).EQ.0)GO TO 355
      IF(IBPSB(I).NE.IS)GO TO 355
      WRITE(LLL,356)IBPOB(I),(IENM2(N,I),N=1,4)
356   FORMAT(1X,I4,' ON ',4A4)
355   CONTINUE
354   IF(NUME(IS).EQ.0)GO TO 234
      DO 357 I=1,LAUNCH
      IF(IBPOE(I).EQ.0)GO TO 357
      IF(IGLER(I).EQ.0)GO TO 357
      IF(IBPSE(I).NE.IS)GO TO 357
      WRITE(LLL,358)IBPOE(I),I
358   FORMAT(1X,I4,' ON EAGLE ',I2)
357   CONTINUE
      GO TO 234
C              SP
351   CALL VULCAN
      GO TO 234
C              EN
705   CALL ECCLE(NANU)
      GO TO 234
C              NO
350   NOSTOP=1
      GO TO 234
C             SU
519   IF(IJ(3-IS).EQ.0)GO TO 5190
      DO 170 I=1,4
      IF(ICHOE(I).EQ.0)GO TO 170
      I7=I+4
      II7=I7+1
      WRITE(II7,171)(INAME(IQ0,IT),IQ0=1,3)
171   FORMAT(' THE ',3A4,' WISHES TO SURRENDER')
170   CONTINUE
      ISURR(IT)=1
      WRITE(LLL,133)
133   FORMAT(' PRESENT YOUR SURRENDER TO THE NEAREST ENEMY VESSEL')
      GO TO 234
5190  WRITE(LLL,910)(INAME(IQ0,IT),IQ0=1,3)
910   FORMAT(/' THE STARSHIP ',3A4,' IS NOW RAISING THE WHITE FLAG')
      WRITE(LLL,91)IBASE((IBPSC(IT)+1)/2),(INAME(IQ0,IT),IQ0=1,3)
91    FORMAT(/' STARBASE',I3,' CALLING THE ',3A4,/' DUE TO YOUR COWAR
     *DLY SURRENDER, WE HAVE LOST FACE.'/' FOR THIS ACT YOU ARE DEMOTED
     * TO CESSPOOL CLEANER 4TH CLASS.')
C
C
      MMAP(IENTR(IT),IENTC(IT))=IBLK
      IF(ISPOT(IT).EQ.1)MMAP(IENTR(IT),IENTC(IT))=III
      ICHOE(IT)=0
      IJ(IS)=IJ(IS)-1
      II(IS)=II(IS)-1
      LAST=L
      LLAST=LLL
      IF(I1+I2.EQ.0)GO TO 98
      GO TO 129
98    WRITE(LLAST,300)
300   FORMAT(' ANOTHER GAME ?')
      READ(LAST,92)NA
92    FORMAT(A1)
      L=LAST
      LLL=LLAST
      IF(NNO.NE.NA)GO TO 940
      WRITE(LLAST,90)
90    FORMAT('1',15('-'),'  KEEP ON TREKKIN''   ',15('-')/'1 IF ANY E
     *RRORS ARE DETECTED, PLEASE SEND ME A COPY OF THE'/' ERRONEOUS PART
     *OF THE GAME. ALSO, IF YOU HAVE ANY COMMENTS, '/' COMPLAINTS, COMPL
     *IMENTS, QUESTIONS OR SUGGESTIONS ABOUT THE'/' PRGGRAM, I AM ANXIOU
     *S TO HEAR THEM.'/////', CONTACT-'//'   DONALD ECCLESTONE,'/,5X,
     *'C/O DAN GAHLINGER VIA,'/' DAN@ZEROFUSION.COM -',5X)
      STOP
940   IF(MINES.GT.5)GO TO 946
      DO 945 I=1,4
      IF(IENTR(I).EQ.0)GO TO 945
      MMAP(IENTR(I),IENTC(I))=IBLK
      IF(ISPOT(I).EQ.1)MMAP(IENTR(I),IENTC(I))=III
945   CONTINUE
      DO 942 I=1,8
      IF(ICHOS(I).EQ.0)GO TO 942
      MMAP(IKLNR(I),IKLNC(I))=IBLK
      IF(ISPOK(I).EQ.1)MMAP(IKLNR(I),IKLNC(I))=III
942   CONTINUE
      IF(NUMOUT.EQ.0)GO TO 944
      DO 943 I=1,25
      IF(IGLER(I).NE.0)MMAP(IGLER(I),IGLEC(I))=IBLK
943   CONTINUE
944   IGO(1)=1
      WRITE(LLAST,941)
941   FORMAT(' SAME MAP?')
      READ(LAST,92)NA
      IF(NA.EQ.NNO)IGO(1)=0
      GO TO 94
C                       HN
690   CONTINUE
      GO TO 234
C                       VE
695   CONTINUE
      WRITE(LLL,696)
696   FORMAT(' 7.0 DEVELOPMENTAL')
      GO TO 234
C                      GO
330   IF(IGOL(1).NE.IBLK)GO TO 331
3380  WRITE(LLL,332)
332   FORMAT(' ENTER COMMAND STRING (M,P,T,B,Y,D,C,H FOR HELP)')
      READ(L,333)IGOL
333   FORMAT(80A1)
331   IF(IGOL(1).NE.'H')GO TO 334
      WRITE(LLL,335)
335   FORMAT(' ENTER A STRING OF CHARACTERS INDICATING THE SEQUENCE IN W
     *HICH'/' YOU WISH TO EXECUTE AN ACTION - TYPE'/' ''M'' TO MOVE'/' '
     *'P'' TO FIRE PHASERS'/' ''T'' TO FIRE TORPS/DISRUPTORS'/' ''B'' TO
     * INITIATE A BOARDING PARTY'/' ''Y'' TO ENGAGE A TRACTOR BEAM'/' AN
     *D/OR ''D'' TO ENGAGE A DEFLECTOR BEAM. '/' EG. IF YOU WISH TO FIRE
     * A TORPEDO THEN ENGAGE A TRACTOR BEAM THEN INITIATE A'/' BOARDING
     * PARTY THEN MOVE THEN FIRE PHASERS THEN ENGAGE A DEFLECTOR BEAM,'/
     *' TYPE ''TYBMPD''.'/' NOTE THAT YOU DON''T HAVE TO USE ALL THE CHA
     *RACTERS-'/' COMMANDS SUCH AS ''M'' OR ''PT'' OR ''BY'' ARE POSSIBL
     *E.')
      WRITE(LLL,336)
336   FORMAT(' IF THE FIRST CHARACTER IN THE STRING IS A ''C'','/'  THE
     *GO COMMAND IS CANCELLED')
      WRITE(LLL,337)
337   FORMAT(' OTHER FORMS--'/' EG. B(M)(PT) -IF THE BOARD IS SUCCESSFUL
     *, WE MOVE ELSE WE FIRE PHASERS AND TORPEDOES.'/' THUS THE BACKUS-N
     *AUR FORM OF THE GO-LINE IS-'/' <GO-LINE>::=<GO-CHAR> / <GO-CHAR>(<
     *GO-LINE>)(<GO-LINE>) / <GO-CHAR>(<GO-LINE>) / NIL'/'<GO-CHAR>::=M
     */P/T/B/Y/D'/' CAUTION -THE GO-LINE SHOULD BE 80 CHARACTERS OR LESS
     * IN LENGTH AND SHOULD NOT NEST MORE THAN 6 LEVELS.')
      GO TO 3380
334   IF(IGOL(1).EQ.'C')GO TO 234
      LNA=0
      MOVE=0
      IGO(IT)=2
      LVL=1
      ITAKA(1)=.FALSE.
338   IF(ICHOE(IT).NE.1)GO TO 129
339   LNA=LNA+1
      ISTAT=0
      IF(LNA.LE.80)GO TO 340
343   IF(TWARP(IT).LT.0.5)GO TO 129
      IF(NOMOV(IT).EQ.1)GO TO 129
      IF(MA(IT,29).EQ.9.AND.MA(IT,30).EQ.9)GO TO 129
      CALL ENTEMP(MOVE)
      IF(GAMOVR(LAST))GO TO 98
      GO TO 129
340   IF(IGOL(LNA).EQ.IBLK)GO TO 339
      IF(IGOL(LNA).NE.'(')GO TO 341
      IF(ITAKA(LVL))GO TO 342
      CALL FOSTER(LNA)
      ITAKA(LVL)=.TRUE.
      GO TO 339
342   LVL=LVL+1
      IF(LVL.GT.6)GO TO 343
      ITAKA(LVL)=.FALSE.
      GO TO 339
341   IF(IGOL(LNA).NE.')')GO TO 344
      LVL=LVL-1
      IF(LVL.LE.0)GO TO 343
      ITAKA(LVL)=.FALSE.
      GO TO 339
344   ITAKA(LVL)=.FALSE.
      IF(IGOL(LNA).NE.'M')GO TO 345
      IF(NOMOV(IT).EQ.0)GO TO 346
      WRITE(LLL,3470)
3470  FORMAT(' MOVEMENT IMPOSSIBLE UNTIL ENGINES RE-ENERGIZED')
      GO TO 339
346   MOVE=MOVE+1
      IF(MOVE.GT.1)GO TO 343
      ITAKA(LVL)=SULU(J)
      GO TO 347
345   IF(IGOL(LNA).NE.'P')GO TO 348
      IF(LOCK(IT).EQ.1)ITAKA(LVL)=SAREK(J)
      GO TO 347
348   IF(IGOL(LNA).NE.'T')GO TO 349
      IF(LOCKT(IT).EQ.1)ITAKA(LVL)=SPOCK(J)
      GO TO 347
349   IF(IGOL(LNA).NE.'B')GO TO 365
      IF(IBORD.EQ.1)ITAKA(LVL)=HARPO(IBORD,NUMBO,IRBO,ICBO)
      GO TO 347
365   IF(IGOL(LNA).NE.'Y')GO TO 366
      IF(IPULL(IT).EQ.1)ITAKA(LVL)=LARRY(J)
      GO TO 347
366   IF(IGOL(LNA).NE.'D')GO TO 343
      IF(IPUSH(IT).EQ.1)ITAKA(LVL)=CURLY(J)
347   IF(GAMOVR(LAST))GO TO 98
      GO TO 339
23310 DO 23312 I=1,2
      IF(ICHOB(I).NE.1)GO TO 23312
      IF(NDEAB(I).LE.0)GO TO 23313
      IF(IFIB(I).EQ.1)GO TO 23313
      IF(DFLCB(I).LE.25.)GO TO 23313
      CALL BALOK
23313 IF(IONB(I).NE.0)CALL TALOS
      IF(IGOB(I).EQ.0)DFLCB(I)=DFLCB(I)+10.
      IF(DFLCB(I).GT.300.)DFLCB(I)=300.
      IGOB(I)=0
23312 CONTINUE
      IF(GAMOVR(LAST))GO TO 98
23311 CALL ATACK
      IF(GAMOVR(LAST))GO TO 98
      CALL ENEMY
      DO 301 MI=1,4
      IF(ION(MI).NE.0.OR.ISPOT(MI).NE.0)CALL FINNEY(MI)
301   CONTINUE
      IF(GAMOVR(LAST))GO TO 98
      GO TO 130
      END


C  DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C
C TYPE-EXACT CHECK 04/26/2000 BY: D.G.
C
      BLOCK DATA
      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)
      DATA IENM1/'K','R','T','G','O','Z','D','A'/
      DATA IENM2/'KLIN','GON ','WARS'
     *,'HIP ','ROMU','LAN ','WARS','HIP ','THOL','IAN ','WARS','HIP ',
     *'GORN',' WAR', 'SHIP','    ','ORIO', 'N PR','IVAT','EER ',
     *'KZIN','TI W','ARSH','IP  ','DOOM',
     *'SDAY',' MAC','HINE','MOON','BASE',' ALP','HA  '/
      DATA IBLK,ISTAR,III,IGLE/' ','*','I','='/
      DATA IEE/'E','P','H','C'/,INAME/'ENTE','RPRI','SE  ','POTE',
     *'MPKI','N   ','HAVO','C   ','    ',
     *'CARN','AGE ','    '/,ISIDE/'FEDE','RATI','ON  ',
     *'KLIN','GON ','    '
     */,IM/'1','2','3','4'/
      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 - GAMOVR
C
      LOGICAL FUNCTION GAMOVR(LAST)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      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)
      GAMOVR=.FALSE.
546   DO 762 I=1,8
      IONK(I)=0
      IF(ICHOS(I).NE.0.AND.DFLCK(I).LT.0)CALL HADES
762   CONTINUE
      DO 154 I=1,2
      IF(ICHOB(I).EQ.0)GO TO 154
      J=IBPSS(I)
      IF(DFLCB(I).GE.0)GO TO 155
      CALL EREBUS
      GO TO 1540
155   IF(NDEAB(I).GT.0)GO TO 154
      IF(ICHOB(I).EQ.2)GO TO 154
      CALL CHARON
1540  II(J)=II(J)-1
154   CONTINUE
      DO 134 I=1,4
      IF(ICHOE(I).EQ.0.OR.ICHOE(I).EQ.3)GO TO 134
      IF(DFLCT(I).GE.0)GO TO 2320
      CALL STYX
      IF(I7.EQ.2)GO TO 1341
      GO TO 1340
2320  IF(ICHOE(I).EQ.2)GO TO 134
      IF(NDEAD(I).GT.0)GO TO 134
      CALL BELIAL
1340  J=(IBPSC(I)+1)/2
      IJ(J)=IJ(J)-1
      II(J)=II(J)-1
1341  LAST=IBPSC(I)+4
134   CONTINUE
      IF(IJ(1)+IJ(2).EQ.0)GO TO 98
      IF(ISHAK.EQ.1)GO TO 100
      IF(II(1).NE.0.AND.II(2)+I3.EQ.0)GO TO 139
      IF(II(2).NE.0.AND.II(1)+I3.EQ.0)GO TO 139
      GO TO 100
139   IF(NOSTOP.EQ.2)GO TO 100
      DO 1400 I=1,4
      IF(ICHOE(I).NE.1)GO TO 1400
      J=I+4
      JJJ=J+1
      JTK=(IBPSC(I)+1)/2
      WRITE(JJJ,767)(ISIDE(IQ0,JTK),IQ0=1,3),IBASE(JTK),
     *(INAME(IQ0,I),IQ0=1,3)
767   FORMAT(1X,3A4,' STARBASE',I3,' CALLING THE',3A4,/'
     *S, CAPTAIN - OUR SIDE HAS DEFEATED THE ENEMY')
      LAST=J
      IF(NOSTOP.EQ.1)WRITE(JJJ,7650)
7650  FORMAT(' CONTINUING ..........')
1400  CONTINUE
      IF(NOSTOP.EQ.0)GO TO 98
      NOSTOP=2
      GO TO 100
98    GAMOVR=.TRUE.
100   ISTAT=0
      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 - RANDO -
C
      SUBROUTINE RANDO(IX,IY,IZ)
        COMMON /TOM/ITOM
        INTEGER*2 ISHRT,ISHIT
        REAL RT
        ISHRT=ITOM
        ISHIT=ITOM
C this is a kludge to make the VMS random num. gen. to work.
C      PRINT 22222,IX,IY,IZ
C22222 FORMAT(//' TOP OF RANDO IX=',I6,' IY=',I6,' IZ=',I6//)
C       RT=RAN(ISHRT,ISHIT)
C above line and next line to fix RAN call for other compilers (non-vax)
c thus this code may no longer work on the vax
        RT=RAN(ITOM)
        ITOM=IFIX(RT*10000.)
4     TEMP=FLOAT(MOD(ITOM,100))/100.
        IX=(IZ-IY+1)*TEMP+IY
C      PRINT 22233,IX,IY,IZ
C22233 FORMAT(//' END OF RANDO IX=',I6,' IY=',I6,' IZ=',I6//)
      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                       - HORTA -
C
      SUBROUTINE HORTA(ISTR,ISTC,ITAR,ITAC,RAD,BERNG,IL,AJUS,IGNOR,
     *DIST,KPLOT)
      INTEGER KPLOT(10),INTER(19)
      LOGICAL CYRANO
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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
      DATA INTER/'E','P','H','C','K','R','T','G','O','Z','D','A','*',
     *'=','1','2','3','4','I'/
      IF(IO.EQ.1)PRINT 1970,N,ISTR,ISTC,ITAR,ITAC,RAD,BERNG,AJUS,
     *IGNOR
1970  FORMAT(' BEGIN HORTA N=',I5,' ISTR=',I5,' ISTC=',I5,' ITAR=',I5,
     *' ITAC=',I5,' RAD=',F15.7,' BERNG=',F15.7,' AJUS=',F15.7,
     *' IGNOR=',I5)
      IDIST=0
      DISTP=0.0
      I7=ISTR
      I8=ISTC
      IL=1
      J=0
      M=0
      IF(N.GT.2)GO TO 2
      X=DI(ITAC,ITAR,ISTC,ISTR)
      PRINT 12345,X
12345 FORMAT(//' HORTA (TREKA) X=',I7//)
      SINA=FLOAT(ITAR-ISTR)/X
      COSA=FLOAT(ITAC-ISTC)/X
      GO TO 3
2     SINA=SIN(BERNG+AJUS)
      COSA=COS(BERNG+AJUS)
3     IF(SINA.NE.0.AND.COSA.NE.0)GO TO 4
      DISTP=DISTP+1.00
      IF(SINA.EQ.0)M=M+1
      IF(COSA.EQ.0)J=J+1
      GO TO 5
4     D1=ABS(FLOAT(J+1)/SINA)
      D2=ABS(FLOAT(M+1)/COSA)
      IF(ABS(D1-D2).LE.0-02)GO TO 60
      IF(D1.GT.D2)GO TO 6
      DISTP=D1
      J=J+1
      GO TO 5
60    DISTP=D1
      J=J+1
      M=M+1
      GO TO 5
6     DISTP=D2
      M=M+1
5     IF(DISTP.GT.RAD)GO TO 7
      I7=ISTR+SIGN(FLOAT(J),SINA)
      I8=ISTC+SIGN(FLOAT(M),COSA)
      IF(CYRANO(I7,I8))GO TO 8
21    NA=MMAP(I7,I8)
      IF(NA.NE.INTER(19))GO TO 22
      IF(IGNOR.EQ.1)GO TO 19
      GO TO 15
22    IF(NA.NE.IBLK)GO TO 9
19    IF(N.NE.3)GO TO 13
      IF(IFIX(DISTP).NE.IFIX(DISTP)/2*2)GO TO 3
      IF(IDIST.EQ.IFIX(DISTP))GO TO 3
      KPLOT(IL)=I8
      KPLOT(IL+1)=I7
      IDIST=IFIX(DISTP)
      IL=IL+2
      GO TO 3
9     DO 10 MMIN=1,18
      IF(MMIN.EQ.IV)GO TO 10
      IF(NA.NE.INTER(MMIN))GO TO 10
      IF(MMIN.NE.10)RETURN
      IF(I8.NE.IKLNC(6))GO TO 10
      IF(I7.EQ.IKLNR(6))RETURN
10    CONTINUE
      GO TO 13
8     MMIN=20
      RETURN
7     MMIN=21
      RETURN
13    IF(ISTAT.EQ.11)MMAP(I7,I8)=INTER(19)
      IF(N.EQ.5)GO TO 17
      IF(N.NE.1)GO TO 3
      IF(I7.NE.ITAR)GO TO 3
      IF(I8.NE.ITAC)GO TO 3
      MMIN=22
      RETURN
15    MMIN=19
      RETURN
17    Q=DI(ITAC,ITAR,I8,I7)
      IF(Q.LT.DIST)DIST=Q
      GO TO 3
      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 - CYRANO
C
      LOGICAL FUNCTION CYRANO(IR,IC)
      CYRANO=.FALSE.
      IF(IR.LT.1.OR.IR.GT.60.OR.IC.LT.1.OR.IC.GT.60)CYRANO=.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/26/2000 BY: D.G.
C
C                       - DI -
C
      FUNCTION DI(I,J,K,L)
      DI=SQRT(FLOAT((I-K)**2+(J-L)**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 - ANG
C
      FUNCTION ANG(IVR,IVC)
      IF(IVC.NE.0)GO TO 1
      ANG=90.
      GO TO 2
1     ANG=ABS(ATAN(FLOAT(IVR)/FLOAT(IVC)))*180./3.14159265
2     IF(IVC.LT.0.AND.IVR.GE.0)ANG=180.-ANG
      IF(IVC.LT.0.AND.IVR.LT.0)ANG=180.+ANG
      IF(IVC.GE.0.AND.IVR.LT.0)ANG=360.-ANG
      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 - FOSTER
C
      SUBROUTINE FOSTER(LNA)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      I7=1
1     LNA=LNA+1
      IF(LNA.GT.80)GO TO 2
      IF(IGOL(LNA).EQ.'(')I7=I7+1
      IF(IGOL(LNA).EQ.')')I7=I7-1
      IF(I7.NE.0)GO TO 1
2     RETURN
      END


C - DONALD ECCLESTONE SUBPROGRAM FOR T R E. K
C            -- CONVERTED TO PC BY: DAN GAHLINGER --
C   TYPE-EXACT CHECK 04/26/2000 BY: D.G.
C
C -IXIF -
C
      INTEGER FUNCTION IXIF(IVV)
      IXIF=IVV
      IF(IVV.LT.0)IXIF=0
      IF(IVV.GT.10)IXIF=10
      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               - LOKI -
C
      LOGICAL FUNCTION LOKI(IP)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      LOKI=.FALSE.
      IF(IP.NE.1)RETURN
      LOKI=.TRUE.
      WRITE(LLL,1)
1     FORMAT(' WEAPON PREVIOUSLY LOCKED')
      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               ILLDAT -
C
C WHEN FOROTS VERSION 5 DETECTS AN INPUT ERROR, IT BACKSPACES TO THE
C BEGINNING OF THE ILLEGAL RECORD, AND A BRANCH IS MADE TO THE STATEMENT
C SPECIFIED BY ERR IN THE READ STATEMENT. THIS ROUTINE IS CALLED TO
C CLEAR OUT THIS RECORD SO THE NEXT READ WILL GET DATA FROM THE TTY.
      SUBROUTINE ILLDAT
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      READ(L,1)
1     FORMAT(1X)
      RETURN
      END

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- OOPS -
C
      SUBROUTINE OOPS(LLL)
      WRITE(LLL,1)
1     FORMAT(' ILLEGAL ENTRY - COMMAND CANCELLED')
      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 - ILLDAS
C
      SUBROUTINE ILLDAS(IGOL,L)
      DIMENSION IGOL(80)
      READ(L,1)IGOL
1     FORMAT(3X,80A1)
      RETURN
      END


C==========================================================
C
C TREK7   MODULE B
C CONVERTED TO PC BY: DAN GAHLINGER
C ENTIRE MODULE TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C USER COMMAND ROUTINES
C
C AREX    CANCEL  CHEKOV  DEFLOC  NODEFL  GODOT
C GOLLUM  INFO    INST    UHURA   ORWELL  BLOCH
C SCOTT   STONE   ECCLE   TRACLC  NOTRAC  VULCAN
C MRESS   SHADOW
C
C=========================================================


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 AREX -
C
      SUBROUTINE AREX
      LOGICAL CYRANO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /F/WARP(4),ITROW(4),ITCOL(4)
      IF(TWARP(IT).NE.0.)GO TO 15
      WRITE(LLL,625)
625   FORMAT(' NO WARP LEFT - BREAK OUT THE OARS')
      RETURN
15    IF(A.EQ.0.OR.B.EQ.0)GO TO 150
      WARP(IT)=A
      ITCOL(IT)=B/100.
      ITROW(IT)=B-ITCOL(IT)*100
      IF(CYRANO(ITROW(IT),ITCOL(IT)).OR.WARP(IT).GT.TWARP(IT).OR.WARP(IT
     *).LT.0)GO TO 6581
      RETURN
150   WRITE(LLL,508)TWARP(IT)
508   FORMAT(' ENTER WARP FACTOR - BETWEEN 0 AND ',F10.7,': ',$)
      READ(L,*,ERR=6580)WARP(IT)
24    FORMAT(F15.7)
151   IF(WARP(IT).GT.TWARP(IT).OR.WARP(IT).LT.0)GO TO 6581
      WRITE(LLL,506)
506   FORMAT(' ENTER TARGET COORDINATES: ',$)
      READ(L,507,ERR=6580)ITCOL(IT),ITROW(IT)
507   FORMAT(2I2)
      IF(CYRANO(ITCOL(IT),ITROW(IT)))GO TO 6581
658   RETURN
6580  CALL ILLDAT
6581  CALL OOPS(LLL)
      WARP(IT)=0.
      GO TO 658
      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 CANCEL -
C
      SUBROUTINE CANCEL(IBORD)
      DIMENSION IGOK(5)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /H/ANGLE(4),RANG(4),LOCKT(4)
      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)
      DATA IGOK/'T','P','B','Y','D'/
      IF(IGOL(1).EQ.'C')GO TO 67210
      IF(IGOL(1).NE.IBLK)GO TO 6720
67210 WRITE(LLL,6704)
6704  FORMAT(' ENTER COMMANDS YOU WISH CANCELLED (P,T,B,Y,D, H FOR
     * HELP)')
6708  READ(L,6705)(IGOL(I),I=1,6)
6705  FORMAT(6A1)
6720  IF(IGOL(1).NE.'H')GO TO 6706
      WRITE(LLL,6707)
6707  FORMAT(' ENTER A STRING OF LETTERS REPRESENTING THE COMMANDS YOU W
     *ISH CANCELLED-'/' ''P'' TO CANCEL PHASER, ''T'' FOR TORPEDO/DISRUP
     *TOR'/' ''B'' FOR BOARD, ''Y'' FOR YANK, ''D'' FOR DEFLECT')
      GO TO 6708
6706  DO 6711 I7=1,6
      DO 6709 I=1,5
      IF(IGOL(I7).EQ.IGOK(I))GO TO (671,6712,674,6700,6701),1
6709  CONTINUE
      RETURN
6712  IF(LOCK(IT).NE.1)GO TO 6711
      LOCK(IT)=0
      PHASR(IT)=PHASR(IT)+ZAP(IT)
      WRITE(LLL,672)
672   FORMAT(' PHASER COMMAND CANCELLED')
      GO TO 6711
671   IF(LOCKT(IT).NE.1)GO TO 6711
      LOCKT(IT)=0
      IPHOT(IT)=IPHOT(IT)+1
      WRITE(LLL,673)
673   FORMAT(' TORPEDO/DISRUPTOR COMMAND CANCELLED')
      GO TO 6711
674   IBORD=0
      WRITE(LLL,675)
675   FORMAT(' BOARD COMMAND CANCELLED')
      GO TO 6711
6700  IPULL(IT)=0
      WRITE(LLL,6702)
6702  FORMAT(' YANK COMMAND CANCELLED')
      GO TO 6711
6701  IPUSH(IT)=0
      WRITE(LLL,6703)
6703  FORMAT(' DEFLECT COMMAND CANCELLED')
6711  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/27/2000 BY: D.G.
C
C - CHEKOV -
C
      SUBROUTINE CHEKOV
      LOGICAL LOKI
      DIMENSION IBOLT(4,2)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /H/ANGLE(4),RANG(4),LOCKT(4)
      DATA IBOLT/'PHOT','ON T','ORPE','DOES','DISR','UPTO','R BO','LTS'/
      IF(LOKI(LOCKT(IT)))RETURN
C      PRINT 33244,JS
C33244 FORMAT(//' TOP OF CHEKOV (TREKB) JS=',I6//)
      IF(IPHOT(IT).GT.0)GO TO 71
75    WRITE(LLL,72)(IBOLT(I,JS),I=1,4)
72    FORMAT(' THERE ARE NO ',4A4,' LEFT')
C      PRINT 22244
C22244 FORMAT(//' CHEKOV 22244 before 71 - first write'//)
      RETURN
71    DISTP=ANGLE(IT)
C      PRINT 22255
C22255 FORMAT(//' CHEKOV 22255 AFTER 71 IPHOT >= 0'//)
      RANG(IT)=10.
      IF(A.EQ.0)GO TO 7100
      ANGLE(IT)=A
      GO TO 71
C7100  PRINT 22211
C22211 FORMAT(//' CHEKOV 22211 at 7100 JS=',I4//)
7100  WRITE(LLL,3)IPHOT(IT),(IBOLT(I,JS),I=1,4)
73    FORMAT(' YOU HAVE',I3,1X,4A4/' ENTER ANGLE: ')
C      PRINT 22266
C22266 FORMAT(//' CHEKOV 22266 AFTER 73'//)
77    READ(L,*,ERR=130)ANGLE(IT)
24    FORMAT(F15.7)
711   IPHOT(IT)=IPHOT(IT)-1
C      PRINT 22233
C22233 FORMAT(//' CHEKOV 22233 after 711'//)
      LOCKT(IT)=1
      WRITE(LLL,3)
3     FORMAT(' WEAPON LOCKED ON TARGET')
      RETURN
130   ANGLE(IT)=DISTP
      CALL OOPS(LLL)
      CALL ILLDAT
      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 - DEFLOC
C
      SUBROUTINE DEFLOC
      LOGICAL LOKI,NODEFL,CYRANO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      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)
      IF(LOKI(IPUSH(IT)))RETURN
      IF(NODEFL(IT))RETURN
      IF(A.EQ.0.OR.B.EQ.0)GO TO 61
      PUSH(IT)=A
      IPUSHC(IT)=B/100.
      IPUSHR(IT)=B-IPUSHC(IT)*100.
      GO TO 62
61    WRITE(LLL,21)DISTP
21    FORMAT(' RANGE OF BEAM IS',F4.0,' UNITS'/' ENTER TARGET COORDINATE
     *S: ',$)
      A=0
      READ(L,22,ERR=250)IPUSHC(IT),IPUSHR(IT)
22    FORMAT(2I2)
62    IF(CYRANO(IPUSHR(IT),IPUSHC(IT)))GO TO 23
33    NA=MMAP(IPUSHR(IT),IPUSHC(IT))
      IF(NA.EQ.IGLE)GO TO 267
      IF(NA.EQ.IM(IT))GO TO 267
      GO TO 330
267   IF(A.NE.0)GO TO 63
      WRITE(LLL,53)
53    FORMAT(' ENTER DISTANCE YOU WISH TO PUSH OBJECT: ',$)
      READ(L,*,ERR=250)PUSH(IT)
29    FORMAT(F15.7)
63    WRITE(LLL,56)PUSH(IT)
56    FORMAT(' THIS WILL USE ',F11.7,' UNITS OF DEFLECTOR SHIELD
     * ENERGY')
      GO TO 57
330   IF(A.NE.0)GO TO 57
      WRITE(LLL,34)
34    FORMAT(' ENTER THE AMOUNT OF DEFLECTOR SHIELD ENERGY YOU WISH TO U
     *SE'/' (ENTER A NEGATIVE NUMBER FOR HELP)')
      READ(L,29,ERR=250)PUSH(IT)
57    IF(PUSH(IT).EQ.0)GO TO 23
      IF(PUSH(IT).GT.DFLCT(IT))GO TO 264
      IF(PUSH(IT).GT.0)GO TO 35
      WRITE(LLL,36)
36    FORMAT(' IF THE TARGET IS A SHIP-'/' THE AMOUNT OF ENERGY (E) ENTE
     *RED WILL SLOW THE ATTACKING ENEMY'/' SHIP''S SPEED BY A FACTOR OF
     * 2**(-E/5)'/' EG. 5 WILL CUT THE SHIP''S SPEED IN HALF,'/' 10 WILL
     * SLOW IT TO 1/4 SPEED, 15 WILL SLOW IT TO 1/8 SPEED' //' IF THE TA
     *RGET IS AN EAGLE OR MINE-'/' 1 UNIT OF DEFLECTOR SHIELD ENERGY IS
     * NEEDED FOR EACH UNIT THIS OBJECT'/' IS PUSHED AWAY'//' IF THE TAR
     *GET IS EMPTY SPACE OR AN ION STORM- NOTHING WILL HAPPEN'//' IF THE
     * TARGET IS A STAR, DOOMSDAY MACHINE OR MOONBASE ALPHA-'/' NOTHING
     * WILL HAPPEN AS THE TARGET IS TOO MASSIVE FOR THE DEFLECTORS'/' TO
     * HANDLE')
      PUSH(IT)=0.
      IF(A.NE.0)GO TO 61
      GO TO 33
35    IPUSH(IT)=1
      WRITE(LLL,37)
37    FORMAT(' DEFLECTORS LOCKED ON TARGET')
      RETURN
264   WRITE(LLL,265)
265   FORMAT(' NOT ENOUGH ENERGY TO LOCK BEAM')
      GO TO 23
250   CALL ILLDAT
23    CALL OOPS(LLL)
      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 - NODEFL -
C
      LOGICAL FUNCTION NODEFL(IT)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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)
      NODEFL=.FALSE.
      I7=33
      IF(IT.GT.2)I7=8
6     DISTP=9-MA(IT,I7)
      IF(MA(IT,I7).EQ.0)DISTP=10.
      IF(MA(IT,I7).NE.9)RETURN
4     WRITE(LLL,5)
5     FORMAT(' NAVIGATIONAL DEFLECTOR HAS BEEN DESTROYED')
      IPUSH(IT)=0
      NODEFL=.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               - GODOT -
C
C- LET'S GO
C- WE CAN'T
C- WHY NOT?
C- WE'RE WAITING FOR
      SUBROUTINE GODOT
      DIMENSION LEN1(31),LEN2(31)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /I/IONK(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 /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 /V/IWEB(2),IWEBZ,INVIS(4)
      IF(A.EQ.0)GO TO 5171
      DISTP=A
      GO TO 51702
5171  WRITE(LLL,121)NOMAP(IT)
121   FORMAT(' ENTER RADIUS OF MAP - BETWEEN 1 AND',I3,': ',$)
      READ(L,*,ERR=5170)DISTP
24    FORMAT(F15.7)
51702 N=DISTP
      IF(N.GE.1.AND.N.LE.NOMAP(IT))GO TO 550
51701 CALL OOPS(LLL)
      RETURN
5170  CALL ILLDAT
      GO TO 51701
550   I7=IENTR(IT)-N
      I8=IENTR(IT)+N
      IV=IENTC(IT)-N
      IVV=IENTC(IT)+N
      IF(I7.LT.1)I7=1
      IF(I8.GT.60)I8=60
      IF(IV.LT.1)IV=1
      IF(IVV.GT.60)IVV=60
      DO 552 J=IV,IVV
552   LEN1(J-IV+1)=J-(J/10)*10
      WRITE(LLL,5175)(LEN1(J),J=1,IVV-IV+1)
5175  FORMAT(3X,31I1)
      DO 5173 J=1,I8-I7+1
      IV1=I8-J+1
      JTK=IV1/10
C     ENCODE(1,5174,NB)JTK
      INA=NA+1
      WRITE(INA,'(I1)')JTK
      JTK=IV1-JTK*10
C     ENCODE(1,5174,NA)JTK
5174  WRITE(INA,'(I1)')JTK
C5174  FORMAT(I1)
C     NOTE THIS IS WHERE WE ATTEMPT TO CONVERT THE ENCODE STATMENTS-ONLY 2!
      JTK=0
      DO 100 I=IV,IVV
      JTK=JTK+1
      NC=MMAP(IV1,I)
      LEN2(JTK)=NC
      IF(NC.EQ.IBLK)GO TO 100
      IF(NC.EQ.III)GO TO 100
      IF(NC.EQ.ISTAR)GO TO 100
      IF(NC.NE.IENM1(2))GO TO 101
      IF(INVIS(IT).EQ.1)GO TO 100
      LEN2(JTK)=IBLK
      IF(ISPOK(2).EQ.1)LEN2(JTK)=III
      GO TO 100
101   IF(NC.NE.IENM1(6))GO TO 102
      IF(IARMZ(5).NE.1)GO TO 100
      IF(IKLNR(6).NE.J)GO TO 100
      IF(IKLNC(6).NE.I)GO TO 100
      IF(INVIZ(IT).EQ.1)GO TO 100
      LEN2(JTK)=IBLK
      IF(ISPOK(6).EQ.1)LEN2(JTK)=III
      GO TO 100
102   IF(NC.LT.IM(1))GO TO 100
      IF(NC.GT.IM(4))GO TO 100
      IF(NC.NE.IM(IT))GO TO 103
      LEN2(JTK)='M'
      GO TO 100
103   LEN2(JTK)=IBLK
100   CONTINUE
5173  WRITE(LLL,5172)IV1,(LEN2(I),I=1,JTK),NB,NA
5172  FORMAT(I3,33A1)
      WRITE(LLL,5175)(LEN1(J),J=1,IVV-IV+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   - GOLLUM -
C
C- MY PRECIOUS
      SUBROUTINE GOLLUM
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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 /U/LAUNCH,NUMOUT,NUME(2)
      IF(NUMOUT.EQ.0)RETURN
      WRITE(LLL,302)
302   FORMAT(' EAGLES-'/)
      I7=0
      DO 301 I=1,LAUNCH
      IF(IGLER(I).EQ.0)GO TO 301
      I7=I7+1
      WRITE(LLL,303)I,IGLEC(I),IGLER(I)
303   FORMAT('+',I2,' - (',I2,',',I2,')  ',$)
      IF(I7.NE.5)GO TO 301
      I7=0
      WRITE(LLL,304)
304   FORMAT(/' ',$)
301   CONTINUE
      WRITE(LLL,304)
      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
C                       - INFO
C
      SUBROUTINE INFO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      WRITE(LLL,587)(INAME(IQ0,IT),IQ0=1,3),DFLCT(IT),IENTC(IT),
     *IENTR(IT),NDEAD(IT)
587   FORMAT(22X,'DEFLECTORS POSITION'/1X,3A4,13X,F5.1,4X,'(',I2,',',I2,
     *')',5X,'CREW REMAINING=',I4)
      DO 770 N=1,4
      IF(ICHOE(N).EQ.0.OR.ICHOE(N).EQ.3)GO TO 770
      IF(N.EQ.IT)GO TO 770
      WRITE(LLL,771)(INAME(IQ0,N),IQ0=1,3),DFLCT(N),IENTC(N),IENTR(N)
771   FORMAT(1X,3A4,13X,F5.1,4X,'(',I2,',',I2,')')
770   CONTINUE
      DO 772 N=1,2
      IF(ICHOB(N).EQ.0)GO TO 772
      WRITE(LLL,773)(ISIDE(IQ0,N),IQ0=1,3),IBASE(N),DFLCB(N),IBASC(N),
     *IBASR(N)
773   FORMAT(1X,3A4,' STARBASE ',I3,1X,F5.1,4X,')',I2,',',I2,')')
772   CONTINUE
      DO 760 N=1,8
      IF(ICHOS(N).EQ.0)GO TO 760
      IF(N.NE.6.AND.IBPSB(N).EQ.IS)GO TO 761
      GO TO (761,762,761,761,763,764,763,761),N
761   WRITE(LLL,755)(IENM2(I,N),I=1,4),DFLCK(N),IKLNC(N),IKLNR(N)
755   FORMAT(1X,4A4,7X,F5.1,4X,'(',I2,',',I2,')')
      GO TO 760
762   IF(INVIS(IT).EQ.1)GO TO 761
      WRITE(LLL,757)(IENM2(I,2),I=1,4)
757   FORMAT(1X,4A4,7X,'UNKNOWN  UNKNOWN')
      GO TO 760
763   WRITE(LLL,756)(IENM2(I,N),I=1,4),IKLNC(N),IKLNR(N)
756   FORMAT(1X,4A4,7X,'UNKNOWN  (',I2,',',I2,')')
      GO TO 760
764   IF(IARMZ(4).EQ.1.AND.IMAGZ.GT.0)GO TO 91
      IF(IARMZ(5).EQ.1.AND.INVIZ(IT).EQ.0)GO TO 91
      WRITE(LLL,755)(IENM2(I,6),I=1,4),DFLCK(6),IKLNC(6),IKLNR(6)
      GO TO 760
91    WRITE(LLL,757)(IENM2(I,6),I=1,4)
760   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/27/2000 BY: D.G.
C
C IIIII N   N SSSSS TTTTT
C   I   NN  N S       T
C   I   N N N SSSSS   T
C   I   N  NN     S   T
C IIIII N   N SSSSS   T
C
      SUBROUTINE INST
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      WRITE(LLL,3)
3     FORMAT(' HERE ARE YOUR COMMANDS TO THE SHIP. '/' TYPE IN THE WORD
     * OR ITS FIRST TWO LETTERS TO INITIATE THE DESIRED ACTION'/
     *' HELP - PRINT THESE INSTRUCTIONS'/
     *' TRANSFER - TRANSFER OF ENERGY FROM ONE SYSTEM TO ANOTHER'/
     *' PHASER LOCK PHASER BANKS ON TARGET'/
     *' TORPEDO LOCK PHOTON TORPEDOES/DISRUPTORS ON TARGET'/
     *' MINE - SET THE RANGE AT WHICH A TORPEDO BECOMES A MINE'/
     *' YANK - LOCK TRACTOR BEAM ON TARGET'/
     *' DEFLECT - LOCK DEFLECTOR BEAM ON TARGET'/
     *' RESET - RESET PHASERS + TORPEDOES/DISRUPTORS ONTO TARGETS PREVIO
     *USLY SET')
      WRITE(LLL,5)
5     FORMAT(' BOARD - PREPARE TO TRANSPORT A BOARDING PARTY'/
     *' CANCEL - CANCELS PHASER, TORPEDO, BOARD, YANK AND/OR DEFLECT COM
     *MANDS'/
     *' COURSE - SET A NEW COURSE'/
     *' GO - MOVE AND FIRE WEAPONRY IN ANY SEQUENCE')
      WRITE(LLL,4)
4     FORMAT(' MAP - PRINT A MAP OF YOUR SURROUNDINGS'/
     *' INFO - TYPE OUT STATUS OF SHIPS IN THE GAME'/
     *' EAGLE   TYPE OUT POSITION OF EAGLES'/
     *' SPOCK   GIVES PROBABILITIES AND DISTANCES'/
     *' CREW - GIVES NUMBER OF CREW ON YOUR SHIP AND ON BOARDED SHIPS'/
     *' DAMAGE - ALL DECKS REPORT DAMAGE FACTORS'/
     *' ENEMY   ADD ANOTHER ENEMY SHIP TO THE GAME'/
     *' RADIO   USE SUBSPACE RADIO TO CONTACT OTHER MANUALLY-OPERATED
     * SHIPS'/
     *' ATTACK - STARBASE OR BOARDED VESSELS ATTACK'/
     *' CEASE   STARBASE OR BOARDED VESSELS STOP ATTACKING'/
     *' NOSTOP - DO NOT STOP THE GAME WHEN ALL THE ENEMIES HAVE BEEN DEF
     *EATED'/
     *'  SURRENDER - SURRENDER'/)
      WRITE(LLL,800)
800   FORMAT('  IF YOU WISH TO ENTER THE COORDINATES (60,60) OR (1, 1),
     *'/' TYPE 6060 OR 0101.')
      WRITE(LLL,801)
801   FORMAT(' THE RANGE OF A PHOTON TORPEDO OR DISRUPTOR BOLT IS 10 UNI
     *TS'/' NOTE ALSO THAT THERE IS A MAXIMUM AMOUNT OF DAMAGE THAT CAN
     * BE DONE'/' WHEN A PHASER BEAM IS FIRED. THUS YOU ARE ADVISED NOT
     * TO WASTE YOUR ENERGY'/' BY FIRING TOO MUCH AT A TIME. I ADVISE AB
     *OUT 500 UNITS PER SHOT')
32    WRITE(LLL,33)
33    FORMAT(' IF WE ENTER AN ION STORM WE WILL RECEIVE DAMAGE'/' AND O
     *UR SPEED WILL BE CUT IN HALF')
      WRITE(LLL,38)
38    FORMAT(' ENEMY STRATEGY AND STRENGTH-')
34    WRITE(LLL,37)
35    FORMAT(' KLINGONS ALWAYS ATTACK'/' ROMULANS RETREAT WHEN YOUR SHIE
     *LDS EXCEED THEIRS BY 20,'/'  AND DO NOT TRAVEL ON A DIRECT COURSE
     * TO OR FROM YOU WHEN ATTACKING'/' OR RETREATING'/' THOLIANS ALW
     *AYS ATTACK, BUT HALT WHEN THEY ARE 8 UNITS AWAY + USE THEIR WEB',
     */' GORNS RETREAT UNTIL THEIR SHIELDS ARE > THAN YOURS BY 25',
     */' ORIONS MAKE CLOSE PASSES AT US AND FIRE WHEN THEY"RE CLOSEST'/
     *' THE DOOMSDAY MACHINE EATS STARS, MINES, + US'/' MOONBASE ALPHA
     * LAUNCHES 5 WAVES OF 5 EAGLES')
36    WRITE(LLL,35)
37    FORMAT(' ENEMY',12X,'WARP FIREPOWER'//' KLINGONS',9X,'7-9 450-110
     *0'/' ROMULANS',9X,'7-9 300-1000'/' THOLIANS',9X,'5-10 600-900'/'
     *GORNS',12X,'11  350-900'/' ORIONS',11X,'12    500-1100'/' KZINTI
     *',11X,'PLAYER PROGRAMMABLE'/' DOOMSDAY MACHINE ??? 1000-2000'/' M
     *OONBASE ALPHA  0    500'/' EAGLES',11X,'2.9  200'//'FIREPOWER IS
     *GIVEN IN EQUIVALENT ENTERPRISE PHASER UNITS')
      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 - UHURA -
C
      SUBROUTINE UHURA
      INTEGER JCOMS(5)
      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,MES(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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 /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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /TOM/ITOM
      DATA JCOMS/'T','R','J','D','H'/
      WRITE(LLL,1)
1     FORMAT(' ENTER COMMUNICATIONS COMMAND (T,R,J,D,HELP,
     *STOP): ',$)
43    READ(L,14)NA
      DO 40 I7=1,5
      IF(NA.EQ.JCOMS(I7))GO TO (4,4,6,7,41),I7
40    CONTINUE
      RETURN
41    WRITE(LLL,42)
42    FORMAT(' ENTER ''T'' FOR SHIP-TO-SHIP TRANSMISSION'/' ''R'' FOR SH
     *IP-TO-SHIP RECEPTION'/' ''J'' TO JAM SUBSPACE FREQUENCIES'/' ''D''
     * TO ACTIVATE DISTRESS SIGNAL')
      GO TO 43
200   CALL ILLDAT
      GO TO 20
7     DO 8 I=1,4
      IF(ICHOE(I).EQ.0)GO TO 8
      IF(I.EQ.IT)GO TO 8
      I7=I+4
      II7=I7+1
      WRITE(II7,9)(INAME(IQ0,IT),IQ0=1,3)
9     FORMAT(' WE ARE RECEIVING A DISTRESS SIGNAL FROM THE ',3A4)
8     CONTINUE
      WRITE(LLL,10)
10    FORMAT(' DISTRESS SIGNAL TRANSMITTED')
      RETURN
6     WRITE(LLL,11)
11    FORMAT(' ENTER PHASER ENERGY YOU WISH TO EXPEND JAMMING SUBSPACE C
     *OMMUNICATIONS')
      READ(L,*,ERR=200)DISTP
12    FORMAT(F15.7)
      IF(DISTP.GT.PHASR(IT).OR.DISTP.LT.-STATIC(IT))GO TO 20
      STATIC(IT)=STATIC(IT)+DISTP
      PHASR(IT)=PHASR(IT)-DISTP
      DISTP=STATIC(IT)/5.
      IF(DISTP.LT.1.)DISTP=1.
      WRITE(LLL,13)DISTP
13    FORMAT(' THIS WILL BOOST SUBSPACE INTERFERENCE LEVELS BY A MAXIMUM
     * OF ',F6.1,' TIMES NORMAL')
      RETURN
4     WRITE(LLL,5)
5     FORMAT(' ENTER SHIP YOU WISH TO CONTACT (E,P,H,C): ',$)
      READ(L,14)NA
14    FORMAT(A1)
      DO 15 I=1,4
      IF(NA.EQ.IEE(I))GO TO 16
15    CONTINUE
20    CALL OOPS(LLL)
      RETURN
16    IF(I.NE.IT)GO TO 18
      WRITE(LLL,19)
19    FORMAT(' YOU''RE TALKING TO YOURSELF !?!')
      GO TO 20
18    IF(ICHOE(I).NE.1)GO TO 20
      AJUST=1.
      DO 21 IV=1,4
      IF(STATIC(IT).EQ.0)GO TO 21
      DISTP=STATIC(IV)/1000.*(200.-DI(IENTR(IV),IENTC(IV),IENTR(IT),
     *IENTC(IT))-DI(IENTR(IV),IENTC(IV),IENTR(I),IENTC(I)))
      IF(DISTP.LT.1.)DISTP=1.
      AJUST=AJUST*DISTP
21    CONTINUE
      AJUST=AJUST*DI(IENTR(I),IENTC(I),IENTR(IT),IENTC(IT))*(ISPOT(IT)+1
     *)*(ISPOT(I)+1)*2.5
      IF(ICHOS(7).EQ.1.OR.AJUST.GT.100.)AJUST=100.
23    WRITE(LLL,22)AJUST
22    FORMAT(' SUBSPACE INTERFERENCE LEVEL=',F6.2,'% -ENTER PHASER ENERG
     *Y TO BE USED: ',$)
      READ(L,12,ERR=200)DISTP
      IF(DISTP.GT.PHASR(IT).OR.DISTP.LE.0.)GO TO 20
      HARLAN=AJUST*AJUST/(5.0*DISTP)
      IF(HARLAN.GT.AJUST)HARLAN=AJUST
      WRITE(LLL,24)HARLAN
24    FORMAT(' INTERFERENCE LEVEL NOW=',F6.2,'% -ENTER CODE (O(HAILING F
     *REQ) TO 8,STOP): ',$)
      READ(L,2,ERR=200)MMIN
2     FORMAT(I1)
      PHASR(IT)=PHASR(IT)-DISTP
      IF(MMIN.LT.0.OR.MMIN.GT.8)GO TO 20
      IF(MMIN.EQ.0.OR.IS.EQ.(IBPSC(I)+1)/2)GO TO 38
      WRITE(LLL,39)
39    FORMAT(' BUT THE OTHER SHIP WON''T BE ABLE TO UNDERSTAND YOU!')
      GO TO 20
38    IF(I7.EQ.2)GO TO 25
      WRITE(LLL,26)
26    FORMAT(' ENTER YOUR MESSAGE (80 CHARACTERS MAX.)')
      I8=L
      GO TO 27
25    I8=IBPSC(I)+4
      II8=I8+1
      WRITE(II8,28)(INAME(IQ0,IT),IQ0=1,3)
28    FORMAT(' ENTER ANY MESSAGE YOU HAVE FOR THE ',3A4,' (80 CHARS
     * MAX.)')
27    READ(I8,29)MES
29    FORMAT(80A1)
      N=HARLAN*0.8
      IF(N.LT.1)N=1
      IF(N.GT.150)N=150
      DO 32 IV=1,N
      CALL RANDO(JTK,32,93)
      JTK=JTK*2
      CALL RANDO(ISTAT,1,80)
C      DECODE(5,320,JTK)MES(ISTAT)
C320   FORMAT(A5)
320   READ(JTK,'(A5)')MES(ISTAT)
C ATTEMPT #1 TO CONVERT DECODE - THIS IS THE ONLY PLACE DECODE IS USED!
32    CONTINUE
      IF(I7.EQ.2)GO TO 33
      I8=IBPSC(I)+4
      II8=I8+1
      WRITE(II8,34)(INAME(IQ0,IT),IQ0=1,3),MES
34    FORMAT(' MESSAGE FROM THE ',3A4/1X,80A1)
      GO TO 35
33    WRITE(LLL,34)(INAME(IQ0,I),IQ0=1,3),MES
35    DO 36 JTK=1,4
      IF(ICHOE(JTK).NE.1)GO TO 36
      IF(JTK.EQ.IT)GO TO 36
      IF(JTK.EQ.I)GO TO 36
      IF(MMIN.EQ.0)GO TO 37
      IF(IS.EQ.(IBPSC(JTK)+1)/2)GO TO 37
      IF(KODE(IS,MMIN).EQ.1)GO TO 37
      CALL RANDO(IV,1,10)
      IF(IV.GT.1)GO TO 36
      KODE(IS,MMIN)=1
37    I8=IT
      ISTAT=I
      IF(I7.EQ.1)GO TO 370
      I8=I
      ISTAT=IT
370   N=IBPSC(JTK)+4
      NNN=N+1
      WRITE(NNN,380)(INAME(IQ0,I8),IQ0=1,3),(INAME(IQ0,ISTAT),IQ0=1,3),MES
380   FORMAT(' WE HAVE INTERCEPTED AND DECODED THE FOLLOWING MESSAGE'/
     *' FROM THE ',3A4,' TO THE ',3A4/1X,80A1)
36    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/27/2000 BY: D.G.
C
C - ORWELL -
C
      SUBROUTINE ORWELL(IBORD,NUM,IROW,ICOL)
      LOGICAL CYRANO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      JTK=7
      IF(JS.EQ.2)JTK=26
      I7=MA(IT,JTK)+1
      IF(I7.EQ.1)GO TO 15
      WRITE(LLL,20)I7
20    FORMAT(' THE DECK CONTAINING THE TRANSPORTERS HAS RECEIVED'/
     *' DAMAGE FACTOR',I3,'. IF THIS IS VERY LARGE,  A NUMBER OF'/
     *' YOUR PARTY MAY NOT SURVIVE THE TELEPORTATION.')
15    IF(A.EQ.0.OR.B.EQ.0)GO TO 12
      NUM=A
      ICOL=B/100
      IROW=B-ICOL*100
      GO TO 13
12    WRITE(LLL,1)
1     FORMAT(' BOARDING PARTY PREPARATION - ENTER NUMBER OF CREW'/
     *' TO BE TRANSPORTED DOWN (ENTER A NEGATIVE AMOUNT IF CREW IS TO BE
     * BEAMED UP)')
      READ(L,4,ERR=14)NUM
4     FORMAT(I7)
      WRITE(LLL,8)
8     FORMAT(' ENTER CO-ORDINATES OF TARGET')
      READ(L,9,ERR=14)ICOL,IROW
9     FORMAT(2I2)
13    IF(CYRANO(IROW,ICOL))GO TO 10
      IBORD=1
      RETURN
14    CALL ILLDAT
10    CALL OOPS(LLL)
5     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 BLOCH -
C
C- I HAVE THE HEART OF A CHILD
C- (I KEEP IT IN A JAR ON MY DESK)
      SUBROUTINE BLOCH
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /H/ANGLE(4),RANG(4),LOCKT(4)
      IF(LOCK(IT).NE.0)GO TO 901
      IF(ICOIL(IT).EQ.1)GO TO 908
      IF(PHASR(IT)-ZAP(IT).LT.0)GO TO 902
      LOCK(IT)=1
      PHASR(IT)=PHASR(IT)-ZAP(IT)
      WRITE(LLL,903)
903   FORMAT(' PHASERS RE-LOCKED ON TARGET')
      GO TO 901
902   WRITE(LLL,904)
904   FORMAT('-NOT ENOUGH ENERGY TO RE-LOCK PHASERS')
      GO TO 901
908   WRITE(LLL,909)
909   FORMAT(' MAIN COIL BURNOUT - PHASERS UNDER REPAIR')
901   IF(LOCKT(IT).NE.0)RETURN
      IF(IPHOT(IT).LE.0)GO TO 905
      LOCKT(IT)=1
      IPHOT(IT)=IPHOT(IT)-1
      IF(JS.EQ.1)GO TO 900
      WRITE(LLL,910)
910   FORMAT(' DISRUPIOR BOLTS RE-LOCKED ON TARGET')
      RETURN
900   WRITE(LLL,906)
906   FORMAT(' PHOTON TORPEDOES RE-LOCKED ON TARGET')
      RETURN
905   IF(JS.EQ.1)GO TO 911
      WRITE(LLL,912)
912   FORMAT(' NO DISRUPTOR BOLTS LEFT')
      RETURN
911   WRITE(LLL,907)
907   FORMAT(' NO PHOTON TORPEDOES LEFT')
      RETURN
      END


C       -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K7
C CONVERTED TO PC BY: DAN GAHLINGER
C TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C       SSSS   CCCC  OOO  TTTTT TTTTT
C       S     C     O   O   T     T
C        SSS  C     O   O   T     T
C           S C     O   O   T     T
C       SSSS   SSSS  OOO    T     T

      SUBROUTINE SCOTT
      INTEGER TRANS(8)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      DATA TRANS/'PW','WP','WD','DW','PD','DP','TD','DD'/
625   WRITE(LLL,600)DFLCT(IT),PHASR(IT),TWARP(IT),IPHOT(IT)
600   FORMAT(' DEFLECTORS=',F11.7,', PHASERS=',F13.7,', WARP=',F10.7,
     *', TORPS=',I3)
6320  IF(DFLCT(IT).LT.0)DFLCT(IT)=0
632   WRITE(LLL,6331)
6331  FORMAT(' ENTER PW,WP,WD,DW,PD,DP,TD,DD,HELP,STOP: ',$)
      ZAP=0.
      READ(L,92,ERR=6461)NA,ZAP
92    FORMAT(A2,1X,F15.7)
      IF(NA.EQ.'HE')GO TO 651
      IF(NA.EQ.'ST')GO TO 6
      IF(NA.EQ.'**')GO TO 700
      IF(NA.EQ.'??')GO TO 625
627   DO 636 I=1,8
      IF(TRANS(I).EQ.NA)GO TO 635
636   CONTINUE
      GO TO 646
6461  CALL ILLDAT
      IF(NA.EQ.'HE')GO TO 651
      IF(NA.EQ.'ST')GO TO 6
      GO TO 646
635   IF(ZAP.NE.0)GO TO 628
      WRITE(LLL,634)
634   FORMAT(' TYPE IN AMOUNT YOU WISH TO TRANSFER: ',$)
660   READ(L,24,ERR=6461)ZAP
24    FORMAT(F15.7)
628   IF(ZAP.LT.0.AND.I.NE.8)GO TO 646
      GO TO (637,638,639,640,641,642,643,6601),I
646   CALL OOPS(LLL)
6     RETURN
637   IF(ZAP.GT.PHASR(IT))GO TO 646
      ZAP=ZAP/1000.
      IF(TWARP(IT)+ZAP.GT.10.)ZAP=10.-TWARP(IT)
      TWARP(IT)=TWARP(IT)+ZAP
      PHASR(IT)=PHASR(IT)-1000.*ZAP
      GO TO 6320
638   IF(ZAP.GT.TWARP(IT))GO TO 646
      TWARP(IT)=TWARP(IT)-ZAP
      PHASR(IT)=PHASR(IT)+ZAP*1000.
      GO TO 6320
639   IF(ZAP.GT.TWARP(IT))GO TO 646
      ZAP=ZAP*10
      IF(DFLCT(IT)+ZAP.GT.100.)ZAP=100.-DFLCT(IT)
      DFLCT(IT)=DFLCT(IT)+ZAP
      TWARP(IT)=TWARP(IT)-ZAP/10.
      GO TO 6320
640   IF(ZAP.GT.DFLCT(IT))GO TO 646
      ZAP=ZAP/10.
      IF(TWARP(IT)+ZAP.GT.10.)ZAP=10.-TWARP(IT)
      TWARP(IT)=TWARP(IT)+ZAP
      DFLCT(IT)=DFLCT(IT)-ZAP*10.
      GO TO 6320
641   IF(ZAP.GT.PHASR(IT))GO TO 646
      ZAP=ZAP/100.
      IF(DFLCT(IT)+ZAP.GT.100.)ZAP=100.-DFLCT(IT)
      DFLCT(IT)=DFLCT(IT)+ZAP
      PHASR(IT)=PHASR(IT)-ZAP*100.
      GO TO 6320
642   IF(ZAP.GT.DFLCT(IT))GO TO 646
      DFLCT(IT)=DFLCT(IT)-ZAP
      PHASR(IT)=PHASR(IT)+ZAP*100.
      GO TO 6320
643   IF(ZAP.GT.FLOAT(IPHOT(IT)))GO TO 646
      IF(DFLCT(IT)+6.*ZAP.GT.100.)ZAP=IFIX((100.-DFLCT(IT))/6.)
      DFLCT(IT)=DFLCT(IT)+6.*ZAP
      IPHOT(IT)=IPHOT(IT)-IFIX(ZAP)
      GO TO 6320
651   WRITE(LLL,650)
650   FORMAT(' TYPE IN 2 LETTERS (A2) - 1ST LETTER IS THE SYSTEM YOU WIS
     *H TO TRANSFER ENERGY FROM'/' AND THE 2ND LETTER IS WHERE YOU WISH
     * TO TRANSFER IT TO'/' (WARP ENGINES(W), PHASER BANKS(P), TORPEDO/D
     *ISRUPTOR BANKS(T),DEFLECTOR SHIELDS(D))'/' (PW,WP,WD,DW,PD,
     *DP,TD)'/)
38    WRITE(LLL,39)
39    FORMAT(' 1 WARP = 10 DEFLECTOR SHIELD UNITS = 1000 PHASER UNITS'/
     *' 1 PHOTON TORPEDO = 6 DEFLECTOR SHIELD UNITS')
      WRITE(LLL,6500)
6500  FORMAT(' THE ''DD'' COMMAND TRANSFERS DEFLECTOR SHIELD ENERGY BETW
     *EEN SHIPS'/' AS LONG AS YOU ARE WITHIN ONE UNIT OF EACH OTHER. '/
     *' WHEN ASKED TO TYPE IN THE AMOUNT OF ENERGY, TYPE A POSITIVE NUMB
     *ER'/' TO GIVE THE OTHER SHIP THAT AMOUNT OF ENERGY FROM YOUR DEFLE
     *CTORS.'/' TYPE A NEGATIVE NUMBER TO TAKE THAT AMOUNT OF ENERGY FRO
     *M'/' THE OTHER SHIP AND PUT IT IN YOUR DEFLECTORS (YOU CAN ONLY TA
     *KE'/' ENERGY FROM A BOARDED SHIP).'/' YOU''LL ALSO BE ASKED TO ENT
     *ER THE LETTER OF THE SHIP YOU WISH'/' TO TRANSFER ENERGY WITH - TY
     *PE ''K'' FOR KLINGON, ''R'' FOR ROMULAN'/' ''Z'' FOR KZINTI, ETC.'
     *//' IF YOU TYPE ''**'', YOU CAN TRANSFER ENERGY, PERSONNEL AND TOR
     *PEDOES WITH STARBASE')
      GO TO 632
6601  WRITE(LLL,661)
661   FORMAT( ' ENTER LETTER OF SHIP YOU WISH TO TRANSFER ENERGY
     * WITH: ',$)
      READ(L,93)NA
93    FORMAT(A1)
      DO 662 I=1,8
      IF(IENM1(I).EQ.NA)GO TO 663
662   CONTINUE
      GO TO 6460
663   IF(ICHOS(I).EQ.0)GO TO 646
      IF(DI(IKLNC(I),IKLNR(I),IENTC(IT),IENTR(IT)).LT.2.)GO TO 665
672   WRITE(LLL,664)
664   FORMAT(' SHIP OUT OF RANGE')
      GO TO 6320
665   IF(ZAP.LT.0)GO TO 666
      IF(ZAP.GT.DFLCT(IT))GO TO 646
      IF(DFLCK(I)+ZAP.GT.100.)ZAP=100.-DFLCK(I)
667   DFLCK(I)=DFLCK(I)+ZAP
678   DFLCT(IT)=DFLCT(IT)-ZAP
      GO TO 6320
666   IF(IBPSB(I).NE.IS)GO TO 646
      IF(DFLCK(I)+ZAP.LT.0)GO TO 646
      IF(DFLCT(IT)-ZAP.GT.100.)ZAP=DFLCT(IT)-100.
      GO TO 667
6460  DO 670 I=1,4
      IF(IEE(I).EQ.NA)GO TO 671
670   CONTINUE
      GO TO 646
671   IF(ICHOE(I).EQ.0.OR.ICHOE(I).EQ.3)GO TO 646
      IF(DI(IENTR(I),IENTC(I),IENTR(IT),IENTC(IT)).GE.2.)GO TO 672
      IF(ZAP.LT.0)GO TO 676
      IF(ZAP.GT.DFLCT(IT))GO TO 646
      IF(DFLCT(I)+ZAP.GT.100.)ZAP=100.-DFLCT(I)
677   DFLCT(I)=DFLCT(I)+ZAP
      GO TO 678
676   IF((IBPSC(I)+1)/2.NE.IS)GO TO 646
      IF(ICHOE(I).EQ.1)GO TO 646
      IF(DFLCT(I)+ZAP.LT.0)GO TO 646
      IF(DFLCT(IT)-ZAP.GT.100.)ZAP=DFLCT(IT)-100.
      GO TO 677
700   DO 701 I=1,2
      IF(ICHOB(I).EQ.0)GO TO 701
      IF(IBPSS(I).NE.IS)GO TO 701
      IF(DI(IENTR(IT),IENTC(IT),IBASR(I),IBASC(I)).GE.2.)GO TO 701
      CALL STONE
      GO TO 6320
701   CONTINUE
      WRITE(LLL,702)
702   FORMAT(' WE ARE NOT DOCKED AT OUR STARBASE')
      GO TO 6320
      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 - STONE -
C
      SUBROUTINE STONE
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
7     WRITE(LLL,5)NDEAB(I),NDEAD(IT)
5     FORMAT(' TYPING A NEGATIVE NUMBER TO THE NEXT 3 GUESTIONS WILL CAU
     *SE THOSE THINGS TO BE'/' TRANSFERRED FROM YOU TO THE STARBASE'/' W
     *E HAVE',I5,' PERSONNEL, YOU HAVE ',I4,/' HOW MANY DO YOU WISH TO R
     *EINFORCE YOUR SHIP? ',$)
      IV=1
      READ(L,6,ERR=13)I7
6     FORMAT(I7)
      IF(I7.GT.NDEAB(I).OR.I7.GT.NDEAD(IT))GO TO 7
      NDEAD(IT)=NDEAD(IT)+I7
      NDEAB(I)=NDEAB(I)-I7
      IF(NDEAB(I).GT.0)ICHOB(I)=1
10    WRITE(LLL,8)DFLCB(I),DFLCT(IT)
8     FORMAT(' OUR DEFLECTORS=',F11.7,', YOUR DEFLECTORS=',F11.7/' BY HO
     *W MUCH DO YOU WISH TO BOOST YOUR SHIELDS? ',$)
      IV=2
      READ(L,9,ERR=13)DISTP
9     FORMAT(F15.7)
      IF(DISTP.GT.DFLCB(I).OR.DISTP.GT.DFLCT(IT))GO TO 10
      IF(DFLCT(IT)+DISTP.GT.100.)DISTP=100.-DFLCT(IT)
      IF(DFLCB(I)-DISTP.GT.300.)DISTP=DFLCB(I)-300.
      DFLCT(IT)=DFLCT(IT)+DISTP
      DFLCB(I)=DFLCB(I)-DISTP
12    WRITE(LLL,11)IPHOB(I),IPHOT(IT)
11    FORMAT(' WE HAVE ',I2,' PHOTON TORPEDOES/DISRUPTOR BOLTS, YOU HAVE
     *',I3/' HOW MANY DO YOU WISH? ',$)
      IV=3
      READ(L,6,ERR=13)I7
      IF(I7.GT.IPHOB(I).OR.I7.GT.IPHOT(IT))GO TO 12
      IPHOT(IT)=IPHOT(IT)+I7
      IPHOB(I)=IPHOB(I)-I7
1     CONTINUE
      RETURN
13    CALL ILLDAT
      GO TO (7,10,12),IV
      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 - ECCLE -
C
      SUBROUTINE ECCLE(NANU)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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),Ll2R(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 /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)
      IF(NANU.EQ.1)GO TO 720
      WRITE(LLL,705)
705   FORMAT(' PLEASE STANDBY......')
      DO 704 I=1,4
      IF(ICHOE(I).NE.1)GO TO 704
      IF(I.EQ.IT)GO TO 704
      N=IBPSC(I)+4
      NNN=N+1
      WRITE(NNN,703)
703   FORMAT(' A REQUEST HAS BEEN MADE FOR A NEW COMPUTER-CONTROLLED ENE
     *MY. DO YOU AGREE?')
      READ(N,702)NA
702   FORMAT(A1)
      IF(NA.NE.'Y')GO TO 701
704   CONTINUE
      WRITE(LLL,716)
716   FORMAT(' ENTER THE LETTER STANDING FOR THE ENEMY YOU WISH IN THE G
     *AME'/' (''K'' FOR KLINGON, ETC.) ENTER A ''?'' IF YOU WISH AN ENEM
     *Y CHOSEN AT RANDOM')
      READ(L,702)NA
      DO 717 I=1,8
      IF(NA.EQ.IENM1(I))GO TO 718
717   CONTINUE
7070  I7=0
      DO 706 I=1,7
706   I7=I7+ICHOS(I)
      IF(I7.GE.6)GO TO 712
707   CALL RANDO(I,1,7)
      IF(I.EQ.6)GO TO 707
718   IF(ICHOS(I).EQ.1)GO TO 7070
708   CALL RANDO(IKLNR(I),2,59)
      CALL RANDO(IKLNC(I),2,59)
      NA=MMAP(IKLNR(I),IKLNC(I))
      IF(NA.NE.IBLK.AND.NA.NE.III)GO TO 708
      IF(I.NE.8)GO TO 600
      IF(NA.EQ.III)GO TO 708
      IF(NUMOUT.EQ.0)GO TO 600
      WRITE(LLL,601)
601   FORMAT(' YOU MUST GET RID OF ALL EAGLES BEFORE YOU CAN'/
     *'    FIGHT ANOTHER MOONBASE')
      RETURN
600   ICHOS(I)=1
      DFLCK(I)=100.
      IONK(I)=0
      ISPOK(I)=0
      IBPSB(I)=0
      IF(I.NE.7)IBPOB(I)=0
      IGOCO(I)=1
      JTK=1
      IF(I.NE.6)GO TO 719
      CALL KZIN
      CALL NIVEN
      GO TO 710
719   IF(I.NE.8)GO TO 709
      DFLCK(8)=70.
      LAUNCH=0
      IF(LAUNCH.GE.25)GO TO 709
      CALL LEGUIN(0,0)
709   CALL ASIMOV(NA,I)
      MMAP(IKLNR(I),IKLNC(I))=IENM1(I)
710   WRITE(LLL,711)(IENM2(IV,I),IV=1,4)
711   FORMAT(' REINFORCEMENTS ARE IN THE FORM OF A SHINY NEW'//10X,4A4/)
      I3=I3+1
      ISHAK=0
      IF(NOSTOP.EQ.2)NOSTOP=1
      RETURN
712   WRITE(LLL,714)
714   FORMAT(' WHY DON''T YOU TRY FIGHTING THE ENEMIES YOU ALREADY
     * HAVE?')
      RETURN
701   DO 700 N=1,4
      IF(ICHOE(N).NE.1)GO TO 700
      IV=N+4
      IVI=IV+1
      WRITE(IVI,715)
715   FORMAT(' REQUEST FOR ENEMY VETOED')
700   CONTINUE
      NANU=1
      RETURN
720   WRITE(LLL,721)
721   FORMAT(' REQUEST HAS ALREADY BEEN VETOED - TRY AGAIN NEXT TURN')
      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        - TRACLC
C
      SUBROUTINE TRACLC
      LOGICAL LOKI,NOTRAC,CYRANO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      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)
      IF(LOKI(IPULL(IT)))RETURN
      IF(NOTRAC(IT))RETURN
      IF(A.EQ.0.OR.B.EQ.0)GO TO 58
      PULL(IT)=A
      IPULLC(IT)=B/100.
      IPULLR(IT)=B-IPULLC(IT)*100.
      GO TO 59
58    WRITE(LLL,21)DISTP
21    FORMAT(' RANGE OF BEAM IS, F4. 0, UNITS'/' ENTER TARGET COORD
     *INATES:  ',$)
      A=0
      READ(L,22,ERR=250)IPULLC(IT),IPULLR(IT)
22    FORMAT(2I2)
59    IF(CYRANO(IPULLR(IT),IPULLC(IT)))GO TO 23
26    NA=MMAP(IPULLR(IT),IPULLC(IT))
      IF(NA.EQ.IGLE)GO TO 261
      IF(NA.EQ.IM(IT))GO TO 261
      GO TO 260
261   IF(A.NE.0)GO TO 60
      WRITE(LLL,50)
50    FORMAT(' ENTER DISTANCE YOU WISH TO PULL OBJECT: ',$)
      READ(L,29,ERR=250)PULL(IT)
60    PULL(IT)=PULL(IT)/10.
      WRITE(LLL,51)PULL(IT)
51    FORMAT(' THIS WILL USE ',F10.7,' UNITS OF WARP ENERGY')
      GO TO 52
260   IF(A.NE.0)GO TO 52
      WRITE(LLL,28)
28    FORMAT(' ENTER THE AMOUNT OF WARP ENERGY YOU WISH TO USE'/' (ENTER
     *  A NEGATIVE NUMBER FOR HELP)')
      READ(L,29,ERR=250)PULL(IT)
29    FORMAT(F15.7)
52    IF(PULL(IT).EQ.0)GO TO 23
      IF(PULL(IT).GT.TWARP(IT))GO TO 264
      IF(PULL(IT).GT.0)GO TO 40
      WRITE(LLL,41)
41    FORMAT(' IF THE TARGET IS A SHIP-'/' THE AMOUNT OF ENERGY (E) ENTE
     *RED WILL SLOW THE RETREATING ENEMY'/' SHIP''S SPEED BY A FACTOR OF
     * 2**(-E/0. 5)'/' EG. 0.5 WILL CUT THE SHIP''S SPEED IN HALF, '/' 1
     *.0 WILL SLOW IT TO 1/4 SPEED, 1.5 WILL SLOW IT TO 1/8 SPEED'//' IF
     *THE TARGET IS AN EAGLE OR MINE'/' 0.1 UNITS OF WARP ENERGY ARE NEE
     *DED FOR EACH UNIT THIS OBJECT IS PULL-ED IN'//' IF THE TARGET IS E
     *MPTY SPACE OR AN ION STORM-NOTHING WILL HAPPEN'//' IF THE TARGET I
     *S A STAR, DOOMSDAY MACHINE OR MOONBASE ALPHA-'/' NOTHING WILL HAPP
     *EN AS THE TARGET IS TOO MASSIVE FOR THE TRACTORS'/' TO HANDLE')
      PULL(IT)=0.
      IF(A.NE.0)GO TO 58
      GO TO 26
40    IPULL(IT)=1
      WRITE(LLL,42)
42    FORMAT(' TRACTORS LOCKED ON TARGET')
      RETURN
264   WRITE(LLL,265)
265   FORMAT(' NOT ENOUGH ENERGY TO LOCK BEAM')
      GO TO 23
250   CALL ILLDAT
23    CALL OOPS(LLL)
      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                       - NOTRAC -
C
      LOGICAL FUNCTION NOTRAC(IT)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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)
      NOTRAC=.FALSE.
      I7=27
      IF(IT.GT.2)I7=5
6     DISTP=9-MA(IT,I7)
      IF(MA(IT,I7).EQ.0)DISTP=10.
      IF(MA(IT,I7).NE.9)RETURN
      WRITE(LLL,3)
3     FORMAT(' TRACTOR BEAM MACHINERY ROOM HAS BEEN DESTROYED')
      IPULL(IT)=0
      NOTRAC=.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 -       VULCAN -
C
      SUBROUTINE VULCAN
      INTEGER PONFAR(6)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      DATA PONFAR/'HE','WE','WA','PH','DO','DI'/
      WRITE(LLL,1)
1     FORMAT(' SPOCK HERE, CAPTAIN.....')
2     WRITE(LLL,201)
201   FORMAT(' ENTER WEB,WARP,PHASER,DOOM,DIST,HELP FOR HELP,STOP
     * TO STOP')
8     READ(L,4)NA
4     FORMAT(A2)
      DO 9 I=1,10
      IF(PONFAR(I).EQ.NA)GO TO (10,20,23,24,26,28),I
9     CONTINUE
      IF(NA.EQ.'ST')GO TO 200
      GO TO 6
10    WRITE(LLL,5)
5     FORMAT(' ENTER ''WEB'' TO LIST PROBABILITIES IF CAUGHT IN A WEB'/
     *' ''WARP'' FOR ENGINE PROBABILITIES'/
     *' ''PHASER'' FOR PROBS. OF PHASERS AND TORPEDOES/DISRUPTORS'/
     *' ''DOOM'' FOR PROBABILITES FOR DOOMSDAY MACHINE'/
     *' ''DIST'' TO CALCULATE DISTANCE BETWEEN COORDINATES AND CALCULATE
     *'/'  PROB. OF A PHASER HIT WHEN FIRED AT THE GIVEN COORDINATES'/)
      GO TO 8
20    WRITE(LLL,21)
21    FORMAT(' IF WE GO WARP 10, PROB. OF ESCAPING WEB=14.2657142857%'/
     *' IF WE GO LESS THAN WARP 10, PROB. OF ESCAPE=0%'/
     *' IF WE FIRE A TORPEDO, PROB. THAT IT WILL PENETRATE WEB=25%'/5X,
     *' PROB. THAT IT WILL NOT PIERCE WEB=50%'/
     *5X,' PROB. THAT IT WILL BOUNCE BACK AND STRIKE US=25%')
      GO TO 2
23    I7=(MA(IT,20)+1)*5
      WRITE(LLL,22)I7
22    FORMAT(' PROB. OF US LOSING STEERING CONTROL AND VEERING OFF COURS
     *E=',I3,'%'/' IF YOUR NACELLES THREATEN TO RIP OFF IF YOU EXCEED A
     * CERTAIN SPEED,'/' PROB. THAT IT WILL RIP OFF=(AMOUNT BY WHICH LIM
     *IT IS EXCEEDED*10+10)%'/' HOWEVER, IF THE LIMIT AT WHICH THE NAC
     *ELLES THREATEN TO RIP OFF IS WARP 1'/' (IE. THE NACELLE SUPPORT
     * PYLON IS DESTROYED), THEN IF YOU EXCEED'/' WARP 1, PROB. THAT IT
     * WILL RIP OFF=100%'/' IF WARP ENERGY GOES BELOW 0. 5, THE WARP ENG
     *INES WILL BE SHUT DOWN.'/' TO MOVE THEREAFTER YOU WILL HAVE TO BOO
     *ST WARP ENERGY AND'/' WAIT A TURN TO RE-ENERGIZE THE ENGINES')
      GO TO 2
24    WRITE(LLL,25)
25    FORMAT(' PROB. OF TORPS/DISRUPTORS SHORT-CIRCUITING WHEN FIRED=,
     *7%'/' PROB. OF PHASER BANKS SHORT-CIRCUITING WHEN FIRED=5%'/
     *' PROB. OF A MAIN COIL BURNOUT WHEN PHASERS ARE FIRED=5%'/
     *10X,' PROB. THAT MAIN COIL WILL BE REPAIRED=28.57%, 33.33%, 40%'/
     *10X,' DEPENDING ON REPAIR MODE')
      GO TO 2
26    WRITE(LLL,27)
27    FORMAT(' PROB. THAT A PHASER BEAM WILL BOUNCE OFF THE DOOMSDAY MAC
     *HINE=66. 6666667%'/' PROB. THAT A MINE WILL EXPLODE AND CAUSE DAMA
     *GE WHEN MACHINE EATS IT=71.4265714%'/' IF YOU GO CLOSER TO THE MAC
     *HINE THAN THE NEAREST STAR IT WILL EAT YOU'/' YOU CANNOT TRANSPORT
     * ONTO THE DOOMSDAY MACHINE'/' WHEN THE MACHINE IS DESTROYED, EVERY
     *THING WITHIN 7 UNITS IS DESTROYED AS WELL')
      GO TO 2
28    WRITE(LLL,29)
29    FORMAT(' ENTER THE COORDINATES IN THE FORM AABB,CCDD')
      READ(L,30,ERR=6)I7,I8,N,IV
30    FORMAT(2I2,1X,2I2)
      DISTP=DI(I7,I8,N,IV)
      AJUST=100.-(DISTP*2.5)
      IF(AJUST.LT.0.)AJUST=0
      WRITE(LLL,31)DISTP,AJUST
31    FORMAT(' DISTANCE=',F/' PROBABILITY OF A PHASER HIT AT THIS DISTAN
     *CE=',F8.4,'%')
      GO TO 2
6     WRITE(LLL,7)
7     FORMAT(' YOUR REQUEST FAILS TO FALL WITHIN LOGICAL PARAMETERS')
200   WRITE(LLL,3)
3     FORMAT(' SPOCK OUT ......')
      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 - MRESS -
C
      SUBROUTINE MRESS
      LOGICAL LOKI,CYRANO
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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
11    IF(LOKI(LOCK(IT)))GO TO 12
      IF(ICOIL(IT).EQ.0)GO TO 400
      WRITE(LLL,401)
401   FORMAT(' PHASERS INOPERATIVE - MAIN COIL BURNOUT UNDER REPAIR')
      GO TO 12
400   IF(PHASR(IT).GT.0)GO TO 21
      WRITE(LLL,22)
22    FORMAT(' YOUR PHASER BANKS ARE DEPLETED')
      GO TO 12
21    DISTP=ZAP(IT)
      I7=ICOLA(IT)
      I8=IROWA(IT)
      IF(A.EQ.0.OR.B.EQ.0)GO TO 210
      ZAP(IT)=A
      ICOLA(IT)=B/100.
      IROWA(IT)=B-ICOLA(IT)*100
      IF(ZAP(IT).LT.0.OR.ZAP(IT).GT.PHASR(IT))GO TO 1200
      GO TO 240
210   WRITE(LLL,23)PHASR(IT)
23    FORMAT(' YOU HAVE ',F6.0,' UNITS OF ENERGY IN YOUR PHASER BANKS
     * TYPE IN HOW MANY YOU WISH TO USE: ',$)
27    READ(L,24,ERR=1201)ZAP(IT)
24    FORMAT(F15.7)
      IF(ZAP(IT).LE.0.OR.ZAP(IT).GT.PHASR(IT)+0.0001)GO TO 1200
391   WRITE(LLL,758)
758   FORMAT(' PLEASE ENTER COORDINATES OF TARGET: ',$)
      READ(L,507,ERR=1201)ICOLA(IT),IROWA(IT)
507   FORMAT(2I2)
240   IF(CYRANO(IROWA(IT),ICOLA(IT)))GO TO 1200
      IF(ICOLA(IT).EQ.IENTC(IT).AND.IROWA(IT).EQ.IENTR(IT))GO TO 1200
      WRITE(LLL,504)
504   FORMAT(' PHASERS LOCKED ON TARGET')
      PHASR(IT)=PHASR(IT)-ZAP(IT)
      IF(PHASR(IT).LT.0)PHASR(IT)=0
      LOCK(IT)=1
12    RETURN
1200  ZAP(IT)=DISTP
      ICOLA(IT)=I7
      IROWA(IT)=I8
      CALL OOPS(LLL)
      GO TO 12
1201  CALL ILLDAT
      GO TO 1200
      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 - SHADOW -
C- THE WEED OF CRIME BEARS BITTER FRUIT
      SUBROUTINE SHADOW(J)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /K/IWHO(8),DIST(8),KILLZ,KILLR,KILLD,KILLG,IGOCO(8)
      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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      WRITE(LLL,1)
1     FORMAT(' ENTER SHIP LETTER (''*'' FOR STARBASE): ',$)
      READ(L,2)NA
2     FORMAT(A1)
      IF(NA.NE.ISTAR)GO TO 100
      WRITE(LLL,3)
3     FORMAT(' ENTER STARBASE NUMBER: ',$)
      READ(L,4,ERR=500)I7
4     FORMAT(I7)
      DO 5 I=1,2
      IF(I7.EQ.IBASE(I))GO TO 6
5     CONTINUE
      GO TO 501
C- WHO KNOWS WHAT EVIL LURKS IN THE HEARTS OF MEN?
6     IF(IBPSS(I).NE.IS)GO TO 501
      IFIB(I)=J
      DO 7 I8=1,4
      IF(ICHOE(I8).EQ.0)GO TO 7
      IF((IBPSC(I8)+1)/2.NE.IS)GO TO 7
      IV=IBPSC(I8)+4
      IVI=IV+1
      IF(J.EQ.0)GO TO 8
      WRITE(IVI,9)ISIDE(1,I),ISIDE(2,I),I7
9     FORMAT(1X,2A5,' STARBASE',I3, ' HAS CEASED FIRING')
      GO TO 7
8     WRITE(IVI,10)ISIDE(1,I),ISIDE(2,I),I7
10    FORMAT(1X,2A5,' STARBASE',I3,' ATTACKING')
7     CONTINUE
      RETURN
100   DO 105 I=1,8
      IF(NA.EQ.IENM1(I))GO TO 106
105   CONTINUE
      GO TO 501
106   IF(IBPSB(I).NE.IS)GO TO 501
      IGOCO(I)=J
      DO 107 I8=1,4
      IF(ICHOE(I8).EQ.0)GO TO 107
      IF((IBPSC(I8)+1)/2.NE.IS)GO TO 107
      IV=IBPSC(I8)+4
      IVI=IV+1
      IF(J.EQ.0)GO TO 108
      WRITE(IVI,109)(IENM2(N,I),N=1,4)
109   FORMAT(1X,4A4,' RETURNING TO NEAREST ALLIED VESSEL')
      GO TO 107
108   WRITE(IVI,110)(IENM2(N,I),N=1,4)
110   FORMAT(1X,4A4,' ATTACKING')
107   CONTINUE
      RETURN
C- THE SHADOW KNOWS!!!
500   CALL ILLDAT
501   CALL OOPS(LLL)
      RETURN
      END


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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,113)
113   FORMAT(' WARP ENGINE NACELLES ARE DESTROYED AND THUS WARP GREATER
     * THAN 1 IS IMPOSSIBLE')
      GO TO 110
111   WRITE(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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
      NNN=N+1
      WRITE(NNN,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
      NNN=N+1
      WRITE(NNN,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(LLL,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(LLL,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(LLL,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(LLL,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
      NNN=N+1
      WRITE(NNN,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
      IIVV=IVV+1
      WRITE(IIVV,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),LLL,II1,INA,IVI,II7,II8,NNN
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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
      IVI=IV+1
      WRITE(IVI,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
      IVI=IV+1
      WRITE(IVI,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
      IVI=IV+1
      WRITE(IVI,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
      IVI=IV+1
      WRITE(IVI,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
      IVI=IV+1
      WRITE(IVI,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(IVI,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
      JJJ=J+1
      WRITE(JJJ,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,78)
78    FORMAT(' PHOTON TORPEDO BANKS HAVE SHORT-CIRCUITED.')
      GO TO 101
100   WRITE(LLL,102)
102   FORMAT(' DISRUPTOR BANKS HAVE SHORT-CIRCUITED.')
101   WRITE(LLL,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(LLL,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
      II8=I8+1
      WRITE(II8,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(LLL,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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(LLL,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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(LLL,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(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,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(LLL,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
      II8=I8+1
      WRITE(II8,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(LLL,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,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(LLL,103)
103   FORMAT(' BOARDING TARGET OUT OF TRANSPORTER RANGE -OPERATION CANCE
     *LLED')
      RETURN
302   IF(IGO(IT).EQ.2)IGO(IT)=1
      WRITE(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,108)
108   FORMAT(' BOARDING PARTY MATERIALIZED IN A STAR -ALL HAVE SIZZLED')
      GO TO 500
309   WRITE(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II7=I7+1
      WRITE(II7,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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
      II8=I8+1
      WRITE(II8,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(LLL,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(LLL,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
      II8=I8+1
      WRITE(II8,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(II8,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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
      II8=I8+1
      WRITE(II8,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(II8,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(LLL,121)
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(II8,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(LLL,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(II8,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(II8,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(II8,401)
401   FORMAT(' YOU''VE ALREADY DONE THAT')
      GO TO 39
41    WRITE(II8,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(II8,50)
50    FORMAT(' INTRUDER ALERT SOUNDED')
      ADED=ADED*0.8
      GO TO 34
43    WRITE(II8,51)
51    FORMAT(' PERSONNEL EVACUATED')
      KORAX=2
      ADED=ADED*0.6
      GO TO 34
44    WRITE(II8,52)
52    FORMAT(' ENEMY-HELD AREAS SEALED OFF- ENEMY NOW RESORTING TO BLAS
     *TING THROUGH BULKHEADS')
      ISPRED=ISPRED/2
      GO TO 34
45    WRITE(II8,53)
53    FORMAT(' ENEMY-HELD AREAS GASSED')
      CALL RANDO(MMIN,85,95)
      I7=I7*(FLOAT(MMIN)/100.)
      GO TO 34
46    WRITE(II8,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(II8,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(II8,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(II8,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(II8,60)
60    FORMAT(' THE SELF-DESTRUCT ROUTINE DOES NOT WORK')
      GO TO 39
58    IF(IDEKU.GT.ISID)GO TO 61
      WRITE(II8,62)
62    FORMAT(' SINCE THE BRIDGE HAS BEEN CAPTURED,')
      WRITE(II8,60)
      GO TO 39
61    CALL RANDO(IV,1,3)
      KODOS(7)=1
      IF(IV.GT.2)GO TO 63
      WRITE(II8,60)
      GO TO 34
63    DO 75 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 75
      I8=IV+4
      II8=I8+1
      WRITE(II8,64)INAME(1,IT),INAME(2,IT)
64    FORMAT(1X,2A5,' SELF-DESTRUCT ROUTINE ACTIVATED')
75    CONTINUE
      DEFLT=-1.
      RETURN
36    WRITE(II8,65)
65    FORMAT(' OUR FORCES HAVE VANQUISHED THE INTRUDERS')
      CALL RANDO(IV,1,5)
      IF(IV.GT.1)GO TO 69
      WRITE(II8,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
      MMIN=MMIN+1
      WRITE(MMIN,68)INAME(1,I),INAME(2,I)
68    FORMAT(' A BOMB HAS BEEN DETONATED IN THE ',2A5,'-DAMAGE REPORT-')
      MMIN=MMIN-1
C OLD CODE just wrote to MMIN, +1 and -1 added to change unit #
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(II8,71)
71    FORMAT(' USING TRUTH DRUGS, PSYCHOTRICORDERS, AND VERIFIER
     * SCANS,')
      GO TO 72
70    WRITE(II8,73)
73    FORMAT(' USING MIND-SIFTERS AND AGONIZERS,')
72    WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II81=I81+1
      IF(IIV.EQ.2)GO TO 271
      IF(MMAP(I7,I8).EQ.IEE(IT))GO TO 221
      WRITE(II81,272)INAME(1,MMIN),INAME(2,MMIN)
272   FORMAT(' MINE HIT ',2A5,'-DAMAGE REPORT-')
      GO TO 270
271   WRITE(II81,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
      II81=I81+1
      IF(IIV.EQ.2)GO TO 210
      WRITE(II81,207)(IENM2(I,MMIN),I=1,4)
207   FORMAT(' MINE HIT ',4A4,'-DAMAGE REPORT-')
      GO TO 274
210   WRITE(II81,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
      II81=I81+1
      IF(IIV.EQ.2)GO TO 278
      WRITE(II81,279)ISIDE(1,MMIN),ISIDE(2,MMIN),IBASE(MMIN)
279   FORMAT(' MINE HIT ',2A5,' STARBASE',I3,'-DAMAGE REPORT-')
      GO TO 277
278   WRITE(II81,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(LLL,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
      II81=I81+1
      WRITE(II81,229)IVV
229   FORMAT(' EAGLE',I3,' HAS COLLIDED WITH A STAR')
282   CONTINUE
      GO TO 215
221   WRITE(LLL,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
      II81=I81+1
      WRITE(II81,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(LLL,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
      II81=I81+1
      WRITE(II81,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
      II81=I81+1
      IF(IIV.EQ.1)GO TO 240
      WRITE(II81,239)IVV,I
239   FORMAT(' EAGLE',I3,' COLLIDED WITH EAGLE',I3/' BOTH EAGLES
     * DESTROYED')
      GO TO 242
240   WRITE(II81,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(LLL,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(LLL,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


C=================================================
C
C  TREK7 MODULE D
C CONVERTED TO PC BY: DAN GAHLINGER
C ENTIRE MODULE TYPE-EXACT CHECK 04/26/2000 BY: D.G.
C
C  SHIP INITIALIZATION AND TERMINATION
C
C HADES   TOPHET  EREBUS  CHARON  STYX  BELIAL
C HARLIE  FIZBIN  TIMEX   MENDEZ  KZIN
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 - HADES -
C
      SUBROUTINE HADES
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      N=I
      J=IBPSB(N)
      IF(J.NE.0)GO TO 54
      I3=I3-1
      GO TO 763
54    II(J)=II(J)-1
      IBPSB(N)=0
763   CALL TOPHET(N)
      IF(N.NE.7)RETURN
766   IV=I7-7
      IVV=I8-7
      IV1=I7+7
      IZA=I8+7
      IF(IV.LE.0)IV=1
      IF(IVV.LE.0)IVV=1
      IF(IV1.GT.60)IV1=60
      IF(IZA.GT.60)IZA=60
      DO 780 N=IV,IV1
      DO 780 J=IVV,IZA
      IF((I8-J)**2+(I7-N)**2.LE.49)MMAP(N,J)=IBLK
780   CONTINUE
      DO 769 N=1,8
      IF(ICHOS(N).EQ.0)GO TO 769
      IF(N.EQ.7)GO TO 769
      IF((IKLNC(N)-I8)**2+(IKLNR(N)-I7)**2.GT.49)GO TO 769
      ISPOK(N)=0
      CALL TOPHET(N)
769   CONTINUE
      IF(NUMOUT.EQ.0)GO TO 7690
      DO 7691 N=1,LAUNCH
      IF(IGLER(N).EQ.0)GO TO 7691
      IF((IGLER(N)-I7)**2+(IGLEC(N)-I8)**2.GT.49)GO TO 7691
      DO 540 KOENIG=1,4
      IF(ICHOE(KOENIG).EQ.0)GO TO 540
      J=KOENIG+4
      JJJ=J+1
      WRITE(JJJ,7692)N
7692  FORMAT(' EAGLE',I3,' DESTROYED BY EXPLOSION')
540   CONTINUE
      CALL BOOM(N)
7691  CONTINUE
7690  DO 55 KOENIG=1,4
      IF(ICHOE(KOENIG).EQ.0)GO TO 55
      IF((IENTC(KOENIG)-I8)**2+(IENTR(KOENIG)-I7)**2.GT.49)GO TO 55
      DO 56 J=1,4
      IF(ICHOE(J).EQ.0)GO TO 56
      IV=J+4
      IVI=IV+1
      WRITE(IVI,772)(INAME(IQ0,KOENIG),IQ0=1,3)
772   FORMAT(' THE ',3A4,' HAS BEEN ENGULFED BY THE EXPLOSION'/' FROM
     * THE DOOMSDAY MACHINE')
56    CONTINUE
      DFLCT(KOENIG)=-10.
55    CONTINUE
      DO 58 N=1,2
      IF(ICHOB(N).EQ.0)GO TO 58
      IF((IBASC(N)-I8)**2+(IBASR(N)-I7)**2.GT.49)GO TO 58
      DFLCB(N)=-10.
      DO 580 J=1,4
      IF(ICHOE(J).EQ.0)GO TO 580
      I7=J+4
      II7=I7+1
      WRITE(II7,59)(ISIDE(IQ0,N),IQ0=1,3),IBASE(N)
59    FORMAT(1X,3A4,' STARBASE',I3,' ENGULFED BY EXPLOSION FROM DOOMSDAY
     *MACHINE')
580   CONTINUE
58    CONTINUE
      DO 57 N=1,5
      IF(LI2R(N).EQ.0)GO TO 57
      IF((LI2R(N)-I7)**2+(LI2C(N)-I8)**2.GT.49)GO TO 57
      LI2R(N)=0
      LI2C(N)=0
57    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 - TOPHET
C
      SUBROUTINE TOPHET(NX)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /I/IONK(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 /S/IBPOB(8),IBPOE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      ICHOS(NX)=0
      IF(NX.EQ.7)GO TO 52
      IF(IBPOB(NX).EQ.0)GO TO 52
      IBPOB(NX)=0
      IBPOB(7)=IBPOB(7)-1
52    I7=IKLNR(NX)
      I8=IKLNC(NX)
      IKLNR(NX)=0
      IKLNC(NX)=0
      IF(ISTAT.EQ.2)GO TO 165
      MMAP(I7,I8)=IBLK
      IF(ISPOK(N).EQ.1)MMAP(I7,I8)=III
165   DO 53 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 53
      J=IV+4
      JJJ=J+1
      WRITE(JJJ,102)(IENM2(MMIN,NX),MMIN=1,4)
102   FORMAT(/' SENSORS REPORT THAT AN EXPLOSION HAS PULVERIZED THE '14A
     *4/'    INTO POWDERED DUST')
53    CONTINUE
      DO 50 J=1,2
      IF(NX+4.EQ.IWEB(J))IWEB(J)=0
      IF(NX.EQ.J*3)IWEB(J)=0
50    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 - EREBUS -
C
      SUBROUTINE EREBUS
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      IF(ISTAT.EQ.2)GO TO 163
163   ICHOB(I)=0
      DFLCB(I)=0
      NDEAB(I)=0
      IONB(I)=0
      DO 156 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 156
      N=I7+4
      NNN=N+1
      WRITE(NNN,157)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
157   FORMAT(' SENSORS REPORT THE DESTRUCTION OF ',3A4,' STARBASE',I3)
156   CONTINUE
      IBASE(I)=IBASE(I)+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/26/2000 BY: D.G.
C
C - CHARON -
C
      SUBROUTINE CHARON
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      ICHOB(I)=2
      NDEAB(I)=0
      DO 158 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 158
      N=I7+4
      NNN=N+1
      WRITE(NNN,159)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
159   FORMAT(' SENSORS DETECT NO LIFE FORMS ABOARD ',3A4,' STARBASE',I3)
158   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/200 BY: D.G.
C
C                               - STYX
C
      SUBROUTINE STYX
      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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /I/IONK(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 /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
        COMMON /TOM/ITOM
      CALL RANDO(IV,1,33)
      IVV=I+4
      J=(I+1)/2
      IIVV=IVV+1
2380  WRITE(IIVV,238)IBASE(J),(INAME(IQ0,I),IQ0=1,3)
238   FORMAT(' STARBASE',I3,' CALLING ',3A4,'.........'/' AN EXPLOSION H
     *AS OCCURRED IN')
      CALL FORBIN(J,IV,IVV,' ')
      WRITE(IIVV,2382)
2382  FORMAT(' AND HAS SPREAD AND ENGULFED YOUR SHIP, DESTROYING YOU'/
     *' AND REDUCING YOUR SHIP TO A LUMP OF MOLTEN SLAG')
      IF(I.EQ.IT)MMIN=1
      IF(ISTAT.EQ.2)GO TO 164
      MMAP(IENTR(I),IENTC(I))=IBLK
      IF(ISPOT(I).EQ.1)MMAP(IENTR(I),IENTC(I))=III
164   DFLCT(I)=0
      NDEAD(I)=0
      IENTR(I)=0
      IENTC(I)=0
      ION(I)=0
      ISPOT(I)=0
      DO 135 I7=1,4
      IF(I7.EQ.I)GO TO 135
      IV=I7+4
      IVI=IV+1
      IF(ICHOE(I7).NE.0)WRITE(IVI,136)(INAME(IQ0,I),IQ0=1,3)
136   FORMAT(' SENSORS REPORT THE DESTRUCTION OF THE ',3A4)
135   CONTINUE
      IF(IWEB(1).EQ.I)IWEB(1)=0
      IF(IWEB(2).EQ.I)IWEB(2)=0
      I7=ICHOE(I)
      ICHOE(I)=3
      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 - BELIAL -
C
      SUBROUTINE BELIAL
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      IVV=I+4
      IIVV=IVV+1
      WRITE(IIVV,615)
615   FORMAT(' CREW REMAINING IS ZERO'/9X,'THUS THERE IS NO ONE LEFT TO
     * CONTROL THE SHIP')
      NDEAD(I)=0
      ICHOE(I)=2
      DO 137 I7=1,4
      IF(I7.EQ.I)GO TO 137
      IV=I7+4
      IVI=IV+1
      IF(ICHOE(I7).NE.0)WRITE(IVI,136)(INAME(IQ0,I),IQ0=1,3)
136   FORMAT(' SENSORS DETECT NO LIFE FORMS ABOARD THE ',3A4)
137   CONTINUE
      RETURN
      END


C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C    CONVERTED TO PC BY: DAN GAHLINGER
C      TYPE-EXACT CHECK (W/CONVERSION) 04/25/2000 BY: D.G.
C  - HARLIE
C
C THIS ROUTINE DOES THE DATA FILE ACCESS - NOTE FOR CONVERSION
C
      SUBROUTINE HARLIE
      COMMON /W/IDEX(2,33,20)
C
C ORIGINAL COMMENTED CODE:
C
C     OPEN(UNIT=1,DEVICE='DRA0:',ACCESS='RANDIN',MODE='ASCII',FILE='KIRK.
C    *DAT',DIRECTORY='050030.D.WORK',RECORD SIZE=80)
C     OPEN(UNIT=2,DEVICE='DRA0:',ACCESS='RANDIN',MODE='ASCII',FILE='KOLOTH
C    *.DAT',DIRECTORY='050030.D.WORK',RECORD SIZE=80)
C
C ORIGINAL CODE:
C
C     OPEN(UNIT=1,TYPE='OLD',ACCESS='DIRECT',
C    *FORM='FORMATTED',
C    *RECORDTYPE='FIXED',RECORDSIZE=80,readonly,
C    *ORGANIZATION='RELATIVE',NAME='SYS$USERS:KIRK.DAT')
C
C     OPEN(UNIT=2,TYPE='OLD',ACCESS='DIRECT',
C    *FORM='FORMATTED',
C    *RECORDTYPE='FIXED',RECORDSIZE=80,readonly,
C    *ORGANIZATION='RELATIVE',NAME='SYS$USERS:KOLOTH.DAT')
C
      OPEN(UNIT=1,TYPE='OLD',readonly,
     *ORGANIZATION='SEQUENTIAL',NAME='KIRK.DAT')
      OPEN(UNIT=2,TYPE='OLD',readonly,
     *ORGANIZATION='SEQUENTIAL',NAME='KOLOTH.DAT')
      DO 1 I=1,33
C      READ(1'I,10)(IDEX(1,I,J),J=1,20)
C 1     READ(2'I,10)(IDEX(2,I,J),J=1,20)
      READ(1,10)(IDEX(1,I,J),J=1,20)
1     READ(2,10)(IDEX(2,I,J),J=1,20)
10    FORMAT(20A4)
c close the files so that some other joe might play
      CLOSE(1)
      CLOSE(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/25/2000 BY: D.G.
C
C - FIZBIN -
C
      SUBROUTINE FIZBIN
      INTEGER LAP(3600),LA(132),LK(56),IGOM(8)
      EQUIVALENCE(LAP,MMAP),(LA,MA),(LK,K)
C***
      integer itom2,idev(2)
      integer*2 icnt
C used by vax version
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /G/ZAP(4),ICOLA(4),IROWA(4),LOCK(4),ICOIL(4)
      COMMON /H/ANGLE(4),RANG(4),LOCKT(4)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /J/KODE(2,8),STATIC(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 /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 /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)
      COMMON /W/IDEX(2,33,20)
        COMMON /TOM/ITOM
94    CALL RANDO(IBASE(1),1,17)
      CALL RANDO(IBASE(2),1,17)
      IF(IBASE(1).EQ.IBASE(2))GO TO 94
      CALL TIMEX
      LAUNCH=0
      ISHAK=0
      NUMOUT=0
      DO 8910 I=1,25
      IGLER(I)=0
      IGLEC(I)=0
      IBPSE(I)=0
8910  IBPOE(I)=0
      ISTAT=0
      MMIN=0
105   WRITE(LLL,104)
104   FORMAT(' ENTER THE MANUALLY-OPERATED SHIPS YOU WISH BY ENTERING A
     * STRING CONTAINING-'/' ''E'' FOR ENTERPRISE, ''P'' FOR POTEMPKIN
     *FEDERATION),'/' ''H'' FOR HAVOC, ''C'' FOR CARNAGE (KLINGON)')
      READ(L,332)(IGOM(I),I=1,4)
332   FORMAT(4A1)
107   DO 108 I=1,4
      ICHOE(I)=0
      DO 108 J=1,4
      IF(IGOM(J).NE.IEE(I))GO TO 108
      ICHOE(I)=1
      ISTAT=ISTAT+1
108   CONTINUE
C      PRINT 11122,ISTAT,ICHOE(1),IGOM(1),I
C11122 FORMAT(//' 108 ISTAT=',I4,' ICHOE(1)=',I4,' IGOM(1)=',A1,' I=',I4)
      IF(ISTAT.EQ.0)GO TO 105
      IF(ISTAT.EQ.1.AND.ICHOE(1).EQ.1)GO TO 111
      WRITE(LLL,109)
C109  FORMAT(' WHEN I STOP TYPING, HIT %C AND ENTER THE FOLLOWING COMMAN
C    *DS-'/' ASSIGN TTYAA 5'/' ASS TTYBB 6'/' ASS TTYCC 7'/' ASS TTY
C    *DD E3'/' . CONTINUE'/' <CR>'//' (WHERE AA, BB, CC, DD ARE THE TTY''S
C    * CONTROLLING THE ENTERPRISE, '/' POTEMPKIN, HAVOC AND CARNAGE RESPE
C    *CTIVELY)'/' (IF YOU''RE NOT PLAYING SOME OF THE SHIPS, DON''T BOTH
C    *ER'/' ENTERING THEIR ASSIGN COMMANDS)'/' (IF YOU''VE HAD THE FORES
C    *IGHT TO DO ALL THIS, JUST HIT <CR>)')
C     READ(L,92)NA
C92   FORMAT(A1)
109   FORMAT(' It is time to assign terminals to TREK7. To do
     *this you need to know'/' the device name of the terminals
     *that you will be using.'/' If you do not know this then
     *stop the game and find out.'/' To do this type "show term",
     *the first piece of information is the name of our terminal'/'
     *for example "TUB1:". Find out the name of all the terminals
     *'/' and then restart the game.')
c***vax version
c
      icnt=5
      do 926 itom2=1,4
      if(igom(itom2).eq.'E')goto 921
      if(igom(itom2).eq.'P')goto 922
      if(igom(itom2).eq.'H')goto 923
      if(igom(itom2).eq.'C')goto 924
      goto 926
c
c
921   write(L,9211)
9211  format(' If you want the Enterprise to play off of this
     *terminal then type a blank.'/' Do not type in the name of
     *this terminal, This causes the game to die.')
      read(L,9212)(idev(j),j=1,2)
9212  format(2(a4))
      if(idev(1).eq.' ')goto 926
      goto 926
c
c
922   write(L,9221)
9221  format(' The Potempkin is assigned to terminal ',$)
      read(L,9222)(idev(j),j=1,2)
9222  format(2(a4))
      goto 926
c
c
923   write(L,9231)
9231  format(' The Havoc is assigned to terminal ',$)
      read(L,9232)(idev(j),j=1,2)
9232  format(2(a4))
      goto 926
c
c
924   write(L,9241)
9241  format(' The Carnage is assigned to terminal ',$)
      read(L,9242)(idev(j),j=1,2)
9242  format(2(a4))
c
c
926   continue
c
c
c
C***
C111   PRINT 11133,ISTAT,ICHOE(1),IGOM(1),I
C11133 FORMAT(//' 111 ISTAT=',I4,' ICHOE(1)=',I4,' IGOM(1)=',A1,' I=',I4)
111   DO 110 I=1,4
C      PRINT 11188,I,ICHOE(I)
C11188 FORMAT(//' INSIDE TOP OF 110 LOOP, I=',I4,' ICHOE(I)=',I4//)
      IF(ICHOE(I).EQ.0)GO TO 110
C      PRINT 11266,I,IPHOT(I),IENTR(I)
C11266 FORMAT(//' RSTUPID TEST I=',I4,' IPHOT(I)=',I4,' IENTR(I)=',I4//)
      CALL RANDO(IENTR(I),1,60)
C      PRINT 11244,I,IPHOT(1),IPHOT(I)
C11244 FORMAT(//' 3STUPID TEST I=',I4,' IPHOT(1)=',I4,' IPHOT(I)=',I4//)
      CALL RANDO(IENTC(I),1,60)
C      PRINT 11255,I,IPHOT(1),IPHOT(I)
C11255 FORMAT(//' 4STUPID TEST I=',I4,' IPHOT(1)=',I4,' IPHOT(I)=',I4//)
      IBPSC(I)=I
      ISPOT(I)=0
      ION(I)=0
      ZAP(I)=0
      INVIS(I)=0
      TWARP(I)=10.
      LOCK(I)=-1
      LOCKT(I)=-1
      ICOIL(I)=0
      WARP(I)=0.
      NOMOV(I)=0
      IPHOT(I)=12
C      PRINT 11199,IPHOT(I)
C11199 FORMAT(//' IN 110 LOOP JUST SET IPHOT TO 12, IPHOT(I)=',I4//)
C      PRINT 11211,I,IPHOT(1),IPHOT(I)
C11211 FORMAT(//' STUPID TEST I=',I4,' IPHOT(1)=',I4,' IPHOT(I)=',I4//)
      PHASR(I)=6000.
      DFLCT(I)=100.
      ISURR(I)=0
      RANG(I)=10.
      NOMAP(I)=15
      MANUM(I)=0
      ITEMP(I)=4000
      NDEAD(I)=430
      NOMOV(I)=0
C      PRINT 11233,I,IPHOT(1),IPHOT(I)
C11233 FORMAT(//' 2STUPID TEST I=',I4,' IPHOT(1)=',I4,' IPHOT(I)=',I4//)
      LI2(I)=0
C      PRINT 11177,I,IPHOT(I)
C11177 FORMAT(//' IN 110 LOOP, I=',I4,' IPHOT(I)=',I6//)
110   CONTINUE
C      PRINT 11144,ISTAT,ICHOE(1),IGOM(1),I
C11144 FORMAT(//' 110 ISTAT=',I4,' ICHOE(1)=',I4,' IGOM(1)=',A1,' I=',I4)
      I3=0
      DO 120 I=1,2
      II(I)=0
      NUME(I)=0
      ICHOB(I)=0
      IONB(I)=0
      IBPSS(I)=I
      NDEAB(I)=1000
      IPHOB(I)=20
      IWEB(I)=0
      IGOB(I)=0
      IFIB(I)=0
120   DFLCB(I)=300.
      INDUZ=0
      IXRYZ=0
      IWEBZ=0
      ISTAZ=0
      KILLR=1
      KILLG=1
      KILLD=1
      IONNO=0
112   CALL RANDO(I7,1,4)
      IF(ICHOE(I7).EQ.0)GO TO 112
      L=I7+4
      DO 113 I=1,4
      IF(I.EQ.I7.OR.ICHOE(I).EQ.0)GO TO 113
      I8=I+4
      II8=I8+1
      IF(I8.EQ.5)I8=6
      WRITE(II8,114)(INAME(IQ0,I7),IQ0=1,3)
114   FORMAT(' PLEASE WAIT WHILE THE ',3A4,' CHOOSES THE ENEMIES')
      IF(I8.EQ.6)I8=5
113   CONTINUE
      WRITE(LLL,751)
751   FORMAT(' PICK THE OPPONENT(S) YOU WISH TO FIGHT BY TYPING IN A STR
     *ING OF LETTERS-'/' EACH LETTER CORRESPONDING TO THE OPPONENT YOU W
     *ISH TO BATTLE.'/' TYPE ''K'' FOR KLINGONS, ''R'' FOR ROMULANS'/'
     *''T'' FOR THOLIANS, ''G'' FOR GORNS'/' ''O'' FOR ORIONS, ''Z'' FOR
     * KZINTI'/' ''D'' FOR A DOOMSDAY MACHINE'/' AND/OR ''A'' FOR MOONBA
     *SE ALPHA')
      READ(L,752)(IGOM(I),I=1,8)
752   FORMAT(8A1)
      DO 7531 I=1,8
      DFLCK(I)=100.
      IBPOB(I)=0
      IBPSB(I)=0
      ICHOS(I)=0
      ISPOK(I)=0
      IONK(I)=0
      IGOCO(I)=1
      DO 753 J=1,8
      IF(IGOM(J).NE.IENM1(I))GO TO 753
      ICHOS(I)=1
753   CONTINUE
7531  CONTINUE
      DFLCK(8)=70.
      IF(ICHOS(6).EQ.1)CALL KZIN
      IF(IGO(1).EQ.1)GO TO 1260
      DO 501 I=1,3600
501   LAP(I)=IBLK
      CALL RANDO(IV,0,10)
      IF(IV.EQ.0)GO TO 1260
      DO 647 N=1,IV
648   CALL RANDO(IVV,4,11)
      CALL RANDO(MMIN,1,60)
      CALL RANDO(J,1,60)
      I7=MMIN+IVV
      I8=J+IVV
      IF(I7.GT.60)GO TO 648
      IF(I8.GT.60)GO TO 648
      DO 649 IVV=J,I8
      DO 649 I=MMIN,I7
649   MMAP(I,IVV)=III
647   CONTINUE
1260  II(1)=ICHOE(1)+ICHOE(2)
      II(2)=ICHOE(3)+ICHOE(4)
      IJ(1)=II(1)
      IJ(2)=II(2)
      DO 115 I=1,8
115   IF(ICHOS(I).EQ.1)I3=I3+1
      DO 119 IVV=1,2
      J=3-IVV
      IF(II(IVV).EQ.0.OR.II(J).NE.0)GO TO 119
      CALL MENDEZ(J)
119   CONTINUE
      DO 116 IVV=1,2
      IF(II(IVV).EQ.0)GO TO 116
      IF(ICHOB(IVV).NE.0)GO TO 116
      IF(II(3-IVV).NE.ICHOB(3-IVV))GO TO 117
      IF(3*II(IVV).GT.I3)GO TO 116
117   CALL MENDEZ(IVV)
116   CONTINUE
      IF(II(2).EQ.0.AND.I3.EQ.0)ISHAK=1
      IF(II(1).EQ.0.AND.I3.EQ.0)ISHAK=1
      IF(ISHAK.EQ.0)GO TO 126
      DO 122 J=1,4
      I=J+4
      II1=I+1
      IF(ICHOE(J).EQ.1)WRITE(II1,6100)
6100  FORMAT(' BEGINNING SHAKEDOWN CRUISE')
122   CONTINUE
126   IF(IGO(1).EQ.1)GO TO 5020
      WRITE(LLL,610)
610   FORMAT(' HOW MANY STARS DO YOU WISH IN YOUR 60 X 60 FIELD - BETWEE
     *N 0 AND 500')
      GO TO 655
1262  CALL ILLDAT
      GO TO 126
655   READ(L,*,ERR=1262)DISTP
1261  IF(DISTP.GT.1500.)GO TO 126
24    FORMAT(F15.7)
123   I7=IFIX(DISTP)
      IF(I7.LT.0)GO TO 126
      ISTAT=0
      IF(I7.EQ.0)GO TO 5022
      DO 502 I=1,17
      CALL RANDO(IV,1,60)
      CALL RANDO(IVV,1,60)
      IF(ISTAT.GE.5)GO TO 502
      CALL RANDO(J,1,100)
      IF(J.GT.5)GO TO 502
      ISTAT=ISTAT+1
      LI2R(ISTAT)=IV
      LI2C(ISTAT)=IVV
502   MMAP(IV,IVV)=ISTAR
5022  IF(ISTAT.GE.5)GO TO 5020
      DO 5021 I=ISTAT+1,5
      LI2R(I)=0
5021  LI2C(I)=0
5020  DO 125 I=1,4
      IF(ICHOE(I).EQ.0)GO TO 125
      IF(MMAP(IENTR(I),IENTC(I)).NE.III)GO TO 1250
      ISPOT(I)=1
      ION(I)=1
1250  MMAP(IENTR(I),IENTC(I))=IEE(I)
125   CONTINUE
      DO 754 I=1,8
      IKLNR(I)=0
      IKLNC(I)=0
      IF(ICHOS(I).NE.1)GO TO 754
7501  CALL RANDO(I7,2,59)
      CALL RANDO(I8,2,59)
      NA=MMAP(I7,I8)
      IF(NA.NE.IBLK.AND.NA.NE.ISTAR.AND.NA.NE.III)GO TO 7501
      IF(I.EQ.8.AND.NA.EQ.III)GO TO 7501
      IKLNR(I)=I7
      IKLNC(I)=I8
7502  IF(I.NE.6.OR.ICHOS(6).EQ.0)GO TO 750
      CALL NIVEN
      GO TO 754
750   CALL ASIMOV(NA,I)
151   MMAP(I7,I8)=IENM1(I)
754   CONTINUE
      IF(ICHOS(2).EQ.0)GO TO 89
      DO 127 I=1,4
      IF(ICHOE(I).EQ.0)GO TO 127
      IF(DI(IKLNC(2),IKLNR(2),IENTC(I),IENTR(I)).GE.5)GO TO 127
      INVIS(I)=1
127   CONTINUE
890   IF(IARMZ(5).EQ.0)GO TO 89
      IF(ICHOS(6).EQ.0)GO TO 89
      DO 891 I=1,4
      IF(ICHOE(I).EQ.0)GO TO 891
      IF(DI(IKLNC(6),IKLNR(6),IENTC(I),IENTR(I)).GE.ICLOZ)GO TO 891
      INVIZ(I)=1
891   CONTINUE
89    ISTAT=0
      DO 170 I=1,8
      KODE(1,I)=0
170   KODE(2,I)=0
      DO 171 I=1,2
      CALL RANDO(IV,0,2)
      IF(IV.EQ.0)GO TO 171
      CALL RANDO(I8,1,8)
      KODE(I,I8)=1
      CALL RANDO(JTK,0,2)
      IF(JTK.NE.0)GO TO 171
      IVV=2*I
      DO 1710 MMIN=IVV-1,IVV
      IF(ICHOE(MMIN).EQ.0)GO TO 1710
      J=MMIN+4
      JJJ=J+1
      WRITE(JJJ,172)I8
172   FORMAT(' INTELLIGENCE REPORTS THAT THE ENEMY HAVE BROKEN CODE',I2)
1710  CONTINUE
171   CONTINUE
      DO 118 I=1,56
      LA(I)=0
118   LK(I)=0
      DO 747 I=57,132
747   LA(I)=0
      IF(ICHOS(8).NE.1)GO TO 8900
      CALL LEGUIN(0,0)
8900  RETURN
      END



C - TAKES   A LICKIN' BUT KEEPS ON TICKIN'
C CONVETED TO PC BY: DAN GAHLINGER
C TYPE-EXACT CHECK 04/26/2000 BY: D.G. (JOKE - THIS NEVER GETS USED!)
C
C  TIMEX
C
      SUBROUTINE TIMEX
      IMPLICIT INTEGER (A-Z)
      DIMENSION I(2),MON(12),F(12)
C FOLLOWING DATA CREATES AN ERROR SO WE FUDGE IT
C     DATA MON/-28580569024,-30711668672,-26969825216,-33349361600,
C    *-26969595840,-28496682944,-28496748480,-33328750528,-23731888064,
C    *-25887629248,-26374102976,-31785377728/
C HERES MY NEW CODE APR/21/2000
C THIS NEVER GETS USED, SO NOBODY CARES
C     DATA MON/9024,8672,5216,1600,
C    *5840,2944,8480,528,8064,
C    *9248,2976,7728/
C     DATA F/0,3,3,6,1,4,6,2,5,0,3,5/
C NEW FORTRAN AND Y2K CHANGE THE NEXT TWO LINES, NO LONGER VALID
C     CALL DATE(I)
C     CALL TIME(D,A)
C    FAKE CODE ENTERED NEXT TWO LINES TO FIX ANOTHER BUG (FAKE BUG)
      D=1
      IF(D.EQ.2)GO TO 99
C LINE BELOW CAUSES FALSE ERROR IN TIMEX LINE 18
      RETURN
C ABOVE LINE MAY GENERATE A FALSE ERROR
C     CALL SETRAN(M)
99    STOP
      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               - MENDEZ

      SUBROUTINE MENDEZ(J)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /TOM/ITOM
      I=1
      N=4
      IF(II(1).EQ.0)I=3
      IF(II(2).EQ.0)N=2
      IF(J.EQ.2.AND.ICHOB(1).EQ.1)I=3
      DO 1 MMIN=I,N
      IF(ICHOE(MMIN).EQ.0)GO TO 1
      I8=MMIN+4
      II8=I8+1
      WRITE(II8,2)(ISIDE(IQ0,J),IQ0=1,3)
2     FORMAT(' DO YOU WISH A ',3A4,' STARBASE?')
      READ(I8,3)NA
3     FORMAT(A1)
      IF(NA.NE.'Y')GO TO 4
1     CONTINUE
      ICHOB(J)=1
      CALL RANDO(IBASR(J),1,60)
      CALL RANDO(IBASC(J),1,60)
      IF(MMAP(IBASR(J),IBASC(J)).EQ.III)IONB(J)=1
      MMAP(IBASR(J),IBASC(J))=ISTAR
      II(J)=II(J)+1
      RETURN
4     DO 5 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 5
      IF(IV.EQ.MMIN)GO TO 5
      I8=IV+4
      II8=I8+1
      WRITE(II8,6)(ISIDE(IQ0,J),IQ0=1,3),(INAME(IQ0,MMIN),IQ0=1,3)
6     FORMAT(1X,3A4,' STARBASE VETOED BY ',3A4)
5     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 - KZIN -
C
      SUBROUTINE KZIN
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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 /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 /Q/IARMZ(6),INDUZ,IXRYZ,IMAGZ,IMAGRZ,IABSZ,ISTAZ,INVIZ(4),
     *ICLOZ,IONNO,IPLANZ,IRUNZ,IDEVZ,IDRIZ,IMAXZ
      COMMON /S/IBPOB(8),IBPOE(25)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
1     IF(IBPOB(6).NE.0)RETURN
      WRITE(LLL,2)
2     FORMAT(' THE KZINTI ARE A SPECIAL ENEMY- THEY ARE PLAYER PROGRAMMA
     *BLE.'/' THUS THE PLAYER ENTERS PARAMETERS REGARDING THE ENEMY STRE
     *NGTH'/' AND STRATEGY.')
7     WRITE(LLL,3)
3     FORMAT(//' TYPE OF STRATEGY -- ENTER A NUMBER-'/
     *' ''1'' FOR ATTACK/RETREAT'/
     *' ''2'' FOR KAMIKAZE'/
     *' ''3'' FOR CLOSE PASSES (EG. ORIONS)')
      N=1
      READ(L,9,ERR=73)DISTP
      IPLANZ=IFIX(DISTP)
      IF(IPLANZ.LT.1.OR.IPLANZ.GT.3)GO TO 7
      IF(IPLANZ.NE.1)GO TO 15
10    WRITE(LLL,8)
8     FORMAT(' ENTER A NUMBER REPRESENTING BY HOW MUCH YOUR
     *'/' DEFLECTORS MUST EXCEED THE KZINTIS'' BEFORE THE KZINTI START'
     */'TO RETREAT.'/' EG. 30 MEANS THE KZINTI RETREAT WHEN YOUR
     * DEFLECTORS ARE'/5X,' GREATER THAN THEIRS BY AT LEAST 30.'/,
     *' EG. -30 MEANS THE KZINTI RETREAT UNLESS THEY EXCEED YOUR
     *'/5x,' DEFLECTORS BY AT LEAST 30.')
      N=2
      READ(L,9,ERR=73)DISTP
9     FORMAT(F15.7)
      IRUNZ=IFIX(DISTP)
131   WRITE(LLL,130)
130   FORMAT(' ENTER A NUMBER (IN DEGREES BETWEEN 0 AND 180) REPRESENTI
     *NG'/' THE MAXIMUM ANGLE THE KZINTIS` PATH MAY DEVIATE FROM A PATH
     * HEADING'/' STRAIGHT TOWARDS YOU (ATTACK) OR STRAIGHT AWAY FROM Yo
     *U (RETREAT).'/' EG. 0 MEANS THEY WILL HEAD STRAIGHT FOR YOU WHEN T
     *HEY ATTACK'/5X,'OR STRAIGHT AWAY FROM YOU WHEN THE RETREAT.'/' EG.
     * 90 MEANS THEIR PATH MAY RANDOMLY DEVIATE OFF TO THE SIDE A MAXIMU
     *M'/5X,'OF 90 DEGREES FROM HEADING STAIGHT AT YOU OR STAIGHT AWAY F
     *ROM YOU')
      N=3
      READ(L,9,ERR=73)DISTP
      IDEVZ=IFIX(DISTP)
      IF(IDEVZ.LT.0.OR.IDEVZ.GT.180)GO TO 131
15    WRITE(LLL,16)
16    FORMAT(' TYPE OF ENGINES -- ENTER A NUMBER-'/
     *' ''1'' FOR IONIC DRIVE ENGINES'/
     *' ''2'' FOR WARP DRIVE ENGINES')
      N=4
      READ(L,9,ERR=73)DISTP
      IDRIZ=IFIX(DISTP)
      IF(IDRIZ.LT.1.OR.IDRIZ.GT.2)GO TO 15
21    WRITE(LLL,20)
20    FORMAT(' ENTER MAXIMUM WARP -- BETWEEN 2 AND 12')
      N=5
      READ(L,9,ERR=73)DISTP
      IMAXZ=IFIX(DISTP)
      IF(IMAXZ.LT.2.OR.IMAXZ.GT.12)GO TO 21
      WRITE(LLL,25)
25    FORMAT(' DO YOU WANT THE KZINTIS'' SPEED TO BE UNAFFECTED BY ION S
     *TORMS?')
      N=6
      READ(L,11,ERR=73)NA
11    FORMAT(A1)
      IF(NA.EQ.'Y')IONNO=1
30    WRITE(LLL,31)
31    FORMAT(' ARMAMENT -- ENTER A STRING OF DIGITS-'/
     *' ''1'' FOR INDUCTION BEAMS'/
     *' ''2'' FOR X-RAY LASER CANNON'/
     *' ''3'' FOR WEB (LIKE THOLIAN''S)'/
     *' ''4'' FOR DECOY IMAGES'/
     *' ''5'' FOR CLOAKING DEVICE'/
     *' AND/OR ''6'' FOR STASIS FIELD')
      READ(L,32,ERR=73)(IONK(I7),I7=1,6)
32    FORMAT(6I1)
      DO 33 I8=1,6
      IARMZ(I8)=0
      DO 33 I7=1,6
      IF(IONK(I7).EQ.I8)IARMZ(I8)=1
33    CONTINUE
      DO 330 I8=1,6
330   IONK(I8)=0
      IF(IARMZ(1).EQ.0)GO TO 40
35    WRITE(LLL,34)
34    FORMAT(' ENTER INDUCTION BEAM STRENGTH IN PHASER UNITS')
      N=7
      READ(L,9,ERR=73)DISTP
      IF(DISTP.GE.250.)GO TO 400
      WRITE(LLL,401)
401   FORMAT(' NUMBER TOO SMALL')
      GO TO 35
400   INDUZ=IFIX(DISTP)/10
40    IF(IARMZ(2).EQ.0)GO TO 70
71    WRITE(LLL,72)
72    FORMAT(' ENTER X-RAY CANNON STRENGTH IN PHASER UNITS')
      N=8
      READ(L,9,ERR=73)DISTP
      IF(DISTP.GE.250.)GO TO 700
      WRITE(LLL,401)
      GO TO 71
700   IXRYZ=IFIX(DISTP)/10
70    IF(IARMZ(3).EQ.0)GO TO 50
41    WRITE(LLL,42)
42    FORMAT(' ENTER RANGE OF WEB')
      N=9
      READ(L,9,ERR=73)DISTP
      IWEBZ=IFIX(DISTP)
      IF(IWEBZ.LE.0)GO TO 41
50    IF(IARMZ(4).EQ.0)GO TO 53
54    WRITE(LLL,55)
55    FORMAT(' ENTER NUMBER OF FALSE IMAGES TO BE GENERATED-
     * AT MOST 15')
      N=10
      READ(L,9,ERR=73)DISTP
      IMAGZ=IFIX(DISTP)
      IF(IMAGZ.LT.0.OR.IMAGZ.GT.15)GO TO 54
58    WRITE(LLL,57)
57    FORMAT(' ENTER RADIUS WITHIN WHICH THE IMAGES ARE TO BE
     * GENERATED')
      N=11
      READ(L,9,ERR=73)DISTP
      IMAGRZ=IFIX(DISTP)
      IF(IMAGRZ.LT.1.OR.IMAGRZ.GT.50)GO TO 58
53    IF(IARMZ(5).EQ.0)GO TO 60
51    WRITE(LLL,52)
52    FORMAT(' ENTER RANGE AT WHICH ENTERPRISE CAN DETECT THE KZINTI SH
     *IP'/' THROUGH THE CLOAKING DEVICE')
      N=12
      READ(L,9,ERR=73)DISTP
      ICLOZ=IFIX(DISTP)
      IF(ICLOZ.LE.0)GO TO 51
60    IF(IARMZ(6).EQ.0)GO TO 29
61    WRITE(LLL,62)
62    FORMAT(' ENTER RANGE OF STASIS FIELD')
      N=13
      READ(L,9,ERR=73)DISTP
      IABSZ=IFIX(DISTP)
      IF(IABSZ.LE.0)GO TO 61
64    WRITE(LLL,63)
63    FORMAT('ENTER STRENGTH OF STASIS FIELD IN EQUIVALENT PHASER UNIT
     *S PER TURN')
      N=14
      READ(L,9,ERR=73)DISTP
      ISTAZ=IFIX(DISTP)
      IF(ISTAZ.LT.1)GO TO 64
29    KILLZ=100
      WRITE(LLL,27)
27    FORMAT(' IF YOU WISH THE KZINTI TO BE NEUTRAL UNTIL FIRED AT'/' O
     *R UNTIL YOU COME WITHIN A CERTAIN RANGE, ENTER THE RANGE AT WHICH'
     */' THEY BECOME HOSTILE.'/' IF NOT, TYPE ''100''.')
      N=15
      READ(L,9,ERR=73)DISTP
      KILLZ=IFIX(DISTP)
      IF(KILLZ.LE.0.OR.KILLZ.GT.100)GO TO 29
280   IF(IARMZ(1).EQ.1.OR.IARMZ(2).EQ.1)GO TO 28
      IARMZ(1)=1
      IARMZ(2)=1
      INDUZ=90
      IXRYZ=90
28    RETURN
73    CALL ILLDAT
      GO TO (7,10,131,15,21,30,35,71,41,54,58,51,61,64,280),N
      END


C====================================================
C TREK7   MODULE E
C  CONVERTED TO PC BY: DAN GAHLINGER
C ENTIRE MODULE TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C  C-O SHIP OPERATIONS
C
C ATACK   MORDOR  PIKE    DOOMVE  EDIBLE  MNERVA
C ASIMOV  NIVEN   WODEN   ALPHA   SIMAK   LEGUIN
C
C====================================================

C              -- DONALD ECCLESTONE SUBPROGRAM FOR     T R E K 7
C
C  CONVERTED TO PC BY: DAN GAHLINGER
C TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C                 AAA     TTTTT   AAA   CCC K   K
C                A   A      T    A   A C    K  K
C                AAAAA      T    AAAAA C    KKK
C                A   A      T    A   A C    K  K
C                A   A      T    A   A  CCC K   K
C
      SUBROUTINE ATACK
      LOGICAL MORDOR
        integer itzro,itvl1
        real rtzro,rtvl1
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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 /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 /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 /U/LAUNCH,NUMOUT,NUME(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
        COMMON /TOM/ITOM
      DO 1000 I=1,8
      N=4
      DIST(I)=100.
      IF(ICHOS(I).NE.1)GO TO 1000
      IF(IWEB(1).EQ.I+4)GO TO 1000
      IF(IWEB(2).EQ.I+4)GO TO 1000
      IF(IO.EQ.1)PRINT 1970,I
1970  FORMAT(' BEGIN ATACK I=',I7)
      IF(MORDOR(MM,MN,RAD,BERNG))GO TO 1000
      IF(I.EQ.5.OR.I.EQ.6)GO TO 10100
      GO TO 1010
1010  N=4
10100 BERNG=BERNG*3.14159265/180.
      AJUST=0.0
      IGNORE=0
      IV=I+4
      IF(IONNO.EQ.1.AND.I.EQ.6)IGNORE=1
        itzro=0
10101 CALL HORTA(IKLNR(I),IKLNC(I),MM,MN,RAD,BERNG,
     *itzro,AJUST,IGNORE,DIST(I),itzro)
      IF(IO.EQ.1)PRINT 1972,MMIN,I7,I8,DISTP
1972  FORMAT(' MMIN=',I7,' I7=',I7,' I8=',I7,' DISTP=',F15.7)
      IF(MMIN.LT.5)GO TO 101
      IF(MMIN.LT.15)GO TO 100
      IF(MMIN.LT.19)GO TO 103
      IF(MMIN.EQ.19)GO TO 102
      IF(MMIN.EQ.21)GO TO 106
100   IF(I.GT.3)GO TO 106
      AJUST=AJUST+0.2617993
      IF(AJUST.GT.6.283184)GO TO 107
      IONK(I)=0
      IGNORE=0
      GO TO 10101
106   RAD=RAD-DISTP+1.42
      IVV=0
      IF(IONNO.EQ.1.AND.I.EQ.6)IGNORE=1
1060  IVVV=N
      N=2
10801 I81=I8
      I71=I7
        rtzro=0.0
        itvl1=1
        rtvl1=1.5
      CALL HORTA(I71,I81,IKLNR(I),IKLNC(I),
     *rtvl1,rtzro,itzro,rtzro,itvl1,rtzro,itzro)
      IF(MMIN.NE.I+4.AND.MMIN.NE.19.AND.MMIN.LT.21)GO TO 10801
1080  MMAP(IKLNR(I),IKLNC(I))=IBLK
      IF(ISPOK(I).EQ.1)MMAP(IKLNR(I),IKLNC(I))=III
      ISPOK(I)=0
      IKLNR(I)=I7
      IKLNC(I)=I8
      IF(MMAP(I7,I8).EQ.III)ISPOK(I)=1
      IF(IVV.EQ.1)GO TO 10093
      IF(IVV.EQ.2)GO TO 10101
      N=IVVV
      AJUST=AJUST+0.7653981
      IF(AJUST.GT.10.)GO TO 10093
      GO TO 10101
101   IF(N.EQ.5)GO TO 106
      IF(N.EQ.6)GO TO 1061
      IVV=1
      GO TO 1060
102   RAD=(RAD-DISTP)/2.
      IONK(I)=1
      IGNORE=1
      IVV=2
      GO TO 1080
107   IVV=1
      GO TO 1060
103   CALL MNERVA(I)
      IVV=1
      MMAP(I7,I8)=IBLK
      GO TO 1080
108   IVV=1
      GO TO 1080
1061  DO 535 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 535
      L=IV+4
      WRITE(LLL,1062)(INAME(IQ0,MMIN),IQ0=1,3)
1062  FORMAT(' THE KZINTI WARSHIP HAS RAMMED THE ',3A4)
535   CONTINUE
      MMAP(I7,I8)=IBLK
      MMAP(IKLNR(6),IKLNC(6))=IBLK
      IF(ISPOK(6).EQ.1)MMAP(IKLNR(6),IKLNC(6))=III
      DFLCT(MMIN)=-1.
      DFLCK(6)=-1.
      ISTAT=2
      RETURN
10093 IF(I.NE.6)GO TO 1063
      CALL NIVEN
      GO TO 1000
1063  CALL ASIMOV(MMAP(IKLNR(I),IKLNC(I)),I)
      IF(I.NE.2)GO TO 1029
1205  N=DFLCK(I)/5.
      IF(N.EQ.0)GO TO 672
      CALL RANDO(J,1,N)
      IF(J.GT.1)GO TO 1029
672   DO 536 IV=1,4
      IF(ICHOE(IV).NE.1)GO TO 536
      L=IV+4
      INVIS(IV)=1
      WRITE(LLL,1030)
1030  FORMAT(' THERE HAS BEEN A BREAKDOWN IN THE ROMULAN WARSHIP''S CLO
     *AKNG DEVICE'/' AND THE SHIP CAN NOW BE PICKED UP BY OUR SENSORS')
536   CONTINUE
1029  MMAP(I7,I8)=IENM1(I)
1000  CONTINUE
      IF(ICHOS(8).EQ.0.AND.NUMOUT.EQ.0)RETURN
      KOENIG=1
      CALL ALPHA
      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 - MORDOR
C
C -WHERE THE SHADOWS LIE
      LOGICAL FUNCTION MORDOR(MM,MN,RAD,BERNG)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /G/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)
        COMMON /TOM/ITOM
      MORDOR=.TRUE.
      CALL PIKE(IKLNR(I),IKLNC(I),IBPSB(I))
      IF(MMIN.EQ.0)GO TO 1000
      DIST(I)=DISTP
      IWHO(I)=MMIN
      IF(I.EQ.8)GO TO 1000
      IF(MMIN.GT.4)GO TO 500
      MM=IENTR(MMIN)
      MN=IENTC(MMIN)
      A=DFLCT(MMIN)
      GO TO 501
500   IF(MMIN.GT.6)GO TO 502
      I7=MMIN-4
      MM=IBASR(I7)
      MN=IBASC(I7)
      A=DFLCB(I7)
      GO TO 501
502   IF(MMIN.GT.14)GO TO 503
      I7=MMIN-6
      MM=IKLNR(I7)
      MN=IKLNC(I7)
      A=DFLCK(I7)
      GO TO 501
503   I7=MMIN-14
      MM=IGLER(I7)
      MN=IGLEC(I7)
      A=0
501   AJUST=0.
      IONK(I)=0
      GO TO (1006,1001,1002,1007,1011,110,1012),I
1006  CALL RANDO(J,7,9)
      IF(DIST(I).LE.1.5)GO TO 1000
      RAD=FLOAT(J)
1005  AJUST=0.0
1009  IF(IBPSB(I).EQ.0.OR.IGOCO(I).EQ.0)GO TO 600
      DISTP=100.
      IVV=0
      DO 601 IV=1,4
      IF(ICHOE(IV).NE.1.OR.(IBPSC(IV)+1)/2.NE.IBPSB(I))GO TO 601
      B=DI(IKLNR(I),IKLNC(I),IENTR(IV),IENTC(IV))
      IF(B.GT.DISTP)GO TO 601
      IVV=IV
      DISTP=B
601   CONTINUE
      IF(IVV.EQ.0)GO TO 600
      MM=IENTR(IVV)
      MN=IENTC(IVV)
      AJUST=0.
      N=4
600   IV=MM-IKLNR(I)
      IVV=MN-IKLNC(I)
      BERNG=ANG(IV,IVV)
1101  BERNG=BERNG+AJUST
      IF(BERNG.LT.0)BERNG=BERNG+360.
      IF(BERNG.GT.360.)BERNG=BERNG-360.
      DO 504 I7=1,4
      IF(ICHOE(I7).NE.1)GO TO 504
      CALL DUNSEL(IKLNR(I),IKLNC(I),RAD,BERNG)
504   CONTINUE
      MORDOR=.FALSE.
1000  RETURN
1001  CALL RANDO(J,7,9)
      RAD=FLOAT(J)
      IV=KILLR
      DO 10010 J=1,4
10010 INVIS(J)=0
      IF(DISTP.LE.10..OR.KILLR.NE.1)KILLR=2
      IF(A-DFLCK(2).GT.20.)KILLR=3
      IV=IV-KILLR
      I71=MMIN+4
      GO TO (1003,10031,1004),KILLR
1003  CALL RANDO(J,1,360)
      BERNG=FLOAT(J)
      GO TO 1009
10031 CALL RANDO(J,-90,90)
      AJUST=FLOAT(J)
      II71=I71+1
      IF(MMIN.LT.5.AND.IV.NE.0)WRITE(II71,10032)
10032 FORMAT(' ROMULAN SHIP ATTACKING')
      GO TO 1009
1004  CALL RANDO(J,90,270)
      AJUST=FLOAT(J)
      II71=I71+1
      IF(MMIN.LT.5.AND.IV.NE.0)WRITE(II71,10033)
10033 FORMAT(' ROMULAN SHIP RETREATING')
      GO TO 1009
1002  IF(DISTP.LE.8.)GO TO 1000
      CALL RANDO(J,5,10)
      RAD=FLOAT(J)
      IF(DISTP-8..LT.RAD)RAD=DISTP-6.5
      GO TO 1005
1007  RAD=11.
      KILLG=1
      IF(DFLCK(4)-A.LT.25.)KILLG=2
      IF(KILLG.EQ.1)GO TO 1005
1008  AJUST=180.
      GO TO 1009
1011  RAD=12.
123   AJUST=ABS(ATAN(1.1/DISTP))*180./3.14159265
      N=5
      GO TO 1009
110   RAD=IMAXZ
      N=4
      IF(IDRIZ.EQ.1)ISTAT=11
      IF(KILLZ.EQ.100)GO TO 124
      IF(DISTP.LE.KILLZ)GO TO 125
      CALL RANDO(I7,1,360)
      AJUST=I7
      GO TO 1009
125   KILLZ=100
124   GO TO (121,122,123),IPLANZ
121   AJUST=0.
      IF(A-DFLCK(6).GT.IRUNZ)AJUST=180.
      CALL RANDO(I7,-IDEVZ,IDEVZ)
      AJUST=AJUST+I7
      GO TO 1009
122   AJUST=0.
      N=6
      GO TO 1009
1012  CALL DOOMVE(MM,MN)
      GO TO 1000
      END


C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K
C  CONVERTED TO PC BY: DAN GAHLINGER
C TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C - PIKE -
C
      SUBROUTINE PIKE(J1,J2,J3)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /G/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)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      DISTP=100.
      MMIN=0
      DO 1 IVV=1,4
      IF(ICHOE(IVV).EQ.0.OR.ICHOE(IVV).EQ.3)GO TO 1
      IF(J3.EQ.(IBPSC(IVV)+1)/2)GO TO 1
      AJUST=DI(J1,J2,IENTR(IVV),IENTC(IVV))
      IF(AJUST.GE.DISTP)GO TO 1
      IF(AJUST.EQ.0)GO TO 1
      DISTP=AJUST
      MMIN=IVV
1     CONTINUE
      DO 2 IVV=1,2
      IF(ICHOB(IVV).EQ.0)GO TO 2
      IF(J3.EQ.IBPSS(IVV))GO TO 2
      AJUST=DI(J1,J2,IBASR(IVV),IBASC(IVV))
      IF(AJUST.GE.DISTP)GO TO 2
      IF(AJUST.EQ.0)GO TO 2
      IF(J3.EQ.0.AND.IJ(IBPSS(IVV)).EQ.0)GO TO 2
      DISTP=AJUST
      MMIN=IVV+4
2     CONTINUE
      DO 3 IVV=1,8
      IF(ICHOS(IVV).NE.1)GO TO 3
      IF(J3.EQ.IBPSB(IVV))GO TO 3
      AJUST=DI(J1,J2,IKLNR(IVV),IKLNC(IVV))
      IF(AJUST.GE.DISTP)GO TO 3
      IF(AJUST.EQ.0)GO TO 3
      IF(IVV.NE.2)GO TO 10
      IF(INVIS(2*J3-1)+INVIS(2*J3).EQ.0.OR.AJUST.GT.5)GO TO 3
      GO TO 11
10    IF(IVV.NE.6.OR.IARMZ(5).EQ.0)GO TO 11
      IF(INVIZ(2*J3-1)+INVIZ(2*J3).EQ.0.OR.AJUST.GT.ICLOZ)GO TO 3
11    DISTP=AJUST
      MMIN=IVV+6
3     CONTINUE
4     IF(NUMOUT.EQ.0)RETURN
      DO 5 IVV=1,LAUNCH
      IF(IGLER(IVV).EQ.0)GO TO 5
      IF(J3.EQ.IBPSE(IVV))GO TO 5
      AJUST=DI(J1,J2,IGLER(IVV),IGLEC(IVV))
      IF(AJUST.GE.DISTP)GO TO 5
      IF(AJUST.EQ.0)GO TO 5
      DISTP=AJUST
      MMIN=IVV+14
5     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/27/2000 BY: D.G.
C
C                - DOOMVE -
C
      SUBROUTINE DOOMVE(MM,MN)
      INTEGER EDIBLE
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(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),IGD(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 /V/IWEB(2),IWEBZ,INVIS(4)
        COMMON /TOM/ITOM
1012  IGNORE=IFIX(DISTP)
      DO 506 N=I,IGNORE
      IVVV=IKLNR(7)-N+1
      IVV=IKLNR(7)+N-1
      I71=IKLNC(7)-N
      I81=IKLNC(7)+N
      IF(IVVV.LT.1)IVVV=1
      IF(I71.LT.1)I71=1
      IF(IVV.GT.60)IVV=60
      IF(I81.GT.60)I81=60
      I7=IKLNR(7)-N
      IF(I7.LT.1)GO TO 507
      DO 508 I8=I71,I81
      J=EDIBLE(MM,MN)
      IF(J.GT.0)GO TO 510
508   CONTINUE
507   I7=IKLNR(7)+N
      IF(I7.GT.60)GO TO 509
      DO 511 I8=I71,I81
      J=EDIBLE(MM,MN)
      IF(J.GT.0)GO TO 510
511   CONTINUE
509   I8=IKLNC(7)-N
      IF(I8.LT.1)GO TO 512
      DO 513 I7=IVVV,IVV
      J=EDIBLE(MM,MN)
      IF(J.GT.0)GO TO 510
513   CONTINUE
512   I8=IKLNC(7)+N
      IF(I8.GT.60)GO TO 506
      DO 515 I7=IVVV,IVV
      J=EDIBLE(MM,MN)
      IF(J.GT.0)GO TO 510
515   CONTINUE
506   CONTINUE
      I7=MM
      I8=MN
      GO TO 517
510   IV=IKLNC(7)
      IVV=IKLNR(7)
      MMAP(IVV,IV)=IBLK
      IF(ISPOK(7).EQ.1)MMAP(IVV,IV)=III
      ISPOK(7)=0
      IKLNC(7)=I8
      IKLNR(7)=I7
      MMAP(I7,I8)=IENM1(7)
      GO TO (514,516,517),J
514   DO 518 IV=1,5
      IF(I7.NE.LI2R(IV))GO TO 516
      IF(I8.NE.LI2C(IV))GO TO 516
      LI2C(IV)=0
      LI2R(IV)=0
      GO TO 1000
518   CONTINUE
      DO 519 IV=1,2
      IF(I7.NE.IBASR(IV))GO TO 519
      IF(I8.NE.IBASC(IV))GO TO 519
529   DFLCB(IV)=-1.
      ISTAT=2
      DO 5190 IVV=1,4
      IF(ICHOE(IVV).EQ.0)GO TO 5190
      I71=IVV+4
      II71=I71+1
      WRITE(II71,521)(ISIDE(IQ0,IV),IQ0=1,3),IBASE(IV)
521   FORMAT(' THE DOOMSDAY MACHINE HAS EATEN ',3A4,' STARBASE',I3)
5190  CONTINUE
519   CONTINUE
      GO TO 1000
516   CALL RANDO(IV,1,7)
      IF(IV.GT.2)GO TO 520
      DO 522 J=1,4
      IF(ICHOE(J).EQ.0)GO TO 522
      IV=J+4
      IVI=IV+1
      WRITE(IVI,523)
523   FORMAT(' THE DOOMSDAY MACHINE HAS JUST EATEN A MINE - NO DAMAGE')
522   CONTINUE
      GO TO 1000
520   CALL MNERVA(7)
      GO TO 1000
517   ISTAT=2
      IF(MMIN.GT.4)GO TO 525
      DFLCT(MMIN)=-1.
      DO 526 IVV=1,4
      IF(ICHOE(IVV).EQ.0)GO TO 526
      IV=IVV+4
      IVI=IV+1
      WRITE(IVI,527)(INAME(IQ0,MMIN),IQ0=1,3)
527   FORMAT(' THE DOOMSDAY MACHINE HAS EATEN THE ',3A4)
526   CONTINUE
      GO TO 1000
525   IF(MMIN.GT.6)GO TO 528
      IV=MMIN-4
      GO TO 529
528   IF(MMIN.GT.14)GO TO 530
      MMIN=MMIN-6
      DFLCK(MMIN)=-1.
      DO 531 IVV=1,4
      IF(ICHOE(IVV).EQ.0)GO TO 531
      IV=IVV+4
      IVI=IV+1
      WRITE(IVI,532)(IENM2(J,MMIN),J=1,4)
532   FORMAT(' THE DOOMSDAY MACHINE HAS EATEN THE ',4A4)
531   CONTINUE
      GO TO 1000
530   MMIN=MMIN-14
      CALL BOOM(MMIN)
      DO 533 IVV=1,4
      IF(ICHOE(IVV).EQ.0)GO TO 533
      IV=IVV+4
      IVI=IV+1
      WRITE(IVI,534)MMIN
534   FORMAT(' THE DOOMSDAY MACHINE HAS EATEN EAGLE',I3)
533   CONTINUE
      GO TO 1000
1000  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                       - EDIBLE -
C
      INTEGER FUNCTION EDIBLE(MM,MN)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      EDIBLE=0
      NA=MMAP(I7,I8)
      IF(NA.EQ.IBLK.OR.NA.EQ.III)RETURN
      IF(NA.NE.ISTAR)GO TO 1
      DO 3 IK=1,2
      IF(MM.EQ.IBASR(IK).AND.MN.EQ.IBASC(IK).AND.IJ(IBPSS(IK)).EQ.0)
     *RETURN
3     CONTINUE
      EDIBLE=1
      RETURN
1     IF(NA.LT.'1'.OR.NA.GT.'4')GO TO 2
      EDIBLE=2
      RETURN
2     IF(MM.NE.I7)RETURN
      IF(MN.EQ.I8)EDIBLE=3
      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 - MNERVA -
C
      SUBROUTINE MNERVA(J)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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),IEE(4),MINES
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      CALL RANDO(IV,10,100)
      IVV=IFIX(ALOG((101.-DFLCK(J))*IV+10.)/0.700619195-1.8185)
      DO 141 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 141
      L=IV+4
      WRITE(LLL,401)(IENM2(N,J),N=1,4)
401   FORMAT(1X,4A4,' HAS COLLIDED WITH A MINE - DAMAGE REPORT-')
141   CONTINUE
      CALL GRUP3(IVV,J)
      MINES=MINES-1
      RETURN
      END


C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K
C  CONVERTED TO PC BY: DAN GAHLINGER
C TYPE-EXACT CHECK 04/27/2000 BY: D.G.
C
C - ASIMOV -
C

      SUBROUTINE ASIMOV(NA,K)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      IF(NA.NE.III)RETURN
      IONK(K)=1
      ISPOK(K)=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 - NIVEN -
C
      SUBROUTINE NIVEN
      LOGICAL WODEN
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25),
     *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGD(4),MINES
      COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      COMMON /Q/IARMZ(6),INDUZ,IXRYZ,IMAGZ,IMAGRZ,IABSZ,ISTAZ,INVIZ(4),
     *ICLOZ,IONNO,IPLANZ,IRUNZ,IDEVZ,IDRIZ,IMAXZ
        COMMON /TOM/ITOM
85    IF(IARMZ(4).EQ.0)GO TO 81
      IF(IMAGZ.EQ.0)GO TO 81
      MMIN=0
      DO 86 N=1,IMAGZ
87    CALL RANDO(IV,-IMAGRZ,IMAGRZ)
      CALL RANDO(IVV,-IMAGRZ,IMAGRZ)
      MMIN=MMIN+1
      IF(MMIN.GT.20)GO TO 81
      IV=IKLNR(6)+IV
      IVV=IKLNC(6)+IVV
      IF(.NOT.WODEN(IV,IVV,MMAP(IV,IVV)))GO TO 87
      MMIN=0
86    MMAP(IV,IVV)=IENM1(6)
      DO 83 MMIN = 1,20
      CALL RANDO(IV,IKLNR(6)-3,IKLNR(6)+3)
      CALL RANDO(IVV,IKLNC(6)-3,IKLNC(6)+3)
      IF(.NOT.WODEN(IV,IVV,MMAP(IV,IVV)))GO TO 83
      IKLNR(6)=IV
      IKLNC(6)=IVV
      GO TO 88
83    CONTINUE
88    CALL ASIMOV(MMAP(IKLNR(6),IKLNC(6)),6)
81    MMAP(IKLNR(6),IKLNC(6))=IENM1(6)
      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 - WODEN -
C
      LOGICAL FUNCTION WODEN(I,J,NA)
      LOGICAL CYRANO
      COMMON /M/MMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      WODEN=.FALSE.
      IF(CYRANO(I,J))RETURN
      IF(NA.NE.IBLK.AND.NA.NE.III.AND.NA.NE.IENM1(6))RETURN
      WODEN=.TRUE.
      RETURN
      END

C       -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C  CONVERTED TO PC BY: DAN GAHLINGER
C checked type-exact 04/24/2000 by DG
C
C               - ALPHA -
C

      SUBROUTINE ALPHA
        integer itzro,itvl1
        real rtzro,rtvl1
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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 /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      CALL SIMAK(J1,J2)
      ISTAT=0
      I=0
      IV=0
      BDIS=DI(J1,J2,IKLNR(8),IKLNC(8))
      IF(IO.EQ.1)PRINT 1978,J1,J2,BDIS
1978  FORMAT(' BEGIN ALPHA J1=',I5,' J2=',I5,' BDIS=',F15.7)
      DO 2 IVV=1,LAUNCH
      IF(IGLER(IVV).EQ.0)GO TO 2
      RAD=2.9
      I7=J1-IGLER(IVV)
      I8=J2-IGLEC(IVV)
      IF(BDIS.LE.5.)GO TO 18
      IF(IABS(I7).LE.3.AND.IABS(I8).LE.3)GO TO 2
18    BERNG=ANG(I7,I8)*3.14159265/180.
      AJUST=0.0
7     N=4
      IGNORE=0
        itzro=0
      CALL HORTA(IGLER(IVV),IGLEC(IVV),
     *itzro,itzro,RAD,BERNG,itzro,AJUST,IGNORE,itzro,itzro)
      IF(IO.EQ.1)PRINT 1979,IVV,MMIN,I7,I8
1979  FORMAT(' =#=',I3,' MMIN=',I5,' I7=',I5,' I8=',I5)
      IF(MMIN.GE.15.AND.MMIN.LE.18)GO TO 5
      IF(MMIN.EQ.21)GO TO 10
      I=1
      RAD=RAD-DISTP+1.42
      AJUST=AJUST+0.785398163
      IF(AJUST.GT.7.)GO TO 2
      N=2
      I4=0
6     I71=I7
      I81=I8
      IGNORE=0
      I4=I4+1
        rtzro=0.0
        itzro=0
        rtvl1=1.5
      CALL HORTA(I71,I81,IGLER(IVV),IGLEC(IVV),
     *rtvl1,rtzro,itzro,rtzro,IGNORE,itzro,itzro)
1981  IF(MMIN.EQ.14.AND.I7.EQ.IGLER(IVV).AND.I8.EQ.IGLEC(IVV))GO TO 11
      IF(MMIN.LT.21)GO TO 6
11    MMAP(IGLER(IVV),IGLEC(IVV))=IBLK
      MMAP(I7,I8)=IGLE
      IGLER(IVV)=I7
      IGLEC(IVV)=I8
      IF(I.EQ.1)GO TO 7
      GO TO 2
5     DO 12 I71=1,4
      IF(ICHOE(I71).EQ.0)GO TO 12
      I81=I71+4
      II81=I81+1
      WRITE(II81,8)IVV
8     FORMAT(' EAGLE',I3,' DESTROYED ON COLLISION WITH A MINE')
12    CONTINUE
      MMAP(I7,I8)=IBLK
      CALL BOOM(IVV)
      MINES=MINES-1
      GO TO 2
10    I=0
      GO TO 11
2     CONTINUE
      IF(LAUNCH.LT.25.AND.ICHOS(8).NE.0)CALL LEGUIN(J1,J2)
      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 - SIMAK -
C
      SUBROUTINE SIMAK(J1,J2)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      I71=IKLNR(8)
      I81=IKLNC(8)
      DO 13 I=1,LAUNCH
      IF(IGLER(I).EQ.0)GO TO 13
      I71=IGLER(I)
      I81=IGLEC(I)
      GO TO 14
13    CONTINUE
14    AJUST=100.
      JTK=0
      DO 15 I7=1,4
      IF(ICHOE(I7).EQ.0)GO TO 15
      DISTP=DI(IENTR(I7),IENTC(I7),I71,I81)
      IF(DISTP.GT.AJUST)GO TO 15
      AJUST=DISTP
      JTK=I7
15    CONTINUE
16    J1=IENTR(JTK)
      J2=IENTC(JTK)
      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 - LEGUIN -
C
      SUBROUTINE LEGUIN(J3,J4)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      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 /TOM/ITOM
      J1=J3
      J2=J4
      IF(J1.EQ.0)CALL SIMAK(J1,J2)
      I71=J1-IKLNR(8)
      IVV=J2-IKLNC(8)
      DISTP=0.785396163
      IF(I71.EQ.0)DISTP=0.
      IF(IVV.EQ.0)DISTP=2.0*DISTP
      IF(IVV.LT.0)DISTP=3.14159265-DISTP
      IF(I71.LT.0)DISTP=-DISTP
      AJUST=0.0
      I81=1
      I8=LAUNCH+1
107   IF(I8.GT.25)GO TO 113
      I71=IFIX(1.8*SIN(DISTP+AJUST))+IKLNR(8)
      IVV=IFIX(1.8*COS(DISTP+AJUST))+IKLNC(8)
      IF(MMAP(I71,IVV).EQ.IBLK)GO TO 105
101   DO 122 JTK=1,4
      IF(MMAP(I71,IVV).EQ.IEE(JTK))GO TO 123
      IF(MMAP(I71,IVV).EQ.IM(JTK))GO TO 102
122   CONTINUE
      GO TO 110
123   DO 124 MMIN=1,4
      IF(ICHOE(MMIN).EQ.0)GO TO 124
      N=MMIN+4
      NNN=N+1
      WRITE(NNN,103)I8,(INAME(IQ0,JTK),IQ0=1,3),I8,
     *(INAME(IQ0,JTK),IQ0=1,3)
103   FORMAT(' EAGLE',I3, ' CRASHED INTO ',3A4, ' ON TAKE-OFF'/
     *' EAGLE',I3,' DESTROYED'/1X,3A4,' DAMAGE REPORT-')
124   CONTINUE
      CALL RANDO(IV,1,100)
      J1=ALOG((101.-DFLCT(JTK))*IV+10.)/0.700619195-1.8185
      CALL GRUP1(J1,JTK)
      NUMOUT=NUMOUT-1
      IGLER(I8)=0
      IGLEC(I8)=0
      GO TO 106
102   DO 125 J1=1,4
      IF(ICHOE(J1).EQ.0)GO TO 125
      J2=J1+4
      JJ2=J2+1
      WRITE(JJ2,104)I8
104   FORMAT(' EAGLE',I3,' DESTROYED ON COLLISION WITH A MINE')
125   CONTINUE
      MMAP(I71,IVV)=IBLK
      MINES=MINES-1
      NUMOUT=NUMOUT-1
      IGLER(I8)=0
      IGLEC(I8)=0
      GO TO 106
105   MMAP(I71,IVV)=IGLE
      IGLER(I8)=I71
      IGLEC(I8)=IVV
      IF(IBPOB(8).EQ.0)GO TO 1060
      IBPOB(8)=IBPOB(8)-2
      NUME(IBPSB(8))=NUME(IBPSB(8))+1
      II(IBPSB(8))=II(IBPSB(8))+1
      IBPOE(I8)=2
      IBPSE(I8)=IBPSB(8)
      GO TO 106
1060  I3=I3+1
106   I81=I81+1
      I8=I8+1
110   IF(AJUST.GT.0)GO TO 111
      AJUST=0.765398163-AJUST
      GO TO 112
111   AJUST=-AJUST
112   IF(AJUST.GT.-6.28.AND.I81.LE.5)GO TO 107
113   LAUNCH=LAUNCH+I81-1
      NUMOUT=NUMOUT+I81-1
120   RETURN
      END


C======================================================================
C
C     TREK7 MODULE F
C CONVERTED TO PC BY: DAN GAHLINGER
C ENTIRE MODULE TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
C   SHIP DAMAGE ROUTINES
C
C BOOM    LIRPA   GRUP1   GRUP2   GRUP3   TPAU
C OXMYX   GOTU    GOTME   FORBIN  QUARK   POS
C
C======================================================================

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - BOOM
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE BOOM(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),LLL,II1,INA,IVI,II7,II8,NNN
      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 /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/MMMAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /S/IBPOB(8),IBPOE(25)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      IF(ISTAT.EQ.2)GO TO 2
      MMMAP(IGLER(J),IGLEC(J))=IBLK
2     IGLER(J)=0
      IGLEC(J)=0
      NUMOUT=NUMOUT-1
      IF(IBPOE(J).EQ.0)GO TO 1
      IBPOE(J)=0
      II(IBPSE(J))=II(IBPSE(J))-1
      NUME(IBPSE(J))=NUME(IBPSE(J))-1
      IBPSE(J)=0
      RETURN
1     I3=I3-1
      RETURN
      END

C     -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C    - LIRPA
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      INTEGER FUNCTION LIRPA(AA,II)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      LIRPA=ALOG((101.-AA)*II*II/DISTP)/0.700619195-6.605
      RETURN
      END

C     DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C CONVERTED TO PC BY: DAN GAHLINGER
C
C     - GRUP 1
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE GRUP1(IVV,MI)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
      IVA=IXIF(IVV)
      CALL GOTME(IVA,MI)
      DFLCT(MI)=DFLCT(MI)-FLOAT(IVA)*1.6
      DO 350 I71=1,4
      IF(ICHOE(I71).EQ.0)GO TO 350
      IF(I71.EQ.IBPSC(MI))GO TO 350
      CALL GOTU(IVA,I71)
350   CONTINUE
      RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - GRUP2 -
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE GRUP2(IVV,MI)
      COMMON /B/NDEAB(2),IPHOB(2),IONB(2),IGOB(2),IFIB(2)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      IVA=IXIF(IVV)
      DFLCB(MI)=DFLCB(MI)-FLOAT(IVA)*1.6
      DO 351 I71=1,4
      IF(ICHOE(I71).EQ.0)GO TO 351
      CALL GOTU(IVA,I71)
351   CONTINUE
      IGOB(MI)=1
      CALL RANDO(I8,IVA/2,IVA*2)
      NDEAB(MI)=NDEAB(MI)-I8
      IF(NDEAB(MI).LT.0)NDEAB(MI)=0
      IF(IVA.GT.2)IFIB(MI)=0
      RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - GRUP3 -
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE GRUP3(IVV,MI)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /K/IWHO(8),DIST(8),KILLZ,KILLR,KILLD,KILLG,IGOCO(8)
      COMMON /S/IBPOB(8),IBPOE(25)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
        COMMON /TOM/ITOM
      IVA=IVV
      IF(IONK(MI).EQ.1)IVA=IVV+2
      IVA=IXIF(IVA)
      DFLCK(MI)=DFLCK(MI)-FLOAT(IVA)*1.6
      DO 352 I71=1,4
      IF(ICHOE(I71).EQ.0)GO TO 352
      CALL GOTU(IVA,I71)
352   CONTINUE
      IF(IBPOB(MI).EQ.0)GO TO 374
      CALL RANDO(I8,IVA/2,IVA)
      IBPOB(MI)=IBPOB(MI)-I8
      IF(IBPOB(MI).GT.0)GO TO 374
      CALL TPAU(MI)
      CALL OXMYX
374   IF(MI.EQ.2)KILLR=2
      IF(MI.EQ.7)KILLD=2
      RETURN
      END

C DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - TPAU -
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE TPAU(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),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /S/IBPOB(8),IBPOE(25)
      COMMON/T/ICHOE(4),ICHOS(8),ICHOB(2)
      DO 142 IV=1,4
      IF(ICHOE(IV).EQ.0)GO TO 142
      I7=IV+4
      II7=I7+1
      WRITE(II7,207)(IENM2(N,J),N=1,4)
207   FORMAT(' CONTROL OF THE ',4A4,' HAS BEEN LOST')
142   CONTINUE
      II(IBPSB(J))=II(IBPSB(J))-1
      IBPSB(J)=0
      IBPOB(7)=IBPOB(7)-1
      I3=I3+1
      IBPOB(J)=0
      RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - OXMYX -
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE OXMYX
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /V/IWEB(2),IWEBZ,INVIS(4)
      DO 133 N=1,2
      IF(IWEB(N).GT.4)GO TO 134
      IF(IBPSB(3*N).EQ.(IBPSC(IWEB(N))+1)/2)IWEB(N)=0
      GO TO 133
134   IF(IWEB(N).EQ.0)GO TO 133
      IF(IBPSB(3*N).EQ.IBPSB(IWEB(N)-4))IWEB(N)=0
133   CONTINUE
      RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - GOTU -
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
      SUBROUTINE GOTU(IVV,I71)
      L=I71+4
      GO TO (40,43,45,90,48,92,52,55,58,61,62),IVV+1
40    WRITE(LLL,42)
42    FORMAT(' NO DAMAGE')
      GO TO 50
43    WRITE(LLL,242)
242   FORMAT(' DAMAGE FACTOR 1- VERY LITTLE DAMAGE SUSTAINED')
      GO TO 50
45    WRITE(LLL,47)
47    FORMAT(' DAMAGE FACTOR 2- MINOR DAMAGE SUSTAINED')
      GO TO 50
90    WRITE(LLL,91)
91    FORMAT(' DAMAGE FACTOR 3- MINOR STRUCTURAL DAMAGE'/16X,'- THERE IS
     * A DENT IN THE VESSEL')
      GO TO 50
48    WRITE(LLL,51)
51    FORMAT(' DAMAGE FACTOR 4- VESSEL MODERATELY DAMAGED')
      GO TO 50
92    WRITE(LLL,93)
93    FORMAT(' DAMAGE FACTOR 5- LIFE SUPPORT SYSTEM BREAKDOWN IN PARTS
     * OF THE VESSEL')
      GO TO 50
52    WRITE(LLL,54)
54    FORMAT(' DAMAGE FACTOR 6- HEAVY INTERNAL DAMAGE TO VESSEL')
      GO TO 50
55    WRITE(LLL,57)
57    FORMAT(' DAMAGE FACTOR 7- HEAVY STRUCTURAL DAMAGE TO VESSEL')
      GO TO 50
58    WRITE(LLL,60)
60    FORMAT(' DAMAGE FACTOR 8- A NUMBER OF DECKS HAVE RUPTURED ON THE
     * VESSEL')
      GO TO 50
61    WRITE(LLL,63)
63    FORMAT(' DAMAGE FACTOR 9- THE VESSEL HAS BEEN ROCKED BY AN EXP
     *LOSION')
      GO TO 50
62    WRITE(LLL,64)
64    FORMAT(' DAMAGE FACTOR 10- VESSEL PARTIALLY DESTROYED')
50    RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 -
C CONVERTED TO PC BY: DAN GAHLINGER
C
C -GOTME -
C TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
      SUBROUTINE GOTME(IVL,IT)
      INTEGER POS
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MMIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80),LLL,II1,INA,IVI,II7,II8,NNN
      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 /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 /TOM/ITOM
      IVV=IVL
      IC=0
      JJ=0
      L=IBPSC(IT)+4
      IS=(IT+1)/2
      IF(IVV.EQ.0)GO TO 110
      IF(IVV.EQ.1)GO TO 112
113   IVVV=IVV-1
1130  DO 121 J=1,33
      IF(MA(IT,J).LT.IVVV)GO TO 111
121   CONTINUE
      IVV=IVV+1
      IF(IVV.LE.10)GO TO 113
      DFLCT(IT)=-1.
      GO TO 232
111   JJ=JJ+IFIX(FLOAT(IVVV+1)*1.6+0.5)
      IF(IVVV.EQ.IC)GO TO 200
      GO TO (114,120,1200,1212,130,137,145,155,156),IVVV
110   WRITE(LLL,42)
42    FORMAT(' NO DAMAGE')
      GO TO 232
112   WRITE(LLL,242)
242   FORMAT(' DAMAGE FACTOR 1- VERY LITTLE DAMAGE SUSTAINED')
      GO TO 232
114   CALL RANDO(J,1,3)
      IF(J.NE.3)GO TO 119
      WRITE(LLL,4005)
4005  FORMAT(' DAMAGE FACTOR 2- TOILETS HAVE BACKED UP IN')
      GO TO 200
119   WRITE(LLL,117)
117   FORMAT(' DAMAGE FACTOR 2- MINOR DAMAGE TO')
      GO TO 200
120   WRITE(LLL,1210)
1210  FORMAT('DAMAGE FACTOR 3- MINOR STRUCTURAL DAMAGE- THERE IS A DENT
     * IN')
      GO TO 200
1200  CALL RANDO(J,1,3)
      GO TO (123,50,4004),J
50    WRITE(LLL,51)
51    FORMAT(' DAMAGE FACTOR 4- POWER FAILURE IN')
      GO TO 200
4004  WRITE(LLL,4007)
4007  FORMAT(' DAMAGE FACTOR 4- THERE IS A BURST WATER MAIN IN')
      GO TO 200
123   WRITE(LLL,124)
124   FORMAT(' DAMAGE FACTOR 4- MODERATE DAMAGE TO')
      GO TO 200
1212  WRITE(LLL,1213)
1213  FORMAT(' DAMAGE FACTOR 5- LIFE SUPPORT SYSTEM BREAKDOWN IN')
      GO TO 200
130   WRITE(LLL,136)
136   FORMAT(' DAMAGE FACTOR 6- HEAVY DAMAGE TO')
      GO TO 200
137   WRITE(LLL,143)
143   FORMAT(' DAMAGE FACTOR 7- A FIRE HAS BROKEN OUT IN')
      GO TO 200
145   WRITE(LLL,153)
153   FORMAT(' DAMAGE FACTOR 8- AN EXPLOSION HAS OCCURRED IN')
      GO TO 200
155   WRITE(LLL,163)
163   FORMAT(' DAMAGE FACTOR 9- PARTIAL DESTRUCTION OF')
      GO TO 200
156   WRITE(LLL,173)
173   FORMAT(' DAMAGE FACTOR 10- DESTRUCTION OF')
200   CALL RANDO(IV,1,33)
      IF(MA(IT,IV).GE.IVVV)GO TO 200
      IF(MA(IT,IV).NE.0)GO TO 701
      MANUM(IT)=MANUM(IT)+1
701   IF(IVVV.NE.9)GO TO 70
      IF(IV.LT.29)GO TO 70
      IF(IV.GT.30)GO TO 70
      MANUM(IT)=MANUM(IT)-1
70    MA(IT,IV)=IVVV
      CALL FORBIN(IS,IV,L,' ')
      IC=IVVV
      CALL RANDO(IV,1,15)
      IVVV=IVVV*IV/9
      IF(IVVV.EQ.0)IVVV=1
      IVV=IVVV+1
      IF(IV.LE.9)GO TO 1130
402   IF(IT.EQ.1)CALL QUARK(L)
4015  IF(MA(IT,14).GT.K(IT,2))PHASR(IT)=PHASR(IT)-MA(IT,14)*300.
      IF(PHASR(IT).LT.0)PHASR(IT)=0.
      K(IT,2)=MA(IT,14)
      TWARP(IT)=TWARP(IT)-FLOAT(MA(IT,29)-K(IT,4))/2.
      TWARP(IT)=TWARP(IT)-FLOAT(MA(IT,30)-K(IT,5))/2.
      K(IT,4)=MA(IT,29)
      K(IT,5)=MA(IT,30)
      IF(MA(IT,28).LT.4.OR.K(IT,6).GE.4)GO TO 657
      TWARP(IT)=TWARP(IT)-1.
      K(IT,6)=MA(IT,28)
657   IF(TWARP(IT).LT.0)TWARP(IT)=0
      J=0
      IF(IS.EQ.2)GO TO 100
      IF(IT.NE.1)GO TO 5000
      IF(K(1,10).GT.4.OR.MA(1,7).LE.4)GO TO 5000
      J=1
      WRITE(LLL,4010)
4010  FORMAT(' DR. MCCOY IS DEAD JIM')
C ORIGINALLY IT SAID DR. MCCOY HAS CROAKED - CHANGED NOV. 15/1999
5000  IPHOT(IT)=IPHOT(IT)-IFIX(FLOAT(IPHOT(IT))*FLOAT(MA(IT,3)-K(IT,14))
     */12.)
      K(IT,14)=MA(IT,3)
      IF(MA(IT,8).LT.4.OR.K(IT,3).EQ.1)GO TO 215
      K(IT,3)=1
      WRITE(LLL,4009)
4009  FORMAT(' CPU SYSTEM 2 HAS BEEN INITIALIZED AND IS TAKING OVER'/
     *' THE FUNCTIONS OF THE DISABLED CPU UNIT')
215   IF(MA(IT,23).GT.K(IT,1))DFLCT(IT)=DFLCT(IT)-(MA(IT,23)-K(IT,1))*3
      K(IT,1)=MA(IT,23)
      JJ=JJ+2*POS(MA(IT,4)-K(IT,7))+3*POS(MA(IT,5)-K(IT,8))
     *+22*POS(MA(IT,6)-K(IT,9))+12*POS(MA(IT,7)-K(IT,10))
     *+3*POS(MA(IT,21)-K(IT,11))+3*POS(MA(IT,22)-K(IT,12))
     *+2*POS(MA(IT,23)-K(IT,13))
      K(IT, 7)=MA(IT, 4)
      K(IT, 8)=MA(IT, 5)
      K(IT, 9)=MA(IT, 6)
      K(IT,10)=MA(IT, 7)
      K(IT,11)=MA(IT,21)
      K(IT,12)=MA(IT,22)
      K(IT,13)=MA(IT,23)
      NOMAP(IT)=15-MA(IT,33)
      GO TO 500
100   IPHOT(IT)=IPHOT(IT)-FLOAT(IPHOT(IT)*(MA(IT,29)+MA(IT,30)-
     *K(IT,14)))/24
      K(IT,14)=MA(IT,29)+MA(IT,30)
      IF(MA(IT,5).LT.4.OR.K(IT,3).EQ.1)GO TO 101
      K(IT,3)=1
      WRITE(LLL,4007)
101   IF(MA(IT,13).GT.K(IT,1))DFLCT(IT)=DFLCT(IT)-(MA(IT,13)-K(IT,1))*3
      K(IT,1)=MA(IT,13)
      JJ=JJ+I8*POS(MA(IT,8)-K(IT,7))+POS(MA(IT,10)-K(IT,8))+
     *2*POS(MA(IT,11)-K(IT,9))+4*POS(MA(IT,17)-K(IT,10))+
     *11*POS(MA(IT,19)-K(IT,11))+4*POS(MA(IT,21)-K(IT,12))+
     *9*POS(MA(IT,22)-K(IT,13))
      K(IT, 7)=MA(IT, 8)
      K(IT, 8)=MA(IT,10)
      K(IT, 9)=MA(IT,11)
      K(IT,10)=MA(IT,17)
      K(IT,11)=MA(IT,19)
      K(IT,12)=MA(IT,21)
      K(IT,13)=MA(IT,22)
      NOMAP(IT)=15-MA(IT,13)
500   CALL RANDO(IV,J,JJ)
      CALL RANDO(N,J,JJ)
      CALL RANDO(IC,0,JJ)
      CALL RANDO(IVVV,0,JJ)
      IF(N.GT.IV)IV=N
      NDEAD(IT)=NDEAD(IT)-IV
      IF(NDEAD(IT).GT.0)GO TO 5001
      IV=IV+NDEAD(IT)
      NDEAD(IT)=0
      IC=0
      IVVV=0
5001  IGO(IT)=0
      WRITE(LLL,406)IV,IC,IVVV
406   FORMAT('CASUALTIES-',I5,' KILLED',5X,I5,' WOUNDED',5X,I5,
     *' MAIMED')
232   CONTINUE
      RETURN
      END

C -- DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - FORBIN
C TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      SUBROUTINE FORBIN(J,I,L,NA)
      CHARACTER*1 NA
C ABOVE LINE SUGGESTED BY S.LIONEL (COMPAQ)
      COMMON /W/IDEX(2,33,20)
      K=16
2     IF(IDEX(J,I,K).NE.'    ')GO TO 1
      K=K-1
      GO TO 2
1     WRITE(LLL,3)NA,(IDEX(J,I,M),M=1,K)
3     FORMAT(A1,1X,20A4)
      RETURN
      END

C - DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C CONVERTED TO PC BY: DAN GAHLINGER
C
C - QUARK -
C   TYPE-EXACT CHECK 04/25/2000 BY: D.G.
C
      SUBROUTINE QUARK(L1)
      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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      CALL RANDO(IV,1,35)
      IF(IV.GT.7)GO TO 4015
      GO TO(40152,4016,4018,40150,40151,40209,4021),IV
40152 WRITE(LLL,4017)
4017  FORMAT(' MR. SPOCK IS MAKING OBSCENE GESTURES BEHIND YOUR BACK')
      GO TO 4015
4016  WRITE(LLL,4019)
4019  FORMAT('SCOTTY IS MAKING RATHER DUBIOUS COMMENTS ABOUT
     *YOUR ANCESTRY')
      GO TO 4015
4018  WRITE(LLL,4020)
4020  FORMAT(' A MESSAGE HAS BEEN RECEIVED OVER SVB-SPACE RADIO. MESSAGE
     * AS FOLLOWS-'//25X,'--DIE FEDERATION PIGS--'//)
      GO TO 4015
40150 WRITE(LLL,40200)
40200 FORMAT(' THE ENTERPRISE''S PRIZE TURNIP HAS RUPTURED'/' DESTROYING
     * THE CREW''S MORALE')
      GO TO 4015
40151 IF(II(2)+ICHOS(1).EQ.0)GO TO 4015
      CALL RANDO(IVVV,1,30000)
      AJUST=63.*FLOAT(IVVV)
      WRITE(LLL,40201)AJUST
40201 FORMAT(' THE KLINGONS HAVE JUST BEAMED ABOARD ',F8.0,' TRIBBLES')
      GO TO 4015
40209 IF(K(1,10).GT.4)GO TO 4015
      WRITE(LLL,4022)
4022  FORMAT(' DR. MCCOY IS PASSING OUT THE CYANIDE TABLETS')
      GO TO 4015
4021  IF(K(1,10).GT.4)GO TO 4015
C NEXT LINE WAS L, BUT TO NORMALIZE, CHANGED CALL TO QUARK TO L1 THUS CHANGED
      LL1=L1+1
      WRITE(LL1,4023)
4023  FORMAT(' SPOCK HAS MADE DR. MCCOY AN HONOURARY VULCAN',/,' BY
     *STUFFING HIS EARS IN A PENCIL SHARPENER')
4015  RETURN
      END

C - DONALD ECCLESTONE SUBPROGRAM FOR T R E K 7 --
C
C CONVERTED TO PC BY: DAN GAHLINGER
C - POS -
C   TYPE-EXACT CHECK 04/24/2000 BY: D.G.
C
      INTEGER FUNCTION POS(I)
      POS=I
      IF(POS.LT.0)POS=0
      RETURN
      END


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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,3337)
3337  FORMAT(' TEMPERATURES ARE BOYOND CRITICAL POINT')
      IF(ITEMP(IT).GE.7500)WRITE(LLL,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(LLL,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II8=I8+1
      WRITE(II8,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
      II1=I+1
      WRITE(II1,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(LLL,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(LLL,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(LLL,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(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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(LLL,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(LLL,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),LLL,II1,INA,IVI,II7,II8,NNN
      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
