home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / EFTSUB.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  3.9 KB  |  56 lines
  1.       SUBROUTINE EFTSUB                                                 1275
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6.       CALL CHEKDG(5,IR)                                                 1293
  7.       IF(IR.EQ.1.)GO TO 2250                                            1294
  8. C     ...LOOP ON NO. THAT CAN BE FIRED PER STARMINUTE.                  1295
  9.       DO 2400 JJJ=1,IETOFT                                              1296
  10.       IF(EFT(1,1).EQ.0..OR.EFT(1,1).GT.NTSTPS)GO TO 2300                1297
  11. C     ...LOOK FOR PLACE IN TORPS ARRAY.                                 1298
  12.       IF(NTORPS.NE.0)GO TO 2202                                         1299
  13.       NTORPS=30                                                         1300
  14.       NT=1                                                              1301
  15.       GO TO 2203                                                        1302
  16. 2202  DO 2201 K=1,NTORPS                                                1303
  17.       IF(TORPS(K,1).EQ.0.)GO TO 2208                                    1304
  18. 2201  CONTINUE                                                          1305
  19.       GO TO 2300                                                        1306
  20. 2208  NT=K                                                              1307
  21. 2203  VPX=COSD(PDEG)*PSP+COSD(EFT(1,2))*ETVEL                           1308
  22.       EFT(1,1)=0.                                                       1309
  23.       VPY=SIND(PDEG)*PSP+SIND(EFT(1,2))*ETVEL                           1310
  24.       MINR=MINR+1                                                       1311
  25.       WRITE(6,2206)MINR                                                 1312
  26. 2206  FORMAT(' TORPEDO DECK: TORPEDO ',I2,' LAUNCHED')                  1313
  27.       TORPS(NT,3)=SQRT(VPX*VPX+VPY*VPY)                                 1314
  28. C     ...CHECK IF TORP MOVING AT WARP SPEED.                            1315
  29.       IF(TORPS(NT,3).LT.1.)GO TO 22060                                  1316
  30.       WRITE(6,2204)                                                     1317
  31. 2204  FORMAT(' TORPEDO ENTERING HYPERSPACE...DELETED')                  1318
  32.       GO TO 2220                                                        1319
  33. 22060 TORPS(NT,1)=XQE+VPX                                               1320
  34.       TORPS(NT,2)=YQE+VPY                                               1321
  35.       VSX=0.                                                            1322
  36.       VSY=0.                                                            1323
  37.       CALL GETBRG(DELTA,VSX,VPX,VSY,VPY,X,Y)                            1324
  38. C     ...PUT BEARING IN -360 TO 0 RANGE.                                1325
  39.       TORPS(NT,4)=DELTA -360.                                           1326
  40. 2220  ITFIRE=ITFIRE-1                                                   1327
  41.       IF(ITFIRE.EQ.0)GO TO 2300                                         1328
  42. C     ...MOVE TORPS TO BE FIRED ARRAY DOWN IN CORE.                     1329
  43.       DO 2225    J=1,ITFIRE                                             1330
  44.       EFT(J,1)=EFT(J+1,1)                                               1331
  45.       EFT(J,2)=EFT(J+1,2)                                               1332
  46. 2225  CONTINUE                                                          1333
  47. 2400  CONTINUE                                                          1334
  48.       GO TO 2300                                                        1335
  49. C     ...DAMAGE CONTROL INHIBITION. DELETE ALL QUEUED FIRINGS.          1336
  50. 2250  DO 2260    J=1,ITFIRE                                             1337
  51. 2260  EFT(J,1)=0.                                                       1338
  52.       ITORP=ITORP+ITFIRE                                                1339
  53.       ITFIRE=0                                                          1340
  54. 2300  RETURN                                                            1341
  55.       END                                                               1342
  56.