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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(6)
      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(L,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(L,508)TWARP(IT)
508   FORMAT(' ENTER WARP FACTOR - BETWEEN 0 AND ',F10.7,': '$)
      READ(L,*,ERR=6580)WARP(IT)
24    FORMAT(F)
151   IF(WARP(IT).GT.TWARP(IT).OR.WARP(IT).LT.0)GO TO 6581
      WRITE(L,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(L)
      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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(6)
      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/MAP(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(L,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(L,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(L,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(L,673)
673   FORMAT(' TORPEDO/DISRUPTOR COMMAND CANCELLED')
      GO TO 6711
674   IBORD=0
      WRITE(L,675)
675   FORMAT(' BOARD COMMAND CANCELLED')
      GO TO 6711
6700  IPULL(IT)=0
      WRITE(L,6702)
6702  FORMAT(' YANK COMMAND CANCELLED')
      GO TO 6711
6701  IPUSH(IT)=0
      WRITE(L,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,I3,JS,ISHAK,NOSTOP
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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
      IF(IPHOT(IT).GT.0)GO TO 71
75    WRITE(L,72)(IBOLT(I,JS),I=1,4)
72    FORMAT(' THERE ARE NO ',4A4,' LEFT')
      TYPE 22244
22244 FORMAT(//' CHEKOV 22244 before 71 - first write'//)
      RETURN
71    DISTP=ANGLE(IT)
      TYPE 22255
22255 FORMAT(//' CHEKOV 22255 AFTER 71 IPHOT >= 0'//)
      RANG(IT)=10.
      IF(A.EQ.0)GO TO 7100
      ANGLE(IT)=A
      GO TO 71
7100  TYPE 22211
22211 FORMAT(//' CHEKOV 22211 at 7100 JS=',I4//)
      WRITE(L,3)IPHOT(IT),(IBOLT(I,JS),I=1,4)
73    FORMAT(' YOU HAVE',I3,1X,4A4/' ENTER ANGLE: ')
      TYPE 22266
22266 FORMAT(//' CHEKOV 22266 AFTER 73'//)
77    READ(L,*,ERR=130)ANGLE(IT)
24    FORMAT(F)
711   IPHOT(IT)=IPHOT(IT)-1
      TYPE 22233
22233 FORMAT(//' CHEKOV 22233 after 711'//)
      LOCKT(IT)=1
      WRITE(L,3)
3     FORMAT(' WEAPON LOCKED ON TARGET')
      RETURN
130   ANGLE(IT)=DISTP
      CALL OOPS(L)
      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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /M/MAP(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(L,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=MAP(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(L,53)
53    FORMAT(' ENTER DISTANCE YOU WISH TO PUSH OBJECT: '$)
      READ(L,*,ERR=250)PUSH(IT)
29    FORMAT(F)
63    WRITE(L,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(L,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(L,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(L,37)
37    FORMAT(' DEFLECTORS LOCKED ON TARGET')
      RETURN
264   WRITE(L,265)
265   FORMAT(' NOT ENOUGH ENERGY TO LOCK BEAM')
      GO TO 23
250   CALL ILLDAT
23    CALL OOPS(L)
      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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      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(L,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 LEN(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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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/MAP(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(L,121)NOMAP(IT)
121   FORMAT(' ENTER RADIUS OF MAP - BETWEEN 1 AND',I3,': '$)
      READ(L,*,ERR=5170)DISTP
24    FORMAT(F)
51702 N=DISTP
      IF(N.GE.1.AND.N.LE.NOMAP(IT))GO TO 550
51701 CALL OOPS(L)
      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   LEN(J-IV+1)=J-(J/10)*10
      WRITE(L,5175)(LEN(J),J=1,IVV-IV+1)
5175  FORMAT(3X,31I1)
      DO 5173 J=1,I8-I7+1
      IV1=I8-J+1
      JTK=IV1/10
      ENCODE(1,5174,NB)JTK
      JTK=IV1-JTK*10
      ENCODE(1,5174,NA)JTK
5174  FORMAT(I1)
      JTK=0
      DO 100 I=IV,IVV
      JTK=JTK+1
      NC=MAP(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(L,5172)IV1,(LEN2(I),I=1,JTK),NB,NA
5172  FORMAT(I3,33A1)
      WRITE(L,5175)(LEN(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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25),
     *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES
      COMMON /U/LAUNCH,NUMOUT,NUME(2)
      IF(NUMOUT.EQ.0)RETURN
      WRITE(L,302)
302   FORMAT(' EAGLES-'/)
      I7=0
      DO 301 I=1,LAUNCH
      IF(IGLER(I).EQ.0)GO TO 301
      I7=I7+1
      WRITE(L,303)I,IGLEC(I),IGLER(I)
303   FORMAT('+',I2,' - (',I2,',',I2,')  '$)
      IF(I7.NE.5)GO TO 301
      I7=0
      WRITE(L,304)
304   FORMAT(/' '$)
301   CONTINUE
      WRITE(L,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,NGSTOP
      COMMON /C/L,A,B,I,NA,IV,T7,IB,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25),
     *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES
      COMMON /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(L,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(L,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(L,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(L,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(L,757)(IENM2(I,2),I=1,4)
757   FORMAT(1X,4A4,7X,'UNKNOWN  UNKNOWN')
      GO TO 760
763   WRITE(L,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(L,755)(IENM2(I,6),I=1,4),DFLCK(6),IKLNC(6),IKLNR(6)
      GO TO 760
91    WRITE(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      WRITE(L,3)
3     FORMAT(' HERE ARE YOUR COMMANDS TO THE SHIP. '/' TYPE IN THE WORD O
     *R 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(L,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(L,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(L,800)
800   FORMAT('  IF YOU WISH TO ENTER THE COORDINATES (60,60) OR (1, 1),
     *'/' TYPE 6060 OR 0101.')
      WRITE(L,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(L,33)
33    FORMAT(' IF WE ENTER AN ION STORM WE WILL RECEIVE DAMAGE'/' AND O
     *UR SPEED WILL BE CUT IN HALF')
      WRITE(L,38)
38    FORMAT(' ENEMY STRATEGY AND STRENGTH-')
34    WRITE(L,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 AND USE THEIR WEB',
     */' GORNS RETREAT UNTIL THEIR SHIELDS ARE GREATER THAN YOURS BY 25',
     */' ORIONS MAKE CLOSE PASSES AT US AND FIRE WHEN THEY"RE CLOSEST'/
     *' THE DOOMSDAY MACHINE EATS STARS, MINES, AND US'/' MOONBASE ALPHA
     * LAUNCHES 5 WAVES OF 5 EAGLES')
36    WRITE(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,MES(80)
      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/MAP(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(L,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(L,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
      WRITE(I7,9)(INAME(IQ0,IT),IQ0=1,3)
9     FORMAT(' WE ARE RECEIVING A DISTRESS SIGNAL FROM THE ',3A4)
8     CONTINUE
      WRITE(L,10)
10    FORMAT(' DISTRESS SIGNAL TRANSMITTED')
      RETURN
6     WRITE(L,11)
11    FORMAT(' ENTER PHASER ENERGY YOU WISH TO EXPEND JAMMING SUBSPACE C
     *OMMUNICATIONS')
      READ(L,*,ERR=200)DISTP
12    FORMAT(F)
      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(L,13)DISTP
13    FORMAT(' THIS WILL BOOST SUBSPACE INTERFERENCE LEVELS BY A MAXIMUM
     * OF ',F6.1,' TIMES NORMAL')
      RETURN
4     WRITE(L,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(L)
      RETURN
16    IF(I.NE.IT)GO TO 18
      WRITE(L,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),IENT
     *C(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(L,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(L,24)HARLAN
24    FORMAT(' INTERFERENCE LEVEL NOW=',F6.2,'% -ENTER CODE (O(HAILING F
     *REQ) TO 8,STOP): '$)
      READ(L,2,ERR=200)MIN
2     FORMAT(I1)
      PHASR(IT)=PHASR(IT)-DISTP
      IF(MIN.LT.0.OR.MIN.GT.8)GO TO 20
      IF(MIN.EQ.0.OR.IS.EQ.(IBPSC(I)+1)/2)GO TO 38
      WRITE(L,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(L,26)
26    FORMAT(' ENTER YOUR MESSAGE (80 CHARACTERS MAX.)')
      I8=L
      GO TO 27
25    I8=IBPSC(I)+4
      WRITE(I8,28)(INAME(IQ0,IT),IQ0=1,3)
28    FORMAT( ' ENTER ANY MESSAGE YOU HAVE FOR THE ',3A4,' (80 CHARACTERS
     * 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)
      DECODE(5,320,JTK)MES(ISTAT)
320   FORMAT(A5)
32    CONTINUE
      IF(I7.EQ.2)GO TO 33
      I8=IBPSC(I)+4
      WRITE(I8,34)(INAME(IQ0,IT),IQ0=1,3),MES
34    FORMAT(' MESSAGE FROM THE ',3A4/1X,80A1)
      GO TO 35
33    WRITE(L,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(MIN.EQ.0)GO TO 37
      IF(IS.EQ.(IBPSC(JTK)+1)/2)GO TO 37
      IF(KODE(IS,MIN).EQ.1)GO TO 37
      CALL RANDO(IV,1,10)
      IF(IV.GT.1)GO TO 36
      KODE(IS,MIN)=1
37    I8=IT
      ISTAT=I
      IF(I7.EQ.1)GO TO 370
      I8=I
      ISTAT=IT
370   N=IBPSC(JTK)+4
      WRITE(N,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(6)
      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(L,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(L,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(I)
      WRITE(L,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(L)
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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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(L,903)
903   FORMAT(' PHASERS RE-LOCKED ON TARGET')
      GO TO 901
902   WRITE(L,904)
904   FORMAT('-NOT ENOUGH ENERGY TO RE-LOCK PHASERS')
      GO TO 901
908   WRITE(L,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(L,910)
910   FORMAT(' DISRUPIOR BOLTS RE-LOCKED ON TARGET')
      RETURN
900   WRITE(L,906)
906   FORMAT(' PHOTON TORPEDOES RE-LOCKED ON TARGET')
      RETURN
905   IF(JS.EQ.1)GO TO 911
      WRITE(L,912)
912   FORMAT(' NO DISRUPTOR BOLTS LEFT')
      RETURN
911   WRITE(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25),
     *IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES
      COMMON /M/MAP(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(L,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(L,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,F)
      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(L,634)
634   FORMAT(' TYPE IN AMOUNT YOU WISH TO TRANSFER: '$)
660   READ(L,24,ERR=6461)ZAP
24    FORMAT(F)
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(L)
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(L,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 /DIS
     *RUPTOR BANKS (T) DEFLECTOR SHIELDS(D))'/' (PW,WP,WD,DW,PD,DP,TD'/)
38    WRITE(L,39)
39    FORMAT(' 1 WARP = 10 DEFLECTOR SHIELD UNITS = 1000 PHASER UNITS'/
     *' 1 PHOTON TORPEDO = 6 DEFLECTOR SHIELD UNITS')
      WRITE(L,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(L,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(L,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(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
7     WRITE(L,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(I)
      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(L,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(F)
      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(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
      COMMON /I/IONK(8),ISPOK(8),ION(4),ISPOT(4)
      COMMON /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/MAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      COMMON /N/INAME(2,4),IENM2(4,8),ISIDE(2,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(L,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
      WRITE(N,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(L,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=MAP(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(L,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)
      MAP(IKLNR(I),IKLNC(I))=IENM1(I)
710   WRITE(L,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(L,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
      WRITE(IV,715)
715   FORMAT(' REQUEST FOR ENEMY VETOED')
700   CONTINUE
      NANU=1
      RETURN
720   WRITE(L,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,ISHAKNOSTOP
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
      COMMON /M/MAP(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(L,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=MAP(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(L,50)
50    FORMAT(' ENTER DISTANCE YOU WISH TO PULL OBJECT: '$)
      READ(L,29,ERR=250)PULL(IT)
60    PULL(IT)=PULL(IT)/10.
      WRITE(L,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(L,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(F)
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(L,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 T
     *HE 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 EM
     *PTY 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(L,42)
42    FORMAT(' TRACTORS LOCKED ON TARGET')
      RETURN
264   WRITE(L,265)
265   FORMAT(' NOT ENOUGH ENERGY TO LOCK BEAM')
      GO TO 23
250   CALL ILLDAT
23    CALL OOPS(L)
      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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      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(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
     *NOMOV(4)
      DATA PONFAR/'HE','WE','WA','PH','DO','DI'/
      WRITE(L,1)
1     FORMAT(' SPOCK HERE, CAPTAIN.....')
2     WRITE(L,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(L,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(L,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(L,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 I
     *T 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(L,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(L,27)
27    FORMAT(' PROB. THAT A PHASER BEAM WILL BOUNCE OFF THE DOOMSDAY MAC
     *HINE=66. 66666667%'/' 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(L,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(L,31)DISTP,AJUST
31    FORMAT(' DISTANCE=',F/' PROBABILITY OF A PHASER HIT AT THIS DISTAN
     *CE=',F8.4,'%')
      GO TO 2
6     WRITE(L,7)
7     FORMAT(' YOUR REQUEST FAILS TO FALL WITHIN LOGICAL PARAMETERS')
200   WRITE(L,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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISLIRR(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(L,401)
401   FORMAT(' PHASERS INOPERATIVE - MAIN COIL BURNOUT UNDER REPAIR')
      GO TO 12
400   IF(PHASR(IT).GT.0)GO TO 21
      WRITE(L,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(L,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(F)
      IF(ZAP(IT).LE.0.OR.ZAP(IT).GT.PHASR(IT)+0.0001)GO TO 1200
391   WRITE(L,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(L,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(L)
      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),IPHDB(2),IONB(2),IGOB(2),IFIB(2)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      COMMON /K/IWHO(8),DIST(8),KILLZ,KILLR,KILLD,KILLG,IGOCO(13)
      COMMON /M/MAP(60,60),IBLK,IENM1(8),IEE(4),IGLE,IM(4),III,ISTAR
      COMMON /N/INAME(2,4),IENM2(4,8),ISIDE(2,2),IBASE(2)
      COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
      COMMON /T/ICHOE(4),ICHOS(6),ICHOB(2)
      WRITE(L,1)
1     FORMAT(' ENTER SHIP LETTER (''*'' FOR STARBASE): '$)
      READ(L,2)NA
2     FORMAT(A1)
      IF(NA.NE.ISTAR)GO TO 100
      WRITE(L,3)
3     FORMAT(' ENTER STARBASE NUMBER: '$)
      READ(L,4,ERR=500)I7
4     FORMAT(I)
      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
      IF(J.EQ.0)GO TO 8
      WRITE(IV,9)ISIDE(1,I),ISIDE(2,I),I7
9     FORMAT(1X,2A5,' STARBASE',I3, ' HAS CEASED FIRING')
      GO TO 7
8     WRITE(IV,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
      IF(J.EQ.0)GO TO 108
      WRITE(IV,109)(IENM2(N,I),N=1,4)
109   FORMAT(1X,4A4,' RETURNING TO NEAREST ALLIED VESSEL')
      GO TO 107
108   WRITE(IV,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(L)
      RETURN
      END
