trekf.for

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

CV EAGLES DESTRUCTION

      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,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)
      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 /S/IBPOB(8),IBPOE(25)
      COMMON /U/LAUNCH,NUMOUT,NUME(2)

CV IF LAST PARTICIPANTS IN GAME: SKIP DELETE EAGLE FROM MAP
      IF(ISTAT.EQ.2)GO TO 2

CV DELETE EAGLE FROM MAP
      MAP(IGLER(J),IGLEC(J))=IBLK

CV SET EAGLE POSITION TO 0/0 (OUT OF GAME)
2     IGLER(J)=0
      IGLEC(J)=0

CV DECREMENT NUMBER OF ACTIVE EAGLES
      NUMOUT=NUMOUT-1

CV IF CREW ON EAGLE = 0: 1
      IF(IBPOE(J).EQ.0)GO TO 1

CV SET CREW ON EAGLE = 0
      IBPOE(J)=0

CV DECREMENT "II" OF PARTY OF EAGLE "J" (???)
      II(IBPSE(J))=II(IBPSE(J))-1

CV DECREMENT NUMBER OF EAGLES UNDER CONTROL OF PARTY OF EAGLE "J"
      NUME(IBPSE(J))=NUME(IBPSE(J))-1

CV SET OWNER OF EAGLE J TO 0 (NONE)
      IBPSE(J)=0

      RETURN

CV DECREMENT NUMBER OF C-O VESSELS IN GAME
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

CV LOGARITHMIC FUNCTION FOR EFFECT OF DEFLECTOR
CV AND SEVERITY FACTOR ON DAMAGE FACTOR
CV
CV AA   - DEFLECTOR STRENGTH (RANGE 0-100)
CV II   - SEVERITY FACTOR
CV

      INTEGER FUNCTION LIRPA(AA,II)
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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

CV DAMAGE MANAGEMENT FOR MANUALLY OPERATED SHIPS

      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)

CV LIMIT DAMAGE NUMBER TO RANGE 0-10
      IVA=IXIF(IVV)

CV MANAGE DAMAGE OF M-O SHIP MI WITH DAMAGE FACTOR IVA
      CALL GOTME(IVA,MI)

CV REDUCE DEFLECTOR STRENGTH OF DAMAGED M-O SHIP BY IVA*1.6
      DFLCT(MI)=DFLCT(MI)-FLOAT(IVA)*1.6

CV LOOP OVER M-O SHIPS I71 FOR 1 TO 4
      DO 350 I71=1,4

CV IF M-O SHIP OUT OF GAME: NEXT M-O SHIP
      IF(ICHOE(I71).EQ.0)GO TO 350

CV IF LOOPED M-O SHIP = DAMAGED M-O SHIP: NEXT M-O SHIP
      IF(I71.EQ.IBPSC(MI))GO TO 350

CV MANAGE DAMAGE OF M-O SHIP I71 WITH DAMAGE FACTOR IVA
      CALL GOTU(IVA,I71)

CV NEXT M-O SHIP
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

CV DAMAGE MANAGEMENT FOR STARBASES

      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

CV CALCULATE LIMITED STARBASE DAMAGE FACTOR (MAX=10)
      IVA=IXIF(IVV)

CV REDUCE STARBASE DEFLECTOR STRENGTH BY 1.6*LIMITED STARBASE DAMAGE FACTOR
      DFLCB(MI)=DFLCB(MI)-FLOAT(IVA)*1.6

CV LOOP OVER ALL M-O SHIPS
      DO 351 I71=1,4

CV IF M-O SHIP NOT IN GAME: SKIP STARBASE DAMAGE BY M-O SHIP
      IF(ICHOE(I71).EQ.0)GO TO 351

CV MANAGE STARBASE DAMAGE TO M-O SHIP
      CALL GOTU(IVA,I71)

CV NEXT M-O SHIP
351   CONTINUE

CV SET IGOB TO "1" ("STARBASE WAS HIT" FLAG)
      IGOB(MI)=1

CV CALCULATE RANDOM DEAD NUMBER (RANGE: IVA/2 - IVA*2)
      CALL RANDO(I8,IVA/2,IVA*2)

CV REDUCE STARBASE CREW BY DEAD NUMBER
      NDEAB(MI)=NDEAB(MI)-I8

CV LIMIT STARBASE CREW TO MINIMUM "0"
      IF(NDEAB(MI).LT.0)NDEAB(MI)=0

CV IF STARBASE DAMAGE NUMBER IVA > 2:
CV SET STARBASE "CEASE FIRE" FLAG TO ATTACK (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

CV DAMAGE MANAGEMENT FOR C-O SHIPS

      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

CV SET LIMITED C-O SHIP DAMAGE FACTOR (MAX=10)
CV TO UNLIMITED C-O SHIP DAMAGE FACTOR
      IVA=IVV

CV IF C-O SHIP HIT BY ION STORM:
CV LIMITED C-O SHIP DAMAGE FACTOR (MAX=10) =
CV UNLIMITED C-O SHIP DAMAGE FACTOR + 2
      IF(IONK(MI).EQ.1)IVA=IVV+2

CV LIMIT DAMAGE FACTOR TO RANGE 0-10
      IVA=IXIF(IVA)

CV REDUCE DEFLECTOR STRENGTH BY DAMAGE FACTOR*1.6
      DFLCK(MI)=DFLCK(MI)-FLOAT(IVA)*1.6

CV LOOP OVER M-O SHIPS FROM 1 TO 4
      DO 352 I71=1,4

CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
      IF(ICHOE(I71).EQ.0)GO TO 352

CV APPLY DAMAGE TO M-O SHIP ACCORDING TO LIMITED DAMAGE FACTOR
      CALL GOTU(IVA,I71)

CV NEXT M-O SHIP
352   CONTINUE

CV IF NUMBER OF STARBASE CREW = 0: 374
      IF(IBPOB(MI).EQ.0)GO TO 374

CV CALCULATE RANDOM DEAD CREW NUMBER (I8) IN RANGE IVA/2 TO IVA
      CALL RANDO(I8,IVA/2,IVA)

CV REDUCE NUMBER OF STARBASE CREW BY DEAD CREW NUMBER
      IBPOB(MI)=IBPOB(MI)-I8

CV IF ANY STARBASE CREW MEMBER ALIVE: 374
      IF(IBPOB(MI).GT.0)GO TO 374

CV ELSE: STARBASE CONTROL LOSS
      CALL TPAU(MI)

CV WEB INTERACTION
      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

CV C-0 SHIP CONTROL LOSS

      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,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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)

CV LOOP OVER M-O SHIPS IV FOR 1 TO 4
      DO 142 IV=1,4

CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
      IF(ICHOE(IV).EQ.0)GO TO 142


      I7=IV+4
      WRITE(I7,207)(IENM2(N,J),N=1,4)
207   FORMAT(' CONTROL OF THE ',4A4,' HAS BEEN LOST')

CV NEXT M-O SHIP
142   CONTINUE

CV DECREMENT "II" OF OWNER OF C-O SHIP "J"
      II(IBPSB(J))=II(IBPSB(J))-1

CV SET C-0 SHIP OWNER TO "0" (NO FOREIGN OWNER/NOT BOARDED)
      IBPSB(J)=0

CV DECREMENT NUMBER OF DOOMSDAY CREW ???
      IBPOB(7)=IBPOB(7)-1

      I3=I3+1

CV NUMBER OF CREW OF C-O SHIP "J" = 0
      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

CV WEB INTERACTION

      SUBROUTINE OXMYX
      COMMON /C/L,A,B,I,NA,IV,I7,I8,N,DISTP,AJUST,MIN,ISTAT,JTK,KOENIG,
     *IGNORE,IO,IGOL(80)
      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

CV DAMAGE MESSAGES FOR C-O SHIPS

      SUBROUTINE GOTU(IVV,I71)

CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
      L=I71+4

CV GOTO DAMAGE MESSAGES ACCORDING TO IVV+1
      GO TO (40,43,45,90,48,92,52,55,58,61,62),IVV+1

CV IVV=0
40    WRITE(L,42)
42    FORMAT(' NO DAMAGE')
      GO TO 50

CV IVV=1
43    WRITE(L,242)
242   FORMAT(' DAMAGE FACTOR 1- VERY LITTLE DAMAGE SUSTAINED')
      GO TO 50

CV IVV=2
45    WRITE(L,47)
47    FORMAT(' DAMAGE FACTOR 2- MINOR DAMAGE SUSTAINED')
      GO TO 50

CV IVV=3
90    WRITE(L,91)
91    FORMAT(' DAMAGE FACTOR 3- MINOR STRUCTURAL DAMAGE'/16X,'- THERE IS
     * A DENT IN THE VESSEL')
      GO TO 50

CV IVV=4
48    WRITE(L,51)
51    FORMAT(' DAMAGE FACTOR 4- VESSEL MODERATELY DAMAGED')
      GO TO 50

CV IVV=5
92    WRITE(L,93)
93    FORMAT(' DAMAGE FACTOR 5- LIFE SUPPORT SYSTEM BREAKDOWN IN PARTS
     * OF THE VESSEL')
      GO TO 50

CV IVV=6
52    WRITE(L,54)
54    FORMAT(' DAMAGE FACTOR 6- HEAVY INTERNAL DAMAGE TO VESSEL')
      GO TO 50

CV IVV=7
55    WRITE(L,57)
57    FORMAT(' DAMAGE FACTOR 7- HEAVY STRUCTURAL DAMAGE TO VESSEL')
      GO TO 50

CV IVV=8
58    WRITE(L,60)
60    FORMAT(' DAMAGE FACTOR 8- A NUMBER OF DECKS HAVE RUPTURED ON THE
     * VESSEL')
      GO TO 50

CV IVV=9
61    WRITE(L,63)
63    FORMAT(' DAMAGE FACTOR 9- THE VESSEL HAS BEEN ROCKED BY AN EXP
     *LOSION')
      GO TO 50

CV IVV=10
62    WRITE(L,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

CV DAMAGE FACTORS FOR M-O SHIP

      SUBROUTINE GOTME(IVL,IT)
      INTEGER POS
      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 /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

CV SET INTERNAL DAMAGE FACTOR IVV TO EXTERNAL DAMAGE FACTOR IVL
      IVV=IVL

CV SET NUMBER OF WOUNDED (IC) TO 0
      IC=0

CV SET MAXIMUM HUMAN DAMAGE FACTOR (JJ) TO 0
      JJ=0

CV SET FORTRAN UNIT NUMBER
      L=IBPSC(IT)+4

CV SET IS TO PARTY INDEX (1=FEDERATION / 2 = KLINGON) OF DAMAGED M-O SHIP
      IS=(IT+1)/2

CV IVV = 0: NO DAMAGE, MESSAGE & RETURN
      IF(IVV.EQ.0)GO TO 110

CV IVV = 1: VERY LITTLE DAMAGE, MESSAGE & RETURN
      IF(IVV.EQ.1)GO TO 112

CV SET INTERNAL DAMAGE FACTOR2 (IVVV) = INTERNAL DAMAGE FACTOR - 1
113   IVVV=IVV-1

CV LOOP OVER DECKS (J) FOR 1 TO 33
1130  DO 121 J=1,33

CV IF DAMAGE OF LOOPED DECK < INTERNAL DAMAGE FACTOR2 (IVVV): (111)
      IF(MA(IT,J).LT.IVVV)GO TO 111

CV NEXT DECK
121   CONTINUE


      IVV=IVV+1


      IF(IVV.LE.10)GO TO 113
      DFLCT(IT)=-1.


      GO TO 232

CV CALCULATE INCREASED MAXIMUM HUMAN DAMAGE FACTOR (JJ)
CV DEPENDING ON INTERNAL DAMAGE FACTOR2 (IVVV)
111   JJ=JJ+IFIX(FLOAT(IVVV+1)*1.6+0.5)

CV IF INTERNAL DAMAGE FACTOR2 (IVVV) = NUMBER OF WOUNDED (IC): 200
      IF(IVVV.EQ.IC)GO TO 200

CV GO TO LABELS ACCORDING TO INTERNAL DAMAGE FACTOR2 (IVVV)
      GO TO (114,120,1200,1212,130,137,145,155,156),IVVV

CV DAMAGE FACTOR 0
110   WRITE(L,42)
42    FORMAT(' NO DAMAGE')
      GO TO 232

CV DAMAGE FACTOR 1
112   WRITE(L,242)
242   FORMAT(' DAMAGE FACTOR 1- VERY LITTLE DAMAGE SUSTAINED')
      GO TO 232

CV DAMAGE FACTOR 2

CV CALCULATE RANDOM DAMAGE FACTOR J IN RANGE 1 TO 3
114   CALL RANDO(J,1,3)

CV IF RANDOM DAMAGE FACTOR J <> 3: MINOR DAMAGE
      IF(J.NE.3)GO TO 119

CV DAMAGE FACTOR 2 - TOILETS HAVE BACKED UP
      WRITE(L,4005)
4005  FORMAT(' DAMAGE FACTOR 2- TOILETS HAVE BACKED UP IN')
      GO TO 200

CV DAMAGE FACTOR 2 - MINOR DAMAGE
119   WRITE(L,117)
117   FORMAT(' DAMAGE FACTOR 2- MINOR DAMAGE TO')
      GO TO 200

CV DAMAGE FACTOR 3
120   WRITE(L,1210)
1210  FORMAT(' DAMAGE FACTOR 3- MINOR STRUCTURAL DAMAGE- THERE IS A DENT
     * IN')
      GO TO 200

CV DAMAGE FACTOR 4

CV CALCULATE RANDOM DAMAGE FACTOR J IN RANGE 1 TO 3
1200  CALL RANDO(J,1,3)

CV GO TO LABELS ACCORDING TO DAMAGE FACTOR J
      GO TO (123,50,4004),J

CV DAMAGE FACTOR 4-1 POWER FAILURE
50    WRITE(L,51)
51    FORMAT(' DAMAGE FACTOR 4- POWER FAILURE IN')
      GO TO 200

CV DAMAGE FACTOR 4-2 BURST WATER MAIN
4004  WRITE(L,4007)
4007  FORMAT(' DAMAGE FACTOR 4- THERE IS A BURST WATER MAIN IN')
      GO TO 200

CV DAMAGE FACTOR 4-3 MODERATE DAMAGE
123   WRITE(L,124)
124   FORMAT(' DAMAGE FACTOR 4- MODERATE DAMAGE TO')
      GO TO 200

CV DAMAGE FACTOR 5
1212  WRITE(L,1213)
1213  FORMAT(' DAMAGE FACTOR 5- LIFE SUPPORT SYSTEM BREAKDOWN IN')
      GO TO 200

CV DAMAGE FACTOR 6
130   WRITE(L,136)
136   FORMAT(' DAMAGE FACTOR 6- HEAVY DAMAGE TO')
      GO TO 200

CV DAMAGE FACTOR 7
137   WRITE(L,143)
143   FORMAT(' DAMAGE FACTOR 7- A FIRE HAS BROKEN OUT IN')
      GO TO 200

CV DAMAGE FACTOR 8
145   WRITE(L,153)
153   FORMAT(' DAMAGE FACTOR 8- AN EXPLOSION HAS OCCURRED IN')
      GO TO 200

CV DAMAGE FACTOR 9
155   WRITE(L,163)
163   FORMAT(' DAMAGE FACTOR 9- PARTIAL DESTRUCTION OF')
      GO TO 200

CV DAMAGE FACTOR 10
156   WRITE(L,173)
173   FORMAT(' DAMAGE FACTOR 10- DESTRUCTION OF')

CV =========================
CV CALCULATE AFFECTED DECKS
CV =========================

CV CALCULATE RANDOM DECK IV IN RANGE 1 TO 33
200   CALL RANDO(IV,1,33)

CV IF DECK STATUS >= INTERNAL DAMAGE FACTOR2 (IVVV):
CV RE-CALCULATE RANDOM DECK IV (200)
      IF(MA(IT,IV).GE.IVVV)GO TO 200

CV IF DECK STATUS OF DECK IV <> 0: 701
      IF(MA(IT,IV).NE.0)GO TO 701

CV ELSE: DECK STATUS = 0

CV INCREMENT NUMBER OF DAMAGED DECKS (MANUM)
      MANUM(IT)=MANUM(IT)+1

CV IF INTERNAL DAMAGE FACTOR2 (IVVV) <> 9: 70
701   IF(IVVV.NE.9)GO TO 70

CV IF DECK INDEX < 29: 70
      IF(IV.LT.29)GO TO 70

CV IF DECK INDEX > 30: 70
      IF(IV.GT.30)GO TO 70

CV ELSE: DECK = 29 OR 30: DECREMENT NUMBER OF DAMAGED DECKS (MANUM) (???)
      MANUM(IT)=MANUM(IT)-1

CV SET NEW DECK DAMAGE FACTOR OF DECK IV TO INTERNAL DAMAGE FACTOR2 (IVVV)
70    MA(IT,IV)=IVVV

CV WRITE DECK HIT MESSAGE FOR DECK IV OF PARTY IS
      CALL FORBIN(IS,IV,L,' ')

CV SET NUMBER OF WOUNDED (IC) TO INTERNAL DAMAGE FACTOR2 (IVVV)
      IC=IVVV

CV CALCULATE RANDOM DAMAGE CHANGE FACTOR IV IN RANGE 1 TO 15
      CALL RANDO(IV,1,15)

CV CALCULATE NEW INTERNAL DAMAGE FACTOR2 (IVVV)
CV USING RANDOM DAMAGE CHANGE FACTOR IV
      IVVV=IVVV*IV/9

CV IF INTERNAL DAMAGE FACTOR2 (IVVV) = 0:
CV SET INTERNAL DAMAGE FACTOR2 (IVVV) TO 1
      IF(IVVV.EQ.0)IVVV=1

CV SET INTERNAL DAMAGE FACTOR (IVV) TO INTERNAL DAMAGE FACTOR2 (IVVV) + 1
      IVV=IVVV+1

CV IF RANDOM DAMAGE CHANGE FACTOR IV <= 9: NEXT DECK (J)
      IF(IV.LE.9)GO TO 1130

CV ELSE: ADDITIONAL EFFECTS

CV IT=1 GIVE ADDITIONAL FUNNY NEGATIVE INCIDENTS
402   IF(IT.EQ.1)CALL QUARK(L)

CV IF DAMAGE FACTOR OF DECK 14 > SPECIAL DAMAGE FACTOR K OF DECK 2:
CV REDUCE PHASER ENERGY BY DAMAGE FACTOR OF DECK 14 * 300
4015  IF(MA(IT,14).GT.K(IT,2))PHASR(IT)=PHASR(IT)-MA(IT,14)*300.

CV SET PHASER ENERGY MINIMUM TO 0
      IF(PHASR(IT).LT.0)PHASR(IT)=0.

CV SET SPECIAL DAMAGE FACTOR K OF DECK 2 TO DAMAGE FACTOR OF DECK 14
      K(IT,2)=MA(IT,14)

CV REDUCE AVAILABLE WARP POWER BY (DAMAGE FACTOR OF DECK 29 -
CV SPECIAL DAMAGE FACTOR OF DECK 4) / 2
      TWARP(IT)=TWARP(IT)-FLOAT(MA(IT,29)-K(IT,4))/2.

CV REDUCE AVAILABLE WARP POWER BY (DAMAGE FACTOR OF DECK 30 -
CV SPECIAL DAMAGE FACTOR OF DECK 5) / 2
      TWARP(IT)=TWARP(IT)-FLOAT(MA(IT,30)-K(IT,5))/2.

CV SET SPECIAL DAMAGE FACTOR K OF DECK 4 TO DAMAGE FACTOR OF DECK 29
      K(IT,4)=MA(IT,29)

CV SET SPECIAL DAMAGE FACTOR K OF DECK 5 TO DAMAGE FACTOR OF DECK 30
      K(IT,5)=MA(IT,30)

CV IF DAMAGE FACTOR OF DECK 28 < 4 OR SPECIAL DAMAGE FACTOR
CV OF DECK 6 >= 4: 657
      IF(MA(IT,28).LT.4.OR.K(IT,6).GE.4)GO TO 657

CV ELSE: DECREMENT WARP POWER
      TWARP(IT)=TWARP(IT)-1.

CV SET SPECIAL DAMAGE FACTOR K OF DECK 6 TO DAMAGE FACTOR OF DECK 28
      K(IT,6)=MA(IT,28)

CV SET AVAILABLE WARP POWER MINIMUM TO 0
657   IF(TWARP(IT).LT.0)TWARP(IT)=0

CV SET DECK INDEX TO "0" ???
      J=0

CV IF PARTY IS KLINGON: 100
      IF(IS.EQ.2)GO TO 100

CV ELSE: PARTY IS FEDERATION

CV ======================
CV FEDERATION MANAGEMENT
CV ======================

CV IF SHIP IS NOT ENTERPRISE: 5000
      IF(IT.NE.1)GO TO 5000

CV ELSE: SHIP IS ENTERPRISE

CV IF SPECIAL DAMAGE FACTOR OF DECK 10 > 4
CV OR DAMAGE FACTOR OF DECK 7 <= 4: 5000
      IF(K(1,10).GT.4.OR.MA(1,7).LE.4)GO TO 5000

CV SET DECK INDEX TO "1" ???
      J=1

CV ANNOUNCE DEATH OF DR. MCCOY
      WRITE(L,4010)
4010  FORMAT(' DR. MCCOY IS DEAD JIM')
C ORIGINALLY IT SAID DR. MCCOY HAS CROAKED - CHANGED NOV. 15/1999

CV CALCULATE REDUCTION OF NUMBER OF TORPEDOES DEPENDING ON
CV DAMAGE FACTOR OF DECK 3 - SPECIAL DAMAGE FACTOR OF DECK 14
5000  IPHOT(IT)=IPHOT(IT)-IFIX(FLOAT(IPHOT(IT))*FLOAT(MA(IT,3)-K(IT,14))
     */12.)

CV SET SPECIAL DAMAGE FACTOR K OF DECK 14 TO DAMAGE FACTOR OF DECK 3
      K(IT,14)=MA(IT,3)

CV DAMAGE FACTOR OF DECK 8 < 4 OR SPECIAL DAMAGE FACTOR K OF DECK 3 = 1: 215
      IF(MA(IT,8).LT.4.OR.K(IT,3).EQ.1)GO TO 215

CV ELSE: SET SPECIAL DAMAGE FACTOR K OF DECK 3 TO 1
      K(IT,3)=1

CV MESSAGE CPU EXCHANGE
      WRITE(L,4009)
4009  FORMAT(' CPU SYSTEM 2 HAS BEEN INITIALIZED AND IS TAKING OVER'/
     *' THE FUNCTIONS OF THE DISABLED CPU UNIT')

CV IF DAMAGE FACTOR OF DECK 23 > SPECIAL DAMAGE FACTOR OF DECK 1:
CV REDUCE DEFLECTOR STRENGTH DEPENDING ON DAMAGE FACTOR OF DECK 23 -
CV SPECIAL DAMAGE FACTOR OF DECK 1
215   IF(MA(IT,23).GT.K(IT,1))DFLCT(IT)=DFLCT(IT)-(MA(IT,23)-K(IT,1))*3

CV SET SPECIAL DAMAGE FACTOR K OF DECK 1 TO DAMAGE FACTOR OF DECK 23
      K(IT,1)=MA(IT,23)

CV CALCULATE INCREASED MAXIMUM HUMAN DAMAGE FACTOR (JJ)
CV DEPENDING ON SEVERAL DAMAGE FACTORS MA & K
      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))

CV SET SEVERAL SPECIAL DAMAGE FACTORS K TO DAMAGE FACTORS MA
      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)

CV SET AVAILABLE MAP RADIUS (NOMAP) TO (15 - DAMAGE FACTOR OF DECK 33)
      NOMAP(IT)=15-MA(IT,33)
      GO TO 500

CV ==================
CV KLINGON MANAGMENT
CV ==================

CV REDUCE NUMBER OF AVAILABLE TORPEDOES
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(L,4007)

CV REDUCE AVAILABLE DEFLECTOR STRENGTH?
101   IF(MA(IT,13).GT.K(IT,1))DFLCT(IT)=DFLCT(IT)-(MA(IT,13)-K(IT,1))*3

CV DAMAGE FACTOR OF DECK 10-SECONDARY HULL-OBSERVATION LOUNGES (13)
      K(IT,1)=MA(IT,13)

CV CALCULATE INCREASED MAXIMUM HUMAN DAMAGE FACTOR (JJ) DEPENDING ON ...
      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))

CV DAMAGE FACTOR OF DECK 8-LIFE QUALITY FACILITIES/SHIPS
CV COMPUTER/RECREATION FACILITIES (8)
      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)

CV REDUCE AVAILABLE MAP RADIUS DEPENDENT ON DECK 13 DAMAGE
      NOMAP(IT)=15-MA(IT,13)

CV ======================================
CV CALCULATE CASUALTIES FOR BOTH PARTIES
CV ======================================

CV CALCULATE RANDOM NUMBER OF KILLED (IV) IN RANGE J (1)
CV TO MAXIMUM HUMAN DAMAGE FACTOR (JJ)
500   CALL RANDO(IV,J,JJ)

CV CALCULATE RANDOM NUMBER OF KILLED2 (N) IN RANGE J (1) TO
CV MAXIMUM HUMAN DAMAGE FACTOR (JJ)
      CALL RANDO(N,J,JJ)

CV CALCULATE RANDOM NUMBER OF WOUNDED (IC) IN RANGE 0 TO
CV MAXIMUM HUMAN DAMAGE FACTOR (JJ)
      CALL RANDO(IC,0,JJ)

CV CALCULATE RANDOM NUMBER OF MAIMED (IVVV) IN RANGE 0 TO
CV MAXIMUM HUMAN DAMAGE FACTOR (JJ)
      CALL RANDO(IVVV,0,JJ)

CV IF KILLED2 > KILLED: KILLED = KILLED2 (???)
      IF(N.GT.IV)IV=N

CV REDUCE CREW BY KILLED MEMBERS
      NDEAD(IT)=NDEAD(IT)-IV

CV IF THERE ARE SURVIVORS: REPORT CASUALTIES
      IF(NDEAD(IT).GT.0)GO TO 5001

CV ELSE: THERE ARE NO SURVIVORS, ALL ARE KILLED (!)

CV SET NUMBER OF KILLED TO NUMBER OF KILLED + NUMBER OF SURVIVORS (???)
      IV=IV+NDEAD(IT)

CV SET NUMBER OF SURVIVORS TO 0
      NDEAD(IT)=0

CV SET NUMBER OF WOUNDED TO 0
      IC=0

CV SET NUMBER OF MAIMED TO 0
      IVVV=0

CV SET MOVEBILTY OF M-O SHIP TO 0
5001  IGO(IT)=0

      WRITE(L,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

CV WRITE SHIP DECKS HIT

      SUBROUTINE FORBIN(J,I,L,NA)
      COMMON /W/IDEX(2,33,20)


      K=16
2     IF(IDEX(J,I,K).NE.'    ')GO TO 1
      K=K-1
      GO TO 2

CV WRITE "+" / " " (NA), (PARTY,LINE,K)
1     WRITE(L,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

CV ADDITIONAL FUNNY NEGATIVE INCIDENTS
CV "L1" IN COMMON BLOCK ON PURPOSE !!!

      SUBROUTINE QUARK(L)
      COMMON /A/IT,IS,II(2),IJ(2),I3,JS,ISHAK,NOSTOP
      COMMON /C/L1,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 /T/ICHOE(4),ICHOS(8),ICHOB(2)
      COMMON /TOM/ITOM

CV CALCULATE RANDOM NEGATIVE INCIDENTS FACTOR IV IN RANGE 1 TO 35
      CALL RANDO(IV,1,35)

CV 28/35 (80%) PROBABILITY OF NO NEGATIVE INCIDENT
      IF(IV.GT.7)GO TO 4015

CV 7/35 (20%) PROBABILITY OF A NEGATIVE INCIDENT
      GO TO(40152,4016,4018,40150,40151,40209,4021),IV

CV OBSCENE GESTURES (IV=1)
40152 WRITE(L,4017)
4017  FORMAT(' MR. SPOCK IS MAKING OBSCENE GESTURES BEHIND YOUR BACK')
      GO TO 4015

CV DUBIOUS COMMENTS (IV=2)
4016  WRITE(L,4019)
4019  FORMAT(' SCOTTY IS MAKING RATHER DUBIOUS COMMENTS ABOUT
     * YOUR ANCESTRY')
      GO TO 4015

CV DIE FEDERATION PIGS (IV=3)
4018  WRITE(L,4020)
4020  FORMAT(' A MESSAGE HAS BEEN RECEIVED OVER SUB-SPACE RADIO. MESSAGE
     * AS FOLLOWS-'//25X,'--DIE FEDERATION PIGS--'//)
      GO TO 4015

CV PRIZE TURNIP RUPTURE (IV=4)
40150 WRITE(L,40200)
40200 FORMAT(' THE ENTERPRISE''S PRIZE TURNIP HAS RUPTURED'/' DESTROYING
     * THE CREW''S MORALE')
      GO TO 4015

CV TRIBBLES PLAGUE (IV=5)

CV IF NEITHER C-O NOR M-O KLINGON VESSEL: 4015
40151 IF(II(2)+ICHOS(1).EQ.0)GO TO 4015

CV CALCULATE LARGE RANDOM NUMBER OF TRIBBLES
      CALL RANDO(IVVV,1,30000)
      AJUST=63.*FLOAT(IVVV)
      WRITE(L,40201)AJUST
40201 FORMAT(' THE KLINGONS HAVE JUST BEAMED ABOARD ',F8.0,' TRIBBLES')
      GO TO 4015

CV CYANIDE TABLETS (IV=6)

CV IF SPECIAL DAMAGE FACTOR (K) OF DECK 10 > 4: 4015
40209 IF(K(1,10).GT.4)GO TO 4015
      WRITE(L,4022)
4022  FORMAT(' DR. MCCOY IS PASSING OUT THE CYANIDE TABLETS')
      GO TO 4015

CV HONOURARY VULCAN (IV=7)

CV IF SPECIAL DAMAGER FACTOR (K) OF DECK 10 > 4: 4015
4021  IF(K(1,10).GT.4)GO TO 4015
      WRITE(L,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

CV MAP NEGATIVE VALUES TO "0"

      INTEGER FUNCTION POS(I)
      POS=I
      IF(POS.LT.0)POS=0
      RETURN
      END