-
Notifications
You must be signed in to change notification settings - Fork 1
/
trekg.for
2152 lines (1526 loc) · 52.1 KB
/
trekg.for
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
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
CV MOVE M-O SHIP
CV
CV ==========================
CV INPUT TRANSFER PARAMETERS
CV ==========================
CV MOVE - REQUESTED SHIP MOVEMENT FLAG
CV ITEMP - ENGINE TEMPERATURE
CV WARP - REQUESTED SHIP WARP
CV MA - DECK STATUS
CV MANUM - NUMBER OF DAMAGED DECKS
CV TWARP - AVAILABLE WARP POWER
CV ICHOE - M-O SHIP
CV INAME - VESSEL NAME
CV K - SPECIAL DAMAGE FACTOR "K"
CV
CV ===================
CV INTERNAL VARIABLES
CV ===================
CV I7 - RANDOM ENGINE TEMPERATURE FACTOR
CV I7 - RANDOM ENGINE EXPLOSION PROBABILITIY FACTOR
CV I7 - M-O SHIP INDEX
CV I8 - SUMMED UP DAMAGE FACTOR
CV I8 - M-O SHIP FORTRAN UNIT NUMBER
CV J - INDEX OF HIT ENGINE
CV IVV - M-O SHIP DAMAGE FACTOR
CV
CV ==================
CV OUTPUT PARAMETERS
CV ==================
CV ITEMP - ENGINE TEMPERATURE
CV TWARP - AVAILABLE WARP POWER
CV K - SPECIAL DAMAGE FACTOR "K"
CV
CV ======
CV STEPS
CV ======
CV 1. ENGINE TEMPERATURE MANAGEMENT
CV 2. POTENTIAL NACELLE EXPLOSION
CV FINISH
CV
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,MIN,ISTAT,JTK,KOEING,
*IGNORE,IO,IGOL(80)
COMMON /E/PHASR(4),TWARP(4),IPHOT(4),NDEAD(4),ISURR(4)
COMMON /F/WARP(4),ITROW(4),ITCCL(4)
COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
COMMON /O/MA(4,33),K(4,14),NOMAP(4),MANUM(4),HIVEL(4,2),ITEMP(4),
*NOMOV(4)
COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
COMMON /TOM/ITOM
CV ==============================
CV ENGINE TEMPERATURE MANAGEMENT
CV ==============================
CV IF MOVE > 0: CALCULATE & INCREASE ENGINE TEMPERATURE
IF(MOVE.GT.0)GO TO 3331
CV ELSE (MOVE <= 0):
CV IF ENGINE TEMPERATURE = 4000: RETURN (DO NOTHING)
IF(ITEMP(IT).EQ.4000)GO TO 546
CV OTHERWISE COOL ENGINE DOWN BY 600,
CV BUT NOT BELOW 4000 (SEE LABEL 3332)
ITEMP(IT)=ITEMP(IT)-600
GO TO 3332
CV GENERATE RANDOM ENGINE TEMPERATURE FACTOR I7 (75-125)
3331 CALL RANDO(I7,75,125)
CV IF WARP > 6: JUMP TO 3333
IF(WARP(IT).GT.6.)GO TO 3333
CV CALCULATE NEW ENGINE TEMPERATURE IF WARP <= 6
CV NEW ENGINE TEMPERATURE BASED ON WARP AND ENGINE TEMPERATURE FACTOR I7
ITEMP(IT)=ITEMP(IT)+(WARP(IT)-6.)*I7
GO TO 3332
CV CALCULATE NEW ENGINE TEMPERATURE IF WARP > 6
CV DEPENDING ON STATUS OF DECK IDS 29&30
3333 ITEMP(IT)=ITEMP(IT)+(WARP(IT)-6.)*FLOAT(I7)*(FLOAT(MA(IT,29))/9.+
*1.)*(FLOAT(MA(IT,30))/9.+1.)
CV SET ENGINE MINIMUM TEMPERATURE = 4000
3332 IF(ITEMP(IT).LT.4000)ITEMP(IT)=4000
CV PRINT ENGINE TEMPERATURE
WRITE(L,3334)ITEMP(IT)
3334 FORMAT(' ENGINE TEMP. = ',I5,' DEGREES')
CV ENGINE TEMPERATURE < 5500: O.K.
IF(ITEMP(IT).LT.5500)GO TO 546
CV 5500 <= ENGINE TEMPERATURE < 6200: NEAR CRITICAL
IF(ITEMP(IT).LT.6200)GO TO 3336
CV 6200 <= ENGINE TEMPERATURE < 7500: BEYOND CRITICAL POINT
IF(ITEMP(IT).GT.6200)GO TO 3335
CV WRITE MESSAGE "ENGINES OVERHEATING"
3336 WRITE(L,3339)
3339 FORMAT(' ENGINES OVERHEATING -TEMPERATURES ARE NEAR CRITICAL')
GO TO 546
CV WRITE MESSAGE "TEMPERATURES ARE BEYOND CRITICAL POINT"
3335 WRITE(L,3337)
3337 FORMAT(' TEMPERATURES ARE BEYOND CRITICAL POINT')
CV ENGINE TEMPERATURE >= 7500; EXPLOSION IMMINENT
IF(ITEMP(IT).GE.7500)WRITE(L,3338)
3338 FORMAT(' EXPLOSION IMMINENT!!!')
CV ============================
CV POTENTIAL NACELLE EXPLOSION
CV ============================
CV GENERATE RANDOM PROBABILITIY FACTOR I7 FOR ENGINE EXPLOSION
CALL RANDO(I7,1,100)
CV IF ENGINE EXPLOSION PROBABILITIY FACTOR I7 > (ITEMP(IT)-6200)/100:
CV RETURN (ENGINE SURVIVES)
IF(I7.GT.(ITEMP(IT)-6200)/100)GO TO 546
CV ELSE: ENGINE JETTISONED AND EXPLODED
CV CALCULATE FACTOR I8 FROM DAMAGES SO FAR
I8=MA(IT,29)+MA(IT,30)+1
CV CALCULATE RANDOM NEW DAMAGE FACTOR I7
CALL RANDO(I7,0,I8)
CV CALCULATE WHICH ENGINE IS HIT
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
CV REDUCE AVAILBLE WARP POWER, BUT NOT BELOW 0
TWARP(IT)=TWARP(IT)-4.5+K(IT,3+J)/2
IF(TWARP(IT).LT.0)TWARP(IT)=0
CV SET DAMAGE FACTOR K
K(IT,3+J)=9
CV WRITE MESSAGE "JETTISONNED ... EXPLODED"
WRITE(L,3340)J,J
3340 FORMAT(' ENGINEERING HERE SIR - MATTER AND ANTI-MATTER ARE NO WIT
*HIN RED-ZONE PROXIMITY'/' AUTOMATIC RELAYS CUTTING IN..... NACELLE
*',I2,' JETTISONNED'/' NACELLE',I2,' HAS EXPLODED - DAMAGE REPORT D
*UE TO PROXIMITY OF BLAST-')
DO 162 I7=1,4
IF(ICHOE(I7).EQ.0)GO TO 162
IF(I7.EQ.IT)GO TO 162
I8=I7+4
WRITE(I8,1630)(INAME(IQ0,IT),IQ0=1,3),J
1630 FORMAT(1X,3A4,' NACELLE',I2,' HAS EXPLODED - DAMAGE REPORT-')
162 CONTINUE
CV SET DAMAGE FACTOR
IVV=10
CV CALL DAMAGE TO M-O SHIP SUBROUTINE GRUP1
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
CV CALCULATION & ANNOUNCEMENT WHAT STARBASE NO # HAS ACHIEVED
CV ==========================
CV INPUT TRANSFER PARAMETERS
CV ==========================
CV IBPSS - STARBASE OWNER INDEX
CV IJ - STARBASE OWNER PARTY INDEX
CV DFLCB - STARBASE DEFLECTOR STRENGTH
CV DFLCT - M-O SHIP DEFLECTOR STRENGTH
CV DFLCK - C-O SHIP DEFLECTOR STRENGTH
CV IBASR - ROW POSITION OF STARBASE
CV IBASC - COL POSITION OF STARBASE
CV MIN - NEAREST VESSEL INDEX
CV DISTP - DISTANCE TO NEAREST VESSEL
CV ICHOE - M-O SHIP
CV ISIDE - OPPONENT SIDE NAME
CV IBASE - STARBASE INDEX
CV INAME - VESSEL NAME
CV
CV ===================
CV INTERNAL VARIABLES
CV ===================
CV I7 - STARBASE OWNER INDEX
CV I7 - DOOMSDAY BOUNCE OFF FACTOR
CV I7 - M-O SHIP INDEX
CV I8 - M-O SHIP FORTRAN UNIT NUMBER
CV IVV - RANDOM ATTACK FACTOR
CV
CV ==================
CV OUTPUT PARAMETERS
CV ==================
CV -- NONE --
CV
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,MIN,ISTAT,JTK,KOENIG,
*IGNORE,IO,IGOL(80)
COMMON /D/DFLCT(4),DFLCK(8),DFLCB(2)
COMMON /L/IENTR(4),IENTC(4),IKLNR(8),IKLNC(8),IGLER(25),IGLEC(25),
*IBASR(2),IBASC(2),LI2(4),LI2R(5),LI2C(5),IGO(4),MINES
COMMON /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
COMMON /R/IBPSC(4),IBPSB(8),IBPSS(2),IBPSE(25)
COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
COMMON /TOM/ITOM
CV I7 = OWNER SHIP OF STARBASE
I7=IBPSS(I)
CV IF STARBASE OWNER PARTY = 0 (NONE): OWNER = 0 (NONE)
IF(IJ(I7).EQ.0)I7=0
CV CALCULATE NEAREST VESSEL TO STARBASE
CALL PIKE(IBASR(I),IBASC(I),I7)
CV IF NO NEAREST VESSEL (MIN=0): RETURN
IF(MIN.EQ.0)GO TO 1
CV IF DISTANCE TO NEAREST VESSEL > 20: RETURN
IF(DISTP.GT.20.)GO TO 1
CV ELSE: DISTANCE TO NEAREST VESSEL <= 20:
CV REDUCE STARBASE DEFLECTOR STRENGTH BY 5.0 (WHY?)
DFLCB(I)=DFLCB(I)-5.0
CALCULATE RANDOM ATTACK FACTOR (IVV) IN RANGE 1 TO 100
CALL RANDO(IVV,1,100)
CV IF RANDOM ATTACK FACTOR (IVV) <= DISTANCE TO NEAREST VESSEL * 2.5:
CV RETURN
IF(IVV.LE.DISTP*2.5)GO TO 1
CV ELSE: RANDOM ATTACK FACTOR (IVV) > DISTANCE TO NEAREST VESSEL * 2.5
CV =======
CV EAGLES
CV =======
CV IF NEAREST VESSEL = EAGLE: 2
IF(MIN.GT.14)GO TO 2
CV ==========
CV M-O SHIPS
CV ==========
CV IF NEAREST VESSEL = NO M-O SHIP: S
IF(MIN.GT.4)GO TO 3
CV LOOP OVER ALL M-O SHIPS (I7)
DO 4 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 4
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE MESSAGE "<PARTY> STARBASE <NUMBER> HAS SCORED A HIT ON THE
CV <NEAREST VESSEL (M-O SHIP)> ..."
WRITE(I8,5)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),
*(INAME(IQ0,MIN),IQ0=1,3)
5 FORMAT(/1X,3A4,' STARBASE',I3,' HAS SCORED A HIT ON THE ',3A4,'-DA
*MAGE REPORT-')
CV NEXT M-O SHIP
4 CONTINUE
CV CALCULATE DAMAGES ON M-O SHIP CONSIDERING DEFLECTOR STRENGTH
CV WITH SEVERITY FACTOR "50"
CALL GRUP1(LIRPA(DFLCT(MIN),50),MIN)
CV RETURN
GO TO 1
CV ============================================
CV NEAREST VESSEL = NEITHER EAGLE NOR M-O SHIP
CV ============================================
CV IF NEAREST VESSEL = C-O SHIP: 6
3 IF(MIN.GT.6)GO TO 6
CV ==========================
CV NEAREST VESSEL = STARBASE
CV ==========================
MIN=MIN-4
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 7 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 7
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE "STARBASE <X> HIT STARBASE <Y>" MESSAGE TO M-O SHIP
WRITE(I8,8)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),
*(ISIDE(IQ0,MIN),IQ0=1,3),IBASE(MIN)
8 FORMAT(/1X,3A4,' STARBASE',I3,' HIT ',3A4,' STARBASE',I3,
*'-DAMAGE REPORT-')
CV NEXT M-O SHIP
7 CONTINUE
CV CALCULATE DAMAGES ON STARBASE CONSIDERING DEFLECTOR STRENGTH
CALL GRUP2(LIRPA(DFLCB(MIN)/3.,50),MIN)
CV RETURN
GO TO 1
CV ==============================
CV NEAREST VESSEL = ANY C-O SHIP
CV ==============================
6 MIN=MIN-6
CV IF NEAREST VESSEL IS NOT DOOMSDAY: 15
IF(MIN.NE.7)GO TO 15
CV ==========================
CV NEAREST VESSEL = DOOMSDAY
CV ==========================
CV CALCULATE RANDOM "DOOMSDAY BOUNCE OFF FACTOR" (I7) IN RANGE 1 TO 3
CALL RANDO(I7,1,3)
CV IF "BOUNCE OFF FACTOR" (I7) = 2 SKIP "BOUNCE OFF" (15)
IF(I7.EQ.2)GO TO 15
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 16 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 16
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE "STARBASE <NUMBER> PHASERS BOUNCED OFF DOOMSDAY MACHINE"
CV MESSAGE TO M-O SHIP
WRITE(I8,17)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
17 FORMAT(/1X,3A4,' STARBASE',I3,' PHASERS BOUNCED OFF DOOMSDAY
* MACHINE')
CV NEXT M-O SHIP
16 CONTINUE
CV RETURN
GO TO 1
CV ===============================================
CV NEAREST VESSEL = ANY C-O SHIP EXECEPT DOOMSDAY
CV ===============================================
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
15 DO 9 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 9
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE "STARBASE <NUMBER> HIT <SHIP NAME>" MESSAGE TO M-O SHIP
WRITE(I8,18)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),(IENM2(IV,MIN),IV=1,4)
18 FORMAT(/1X,3A4,' STARBASE',I3,' HIT ',4A4,'-DAMAGE REPORT-')
CV NEXT M-O SHIP
9 CONTINUE
CV CALCULATE DAMAGES ON C-O SHIP CONSIDERING DEFLECTOR STRENGTH
CALL GRUP3(LIRPA(DFLCK(MIN),50),MIN)
CV RETURN
GO TO 1
CV =======================
CV NEAREST VESSEL = EAGLE
CV =======================
2 MIN=MIN-14
CV INCREASE STARBASE DEFLECTOR STRENGTH BY 4.9 (WHY?)
DFLCB(I)=DFLCB(I)+4.9
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 10 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 10
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE "STARBASE <NUMBER> DESTROYED EAGLE <EAGLE NAME>" MESSAGE TO M-O SHIP
WRITE(I8,11)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I),MIN
11 FORMAT(/1X,3A4,' STARBASE',I3,' DESTROYED EAGLE',I3)
CV NEXT M-O SHIP
10 CONTINUE
CV DO EAGLE DESTRUCTION
CALL BOOM(MIN)
CV RETURN
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
CV CALCULATION & ANNOUNCEMENT OF ION STORM DAMAGE TO STARBASE
SUBROUTINE TALOS
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 /N/INAME(3,4),IENM2(4,8),ISIDE(3,2),IBASE(2)
COMMON /T/ICHOE(4),ICHOS(8),ICHOB(2)
COMMON /TOM/ITOM
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 13 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 13
CV CALCULATE M-O SHIP FORTRAN UNIT NUMBER
I8=I7+4
CV WRITE "ION STORM DAMAGE TO <PARTY> STARBASE <NUMBER>" MESSAGE TO M-O SHIP
WRITE(I8,14)(ISIDE(IQ0,I),IQ0=1,3),IBASE(I)
14 FORMAT(/' ION STORM DAMAGE TO ',3A4,' STARBASE',I3,' AS FOLLOWS-')
CV NEXT M-O SHIP
13 CONTINUE
CV CALCULATE RANDOM DAMAGE BASE NUMBER (IV) IN RANGE 1 TO 20
CALL RANDO(IV,1,20)
CV CALCULATE DAMAGE NUMBER (IVV) FROM DEFLECTOR STRENGTH
CV AND RANDOM DAMAGE BASE NUMBER
IVV=ALOG((101.-DFLCB(I)/3.)*IV)/0.700619195-3.
CV CALCULATE DAMAGES ON STARBASE OWNER PARTY I
CALL GRUP2(IVV,I)
CV NEXT M-O SHIP
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
CV CALCULATION & ANNOUNCEMENT WHAT AN C-O SHIP HAS ACHIEVED
SUBROUTINE ENEMY
LOGICAL BLISH
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 /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
CV ?
KOENIG=0
CV ?
JTK=0
CV LOOP OVER ALL C-O SHIPS (I)
1101 DO 1100 I=1,8
ISTAT=0
CV IF C-O SHIP = MOONBASE: SKIP EAGLE ACTIONS (DUNE)
IF(I.NE.8)GO TO 11010
CV MANAGE EAGLE ACTIONS
CALL DUNE
CV IF C-O SHIP NOT IN GAME: NEXT C-O SHIP
11010 IF(ICHOS(I).EQ.0)GO TO 1100
CV GO TO LABEL ACCORDING TO C-0 SHIP INDEX (I)
107 GO TO (1103,1104,1105,1106,1107,1109,1108,11090),I
CV 1 = KLINGONS
1103 CALL RANDO(IV,45,110)
GO TO 1109
CV 2 = ROMULANS
1104 CALL RANDO(IV,30,100)
GO TO 1109
CV 3 = THOLIANS
1105 CALL RANDO(IV,60,90)
GO TO 1109
CV 4 = GORNS
1106 CALL RANDO(IV,35,90)
GO TO 1109
CV 5 = ORIONS
1107 CALL RANDO(IV,50,100)
GO TO 1109
CV 7= DOOMSDAY
1108 CALL RANDO(IV,100,200)
GO TO 1109
CV 8 = MOONBASE
11090 IV=50
CV 6 = KZINTI
CV =========================================================================
CV DECIDE WHETHER TO ATTACK CURRENT NEAREST VESSEL OR LAST NEAREST VESSEL ?
CV =========================================================================
CV CALCULATE CURRENT NEAREST VESSEL TO C-O SHIP
1109 CALL PIKE(IKLNR(I),IKLNC(I),IBPSB(I))
CV IF NO NEAREST VESSEL: CHECK IF C-O IS KZINTI, NEXT C-O SHIP
IF(MIN.EQ.0)GO TO 232
CV IF DISTANCE LAST TURN >= CURRENT DISTANCE TO NEAREST VESSEL:
CV ATTACK CURRENT NEAREST VESSEL (3390)
IF(DIST(I).GE.DISTP)GO TO 3390
CV IF "LAST TURNS NEAREST VESSEL" IS ONE OF:
CV - NEAREST M-O SHIP: NOT IN GAME OR DESTRUCTED
CV - NO NEAREST STARBASE IN GAME
CV - NEAREST C-O SHIP: NOT IN GAME, NO CREW OR DESTRUCTED)
CV - NO NEAREST EAGLE IN GAME"
CV : ATTACK CURRENT NEAREST VESSEL (3390)
IF(MOLOCH(IWHO(I)))GO TO 3390
CV =======================================
CV SWITCH TO "ATTACK LAST NEAREST VESSEL"
CV =======================================
CV ELSE: DISTANCE TO NEAREST VESSEL = DISTANCE LAST TURN
DISTP=DIST(I)
CV SET "NEAREST VESSEL" TO "LAST TURNS NEAREST VESSEL"
MIN=IWHO(I)
CV SET NUMBER OF PARTICIPANTS IN GAME TO "6"
ISTAT=6
CV ===================================
CV ATTACK CURRENT/LAST NEAREST VESSEL
CV ===================================
CV ========
CV ROMULAN
CV ========
CV IF C-O SHIP IS NOT ROMULAN: SKIP ROMULAN SENSOR RANGE CALCULATION
3390 IF(I.NE.2)GO TO 378
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 380 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).NE.1)GO TO 380
CV IF DISTANCE BETWEEN M-O SHIP AND ROMULAN SHIP > 5: NEXT M-O SHIP
IF(DI(IENTR(I7),IENTC(I7),IKLNR(2),IKLNC(2)).GT.5.)GO TO 380
CV ELSE: DISTANCE BETWEEN M-O SHIP AND ROMULAN SHIP <= 5:
CV SET ROMULAN SHIP VISIBLE
INVIS(I7)=1
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP
I8=I7+4
CV WRITE MESSAGE "... NOW WITHIN SENSOR RANGE"
WRITE(I8,381)
381 FORMAT(' THE ROMULAN SHIP IS NOW WITHIN SENSOR RANGE')
CV SET ROMULAN STRATEGY (KILLR) TO "ATTACK"
KILLR=2
CV NECT M-O SHIP
380 CONTINUE
CV IF ROMULAN STRATEGY (KILLR) = 1 (NEUTRAL): 339
IF(KILLR.NE.1)GO TO 339
CV IF DISTP > 10: NEXT C-O SHIP (1100)
IF(DISTP.GT.10.)GO TO 1100
CV ELSE: DISTP <= 10: SET ROMULAN STRATEGY (KILLR) TO "ATTACK"
KILLR=2
GO TO 339
CV ========
CV THOLIAN
CV ========
CV IF C-O SHIP IS THOLIAN: THOLIA
378 IF(I.EQ.3)CALL THOLIA
CV =========
CV DOOMSDAY
CV =========
CV IF C-O SHIP IS NOT DOOMSDAY: 379
IF(I.NE.7)GO TO 379
CV ELSE C-O SHIP IS DOOMSDAY
CV IF ...: NEXT C-O SHIP
IF(KILLD.EQ.1.AND.DISTP.GT.7.)GO TO 1100
KILLD=1
GO TO 339
CV =======
CV KZINTI
CV =======
379 IF(I.NE.6)GO TO 339
CV IF DISTANCE TO NEAREST VESSEL > KILLZ (KZINTI KILL DISTANCE?)
CV AND KZINTI DEFLECTOR STRENGTH = 100: NEXT C-O SHIP
IF(DISTP.GT.KILLZ.AND.DFLCK(6).EQ.100.)GO TO 1100
CV ELSE: KZINTI SENSOR & STASIS FIELD
CALL KNUTH
CV =========================
CV OTHER C-O SHIPS: 1,4,5,8
CV =========================
CV IF NO NEAREST VESSEL: NEXT C-O SHIP
339 IF(MIN.EQ.0)GO TO 1100
CV IF DISTANCE TO NEAREST VESSEL > 25: NEXT C-O SHIP
IF(DISTP.GT.25.)GO TO 1100
CV =======
CV KZINTI
CV =======
IF(I.NE.6)GO TO 33900
CV IF SPECIAL KZINTI ACTION = TRUE: NEXT C-O SHIP
360 IF(BLISH(JTK))GO TO 1100
CV ELSE: SPECIAL KZINTI ACTION =
CV CALCULATE RANDOM DAMAGE FACTOR (IVV) IN RANGE 1 TO 100
33900 CALL RANDO(IVV,1,100)
CV IF RANDOM DAMAGE FACTOR IVV <= 3. * DISTANCE TO TARGET:
CV CHECK IF C-O IS KZINTI, NEXT C-O SHIP
IF(IVV.LE.DISTP*3.)GO TO 232
CV NEAREST VESSEL IS NOT M-O SHIP: 340
IF(MIN.GT.4)GO TO 340
CV SET MI TO NEAREST VESSEL INDEX
MI=MIN
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 341 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 341
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP (I8)
I8=I7+4
CV WRITE MESSAGE "<NAME OF C-O SHIP> HAS SCORED A HIT ON THE
CV <NEAREST VESSEL NAME>"
WRITE(I8,342)(IENM2(J,I),J=1,4),(INAME(IQ0,MI),IQ0=1,3)
342 FORMAT(/1X,4A4,' HAS SCORED A HIT ON THE ',3A4,'-DAMAGE REPORT-')
CV NEXT M-O SHIP
341 CONTINUE
CV CALCULATE M-O SHIP DAMAGE
CALL GRUP1(LIRPA(DFLCT(MI),IV),MI)
CV CHECK IF C-O IS KZINTI, NEXT C-O SHIP
GO TO 232
CV ==========
CV STARBASES
CV ==========
CV IF VESSEL INDEX > 6: 343
340 IF(MIN.GT.6)GO TO 343
MI=MIN-4
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 344 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 344
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP (I8)
I8=I7+4
CV WRITE MESSAGE "<NAME OF C-O SHIP> HAS HIT STARBASE <STARBASE NUMBER>"
WRITE(I8,330)(IENM2(J,I),J=1,4),(ISIDE(IQ0,MI),IQ0=1,3),IBASE(MI)
330 FORMAT(/1X,4A4,' HAS HIT ',3A4,' STARBASE',I3,'-DAMAGE REPORT-')
CV NEXT M-O SHIP
344 CONTINUE
CV CALCULATE STARBASE DAMAGE
CALL GRUP2(LIRPA(DFLCB(MI)/3.,IV),MI)
CV CHECK IF C-O IS KZINTI, NEXT C-O SHIP
GO TO 232
CV ==========
CV C-O SHIPS
CV ==========
343 IF(MIN.GT.14)GO TO 345
MI=MIN-6
CV ==================================
CV DOOMSDAY "BOUNCE OFF" CALCULATION
CV ==================================
CV IF NEAREST VESSEL IS NOT DOOMSDAY: SKIP "BOUNCE OFF" CALCULATION
IF(MI.NE.7)GO TO 3460
CV CALCULATE RANDOM "BOUNCE OFF" FACTOR I8 IN RANGE 1 TO 3
CALL RANDO(I8,1,3)
CV IF RANDOM "BOUNCE OFF" FACTOR = 2 (33% PROBABILITY):
CV FIRE HITS DOOMSDAY MACHINE
IF(I8.EQ.2)GO TO 3460
CV ELSE: FIRE BOUNCED OFF DOOMSDAY MACHINE
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 3461 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 3461
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP (I8)
I8=I7+4
CV WRITE MESSAGE "<C-O SHIP NAME> FIRE BOUNCED OFF DOOMSDAY MACHINE"
WRITE(I8,3462)(IENM2(J,I),J=1,4)
3462 FORMAT(/1X,4A4,' FIRE BOUNCED OFF DOOMSDAY MACHINE')
CV NEXT M-O SHIP
3461 CONTINUE
CV CHECK IF C-O IS KZINTI, NEXT C-O SHIP
GO TO 232
CV ========================
CV C-O SHIPS
CV ========================
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
3460 DO 346 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 346
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP (I8)
I8=I7+4
CV WRITE MESSAGE "<NAME OF C-O SHIP> HAS SCORED A HIT ON THE
CV <NEAREST VESSEL NAME>"
WRITE(I8,347)(IENM2(J,I),J=1,4),(IENM2(J,MI),J=1,4)
347 FORMAT(/1X,4A4,' HAS SCORED A HIT ON ',4A4,'-DAMAGE REPORT-')
CV NEXT M-O SHIP
346 CONTINUE
CV CALCULATE C-O SHIP DAMAGE
CALL GRUP3(LIRPA(DFLCK(MI),IV),MI)
CV CHECK IF C-O IS KZINTI, NEXT C-O SHIP
GO TO 232
CV =======
CV EAGLES
CV =======
345 MI=MIN-14
CV LOOP OVER M-O SHIPS (I7) FOR 1 TO 4
DO 348 I7=1,4
CV IF M-O SHIP NOT IN GAME: NEXT M-O SHIP
IF(ICHOE(I7).EQ.0)GO TO 348
CV CALCULATE FORTRAN UNIT NUMBER OF M-O SHIP (I8)
I8=I7+4
CV WRITE MESSAGE "<NAME OF C-O SHIP> DESTROYED EAGLE <EAGLE INDEX>"
WRITE(I8,349)(IENM2(J,I),J=1,4),MI
349 FORMAT(/1X,4A4,' DESTROYED EAGLE',I3)
CV NEXT M-O SHIP
348 CONTINUE
CV EAGLE DESTRUCTION
338 CALL BOOM(MI)
CV ====================
CV SPECIAL CASE KZINTI
CV ====================
CV IF C-O SHIP = KZINTI: 360
232 IF(I.EQ.6)GO TO 360
CV NEXT C-O SHIP
1100 CONTINUE
CV RETURN
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
CV NEAREST VESSEL STATUS EVALUATION
CV MOLOCH = TRUE IF:
CV - NEAREST M-O SHIP: NOT IN GAME OR DESTRUCTED
CV - NO NEAREST STARBASE IN GAME
CV - NEAREST C-O SHIP: NOT IN GAME, NO CREW OR DESTRUCTED)
CV - NO NEAREST EAGLE IN GAME
LOGICAL FUNCTION MOLOCH(MIN)
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)
CV SET DEFAULT RETURN VALUE TO "FALSE"
MOLOCH=.FALSE.
CV IF NEAREST VESSEL IS NOT AN M-O SHIP: CHECK OTHER VESSELS (1)
IF(MIN.GT.4)GO TO 1
CV ELSE: NEAREST VESSEL IS AN M-O SHIP
CV IF NEAREST M-O SHIP STATUS IS 1 OR 2 (IN GAME OR NO CREW):
CV RETURN WITH MOLOCH=.FALSE.
IF(ICHOE(MIN).NE.0.AND.ICHOE(MIN).NE.3)RETURN
CV ELSE NEAREST M-O SHIP STATUS IS 0 OR 3 (NOT IN GAME OR DESTRUCTED):
CV MOLOCH=.TRUE.
10 MOLOCH=.TRUE.
CV RETURN
RETURN
CV =========
CV STARBASE
CV =========
CV IF NEAREST VESSEL > 6: C-0 SHIP OR EAGLE
1 IF(MIN.GT.6)GO TO 2
CV IF STARBASE STATUS IS 1, 2, OR 3 (IS OR WAS IN GAME,
CV REGARDLESS OF CREW): RETURN
IF(ICHOB(MIN-4).NE.0)RETURN
CV ELSE: NO NEAREST STARBASE IN GAME: MOLOCH=.TRUE.
GO TO 10
CV =========
CV C-O SHIP
CV =========
CV IF NEAREST VESSEL = EAGLE: PROCESS EAGLE
2 IF(MIN.GT.14)GO TO 3
CV IF C-O SHIP IS IN GAME: RETURN
IF(ICHOS(MIN-6).EQ.1)RETURN
CV ELSE: NEAREST C-O SHIP = 0, 2, OR 3 (IS NOT IN GAME,
CV NO CREW OR DESTRUCTED): MOLOCH=.TRUE.
GO TO 10
CV ======
CV EAGLE
CV ======
CV IF EAGLE STATUS IS 1, 2, OR 3 (IS OR WAS IN GAME,
CV REGARDLESS OF CREW):
3 IF(IGLER(MIN-14).NE.0)RETURN
CV ELSE: NO NEAREST EAGLE IN GAME: MOLOCH=.TRUE.
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
CV EAGLES EFFECTS
SUBROUTINE DUNE
DIMENSION ISID(3,3)
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 /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',' '/