home *** CD-ROM | disk | FTP | other *** search
- SUBROUTINE KLNGN 2062
-
- c include 'tcommon.for'
- %include tcommon.for
-
- DATA GETHRU/.8/,SKFCTR/1./ 2088
- DATA WFR,WFRF,WST,WGH,WB,WNE,WDE,WT/5.,4.,4.,3.,2.,7.,8.,4./ 2089
- DATA POWER/4./ 2090
- DATA SSS1 /9./,sss2/-9./
- sss1=9.**17.
- sss2=-9.**17.
- 2600 IF(KLNGNS.EQ.0)GO TO 2700 2091
- C ...LOOP ON KLINGON ACTIVITIES. 2092
- DO 2680 J=1,KLNGNS 2093
- IF(XKL(J,1).EQ.0.)GO TO 2680 2094
- C ...CHECK IF UNDER E CONTROL 2095
- J1=0 2096
- J2=0 2097
- IF(ICNTL(J+1).NE.1)GO TO 26100 2098
- IF(XKL(J,3).NE.XKL(J,5))J1=1 2099
- IF(XKL(J,4).NE.XKL(J,6))J2=1 2100
- GO TO 2610 2101
- C ...KLINGON MOVEMENT DETERMINATION ROUTINE. 2102
- C ...XVEC WILL BE X COMPONENT OF NEW BEARING 2103
- C ...YVEC WILL BE Y COMPONENT OF NEW BEARING 2104
- C ...ZVEC WILL BE AMOUNT OF VELOCITY REDUCTION FROM MAX (VMXKL) 2105
- 26100 XK=XKL(J,1) 2106
- YK=XKL(J,2) 2107
- XVEC=0. 2108
- YVEC=0. 2109
- ZVEC=0. 2110
- C ...AVOID OTHER KLINGONS. 2111
- IF(KLNGNS.LE.1)GO TO 4050 2112
- DO 4000 K=1,KLNGNS 2113
- IF(K.EQ.J)GO TO 4000 2114
- IF(XKL(K,1).EQ.0.)GO TO 4000 2115
- VPX=XK-XKL(K,1) 2116
- VPY=YK-XKL(K,2) 2117
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2118
- DIST=ABS(DIST) 2119
- W=WFR 2120
- C ...BETTER TO COLLIDE WITH CAPTURED ONES IF NECESSARY. 2121
- IF(ITRMEN(K+1).NE.0)W=WFRF 2122
- XVEC=XVEC+VPX/DIST*W 2123
- YVEC=YVEC+VPY/DIST*W 2124
- ZVEC=ZVEC+SKFCTR/DIST 2125
- 4000 CONTINUE 2126
- C ...AVOID ROMULANS. 2127
- 4050 IF(NROM.EQ.0)GO TO 4150 2128
- DO 4100 K=1,NROM 2129
- IF(XROM(K,1).EQ.0.)GO TO 4100 2130
- VPX=XK-XROM(K,1) 2131
- VPY=YK-XROM(K,2) 2132
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2133
- DIST=ABS(DIST) 2134
- W=WFR 2135
- IF(ITRMEN(K+10).NE.0)W=WFRF 2136
- XVEC=XVEC+VPX/DIST*W 2137
- YVEC=YVEC+VPY/DIST*W 2138
- ZVEC=ZVEC+SKFCTR/DIST 2139
- 4100 CONTINUE 2140
- C ...AVOID STARS. 2141
- 4150 IF(NSTARS.EQ.0)GO TO 4250 2142
- DO 4200 K=1,NSTARS 2143
- IF(STARS(K,1).EQ.0.)GO TO 4200 2144
- VPX=XK-STARS(K,1) 2145
- VPY=YK-STARS(K,2) 2146
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2147
- DIST=ABS(DIST) 2148
- W=WST 2149
- XVEC=XVEC+VPX/DIST*W 2150
- YVEC=YVEC+VPY/DIST*W 2151
- ZVEC=ZVEC+SKFCTR/DIST 2152
- 4200 CONTINUE 2153
- C ...AVOID GHOSTSHIPS. 2154
- 4250 IF(IGH.EQ.0)GO TO 4300 2155
- VPX=XK-GHOST(1) 2156
- VPY=YK-GHOST(2) 2157
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2158
- DIST=ABS(DIST) 2159
- W=WGH 2160
- XVEC=XVEC+VPX/DIST*W 2161
- YVEC=YVEC+VPY/DIST*W 2162
- ZVEC=ZVEC+SKFCTR/DIST 2163
- C ...AVOID STARBASES. 2164
- 4300 IF(IBASE.EQ.0)GO TO 4350 2165
- VPX=XK-BASE(1) 2166
- VPY=YK-BASE(2) 2167
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2168
- DIST=ABS(DIST) 2169
- W=WB 2170
- XVEC=XVEC+VPX/DIST*W 2171
- YVEC=YVEC+VPY/DIST*W 2172
- ZVEC=ZVEC+SKFCTR/DIST 2173
- C ...STAY CLEAR OF EDGES UNLESS ESCAPING. 2174
- 4350 W=WNE 2175
- IF(XKL(J,7).GE.THITR*XKLHIT.OR.NKL/LEFTK.GE.7)W=-WDE 2176
- VPX=SIGN(AMIN1(10.5-XK,XK-.5),5.5-XK) 2177
- VPY=SIGN(AMIN1(10.5-YK,YK-.5),5.5-YK) 2178
- DIST=ABS(VPX)**POWER 2179
- DIST=ABS(DIST) 2180
- IF(DIST.LE..1)DIST=.1 2181
- XVEC=XVEC+VPX/DIST*W 2182
- DIST=ABS(VPY)**POWER 2183
- IF(DIST.LT..1)DIST=.1 2184
- YVEC=YVEC+VPY/DIST*W 2185
- C ...SLOW DOWN FOR EDGES UNLESS ESCAPING. 2186
- IF(XKL(J,7).LT.THITR)ZVEC=ZVEC+SKFCTR/DIST 2187
- C ...NEW SPEED REDUCTION DEPENDENT ON HOW MANY NEARBY OBJECTS TO AVO2188
- C D. 2189
- XKL(J,5)=AMAX1(.05,VMXKL-ZVEC) 2190
- C ...AVOID TORPEDOS. 2191
- IF(NTORPS.EQ.0.OR.LEVEL.EQ.1)GO TO 4550 2192
- DO 4500 K=1,NTORPS 2193
- C ...SELECT ONLY ENEMY TORPS TO AVOID. 2194
- IF(TORPS(K,1).EQ.0..OR.TORPS(K,4).GE.0..AND.TORPS(K,4).LT.360.)GO 2195
- 1TO 4500 2196
- CALL GETBRG(DELTA,XK,TORPS(K,1),YK,TORPS(K,2),VPX,VPY) 2197
- DELV=TORPS(K,4) 2198
- IF(DELV.LT.0.)DELV=DELV+360. 2199
- IF(DELV.GE.360.)DELV=DELV-360. 2200
- VPX=DELTA+90. 2201
- IF(VPX.GE.360.)VPX=VPX-360. 2202
- VPY=DELTA-90. 2203
- IF(VPY.LT.0.)VPY=VPY+360. 2204
- C ...SELECT ONLY THOSE ENEMY TORPS HEADED THIS WAY. 2205
- IF(DELV.LE.VPX.OR.DELV.GE.VPY)GO TO 4500 2206
- VPX=COSD(DELV) 2207
- VPY=SIND(DELV) 2208
- C ...CALCULATE PERPENDICULAR DISTANCE TO TORPEDO PATH. 2209
- c$$$ modified to get aroung microsoft bug
- S=sss1
- IF(VPY.LT.0.)S=ss2 2211
- IF(ABS(VPY).GT.1./SS1)S=VPX/VPY 2212
- IF(S.LT.0.)GO TO 4510 2213
- IF(S.LT.1./SS1)S=1./SS1 2214
- GO TO 4520 2215
- 4510 IF(S.GT.-1./SS1)S=-1./SS1 2216
- 4520 C1=TORPS(K,2)-S*TORPS(K,1) 2217
- C2=YK+XK/S 2218
- VPX=(C2-C1)/(S+1./S) 2219
- VPY=S*VPX+C1 2220
- VPX=XK-VPX 2221
- VPY=YK-VPY 2222
- C ...MOVEMENT WILL BE AT RIGHT ANGLES AWAY FROM TORP PATH. 2223
- DIST=ABS(VPX)**POWER+ABS(VPY)**POWER 2224
- XVEC=XVEC+VPX/DIST*WT 2225
- YVEC=YVEC+VPY/DIST*WT 2226
- 4500 CONTINUE 2227
- 4550 VPY=0. 2228
- C ...THIS WILL BE THE OPTIMUM BEARING TO AVOID MISHAP. 2229
- CALL GETBRG(XKL(J,6),VPY,XVEC,VPY,YVEC,XADD,YADD) 2230
- IF(ABS(XKL(J,6)-XKL(J,4)).LE.DGKL.OR.ABS(360.-ABS(XKL(J,6)- 2231
- 1XKL(J,4))).LE.DGKL)XKL(J,5)=AMIN1(VMXKL,XKL(J,5)*2.) 2232
- 2610 CALL OMOVE(XKL(J,1),XKL(J,2),XKL(J,3),XKL(J,4),XKL(J,5),XKL(J,6) 2233
- 1 ,DSPKL,DGKL) 2234
- IF(J1.EQ.1.AND.XKL(J,3).EQ.XKL(J,5))WRITE(6,26101)J,XKL(J,3) 2235
- 26101 FORMAT(' K',I1,' DESIRED SPEED OF ',F5.3,' ATTAINED') 2236
- IF(J2.EQ.1.AND.XKL(J,4).EQ.XKL(J,6))WRITE(6,26102)J,XKL(J,4) 2237
- 26102 FORMAT(' K',I1,' DESIRED BEARING OF ',F4.0,' ATTAINED') 2238
- C ...CHECK IF LEAVING QUADRANT 2239
- CALL KLQ(J,IR) 2240
- IF(IR.GE.1)GO TO 2680 2241
- C ...K FIRING AREA. 2242
- IF(XKL(J,8).GT.NTSTPS.OR.XKL(J,8).EQ.0.)GO TO 2680 2243
- C ...CHECK IF UNDER E CONTROL. 2244
- IF(ICNTL(J+1).EQ.1)GO TO 2800 2245
- IF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 2680 2246
- C ...CALCULATE HIT ON E 2247
- 2620 IF(IDOCK.EQ.2)GO TO 2680 2248
- CALL GETBRG(VSX,XKL(J,1),XQE,XKL(J,2),YQE,VPX,VPY) 2249
- X=VPX*VPX+VPY*VPY 2250
- VSX=AMAX1(ABS(COSD(VSX)),ABS(SIND(VSX)))**2 2251
- VSY=VSX*SQRT(X) 2252
- VSY=VSY*(XKLHIT-XKL(J,7))/XKLHIT 2253
- VSY=VSY*XKFPE*DISTPK/X/SHLDF 2254
- IF(LEVEL.EQ.1)GO TO 2630 2255
- C ...MASKED? 2256
- CALL MASKEF(XQE,YQE,XKL(J,1),XKL(J,2),VPY) 2257
- VSY=VSY-VPY*VSY*GETHRU 2258
- C ...CALCULATE EFFECT AND RESET FIRING 2259
- 2630 XKL(J,8)=NTSTPS+1.+RAN(IZZ)*XKFPST 2260
- WRITE(6,2173)LETR(11),LETR(2),LETR(3),J,XKL(J,1),XKL(J,2) 2261
- 2173 FORMAT(1X,A1,' HIT ON ',A1,' FROM ',A1,I1,' AT ',F4.1,',',F4.1) 2262
- CALL HITONE(VSY) 2263
- GO TO 2680 2264
- C ...K UNDER E CONTROL FIRING PHASERS. 2265
- 2800 XKL(J,8)=0. 2266
- WRITE(6,26103)J 2267
- 26103 FORMAT(' K',I1,' FIRING PHASERS') 2268
- IF(LEVEL.EQ.1)GO TO 2811 2269
- 2811 IF(KLNGNS.LE.1)GO TO 2320 2270
- C ...CALCULTE HITS ON OTHER KLINGONS. 2271
- DO 2310 K=1,KLNGNS 2272
- IF(XKL(K,1).EQ.0.)GO TO 2310 2273
- IF(K.EQ.J)GO TO 2310 2274
- IF(ICNTL(K+1).EQ.1)GO TO 2310 2275
- CALL GETBRG(VSX,XKL(J,1),XKL(K,1),XKL(J,2),XKL(K,2),VPX,VPY) 2276
- X=VPX*VPX+VPY*VPY 2277
- VSX=AMAX1(ABS(COSD(VSX)),ABS(SIND(VSX)))**2 2278
- VSY=VSX*SQRT(X) 2279
- VSY=VSY*(XKLHIT-XKL(J,7))/XKLHIT 2280
- VSY=VSY*XKFPE*DISTPK/X 2281
- IF(LEVEL.EQ.1)GO TO 2170 2282
- CALL MASKEF(XKL(K,1),XKL(K,2),XKL(J,1),XKL(J,2),VPY) 2283
- VSY=VSY-VPY*VSY*GETHRU 2284
- 2170 WRITE(6,2174)VSY,LETR(3),K,XKL(K,1),XKL(K,2) 2285
- 2174 FORMAT(1X,F8.2,' UNIT HIT ON ',A1,I1,' AT ',F4.1,',',F4.1) 2286
- XKL(K,7)=XKL(K,7)+VSY 2287
- IF(XKL(K,7).LT.XKLHIT)GO TO 2305 2288
- 2366 CALL DLETE(3,K) 2289
- GO TO 2310 2290
- 2305 CONTINUE 2291
- C ...TROOP AND/OR CREW REDUCTIONS DUE TO P HIT. 2292
- IF(ITRMEN(K+1).EQ.0)GO TO 2356 2293
- IX=RAN(IZZ)*2.5*SQRT(VSY) 2294
- IF(IX.GT.ITRMEN(K+1))IX=ITRMEN(K+1) 2295
- ITKL(K)=ITKL(K)+IX 2296
- ITRMEN(K+1)=ITRMEN(K+1)-IX 2297
- 2356 IX=RAN(IZZ)*SQRT(VSY)*2.5 2298
- XKL(K,9)=XKL(K,9)-IX 2299
- IF(XKL(K,9).GT.0.)GO TO 2309 2300
- IF(ITRMEN(K+1).LE.0)GO TO 2366 2301
- 2309 JTKL(K)=JTKL(K)+IX 2302
- 2310 CONTINUE 2303
- 2320 IF(NROM.EQ.0)GO TO 2340 2304
- C ...CALCULATE HIT ON ROMULANS. 2305
- DO 2330 K=1,NROM 2306
- IF(XROM(K,1).EQ.0.)GO TO 2330 2307
- IF(ICNTL(K+10).EQ.1)GO TO 2330 2308
- CALL GETBRG(VSX,XKL(J,1),XROM(K,1),XKL(J,2),XROM(K,2),VPX,VPY) 2309
- X=VPX*VPX+VPY*VPY 2310
- VSX=AMAX1(ABS(COSD(VSX)),ABS(SIND(VSX)))**2 2311
- VSY=VSX*SQRT(X) 2312
- VSY=VSY*(XKLHIT-XKL(J,7))/XKLHIT 2313
- VSY=VSY*XKFPE*DISTPK/X 2314
- IF(LEVEL.EQ.1)GO TO 23705 2315
- CALL MASKEF(XROM(K,1),XROM(K,2),XKL(J,1),XKL(J,2),VPY) 2316
- VSY=VSY-VPY*VSY*GETHRU 2317
- 23705 WRITE(6,2174)VSY,LETR(4),K,XROM(K,1),XROM(K,2) 2318
- XROM(K,3)=XROM(K,3)+VSY 2319
- IF(XROM(K,3).LT.XRMHIT)GO TO 2315 2320
- 2376 CALL DLETE(4,K) 2321
- GO TO 2330 2322
- C ...ROMULAN CREW AND TROOP ON BOARD REDUCTIONS. 2323
- 2315 IF(ITRMEN(K+10).EQ.0)GO TO 2386 2324
- IX=RAN(IZZ)*SQRT(VSY)*2.5 2325
- IF(IX.GT.ITRMEN(K+10))IX=ITRMEN(K+10) 2326
- ITKL(K+9)=ITKL(K+9)+IX 2327
- ITRMEN(K+10)=ITRMEN(K+10)-IX 2328
- 2386 IX=RAN(IZZ)*SQRT(VSY)*2.5 2329
- CREWR(K)=CREWR(K)-IX 2330
- IF(CREWR(K).GT.0.)GO TO 2329 2331
- IF(ITRMEN(K+1).LE.0)GO TO 2376 2332
- 2329 JTKL(K+9)=JTKL(K+9)+IX 2333
- 2330 CONTINUE 2334
- 2340 XKL(J,8)=NTSTPS+1+(CREWK/ITRMEN(J+1)*SKDLAY+RAN(IZZ)*XKFPST) 2335
- 2680 CONTINUE 2336
- 2700 RETURN 2337
- END 2338
