home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / GHACTV.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  3.4 KB  |  116 lines
  1.       SUBROUTINE GHACTV
  2.  
  3.       real ysav(6)
  4.  
  5. c    include 'tcommon.for'
  6.     %include tcommon.for
  7.  
  8.  
  9. C     ...GHOSTSHIP ACTIVITIES.
  10.       I3=3
  11.       I4=4
  12. C     ...MOVEMENT.    USES ENERGY.
  13.       J1=0
  14.       J2=0
  15.       IF(GHOST(5).NE.GHOST(7))J2=1
  16.       IF(GHOST(4).EQ.0..AND.GHOST(6).EQ.0.)GO TO 100
  17.       IF(GHOST(4).NE.GHOST(6))J1=1
  18.       VSX=GHOST(4)-AMIN1(ABS(GHOST(6)-GHOST(4)),DSPGH)/2.
  19.       VSX=VSX*VSX
  20.       VSY=COSD(AMIN1(ABS(GHOST(7)-GHOST(5)),DGGH))
  21.       GHOST(11)=GHOST(11)-(VSX*(2.-2.*VSY)+(AMIN1(ABS(GHOST(6)-GHOST(4))1889
  22.      1,DSPGH)**2))*GHACCE
  23.       IF(GHOST(11).LE.0.)GO TO 900
  24. 100   CALL OMOVE(GHOST(1),GHOST(2),GHOST(4),GHOST(5),GHOST(6),GHOST(7), 1892
  25.      1     DSPGH,DGGH)
  26.       IF(J1.EQ.1.AND.GHOST(4).EQ.GHOST(6))WRITE(6,1)GHOST(4)
  27. 1     FORMAT(' G DESIRED SPEED OF ',F5.3,' ATTAINED')
  28.       IF(J2.EQ.1.AND.GHOST(5).EQ.GHOST(7))WRITE(6,2)GHOST(5)
  29. 2     FORMAT(' G DESIRED BEARING OF ',F4.0,' ATTAINED')
  30. C     ...CHECK IF LEAVING QUAD.
  31.       IF(GHOST(1).LT..5.OR.GHOST(1).GE.10.5)GO TO 900
  32.       IF(GHOST(2).LT..5.OR.GHOST(2).GE.10.5)GO TO 900
  33. C     ...IF UNDER E CONTROL, DO OTHER ACTIVITIES.
  34.       IF(GHOST(8).EQ.0..OR.GHOST(8).GT.NTSTPS)GO TO 500
  35. C     ...FIRES T.
  36.       IF(GHOST(12).LE.0.)GO TO 500
  37.       IF(RTBRG(1).LT.0.)GO TO 500
  38.       IF(NTORPS.NE.0)GO TO 200
  39.       K=1
  40.       NTORPS=30
  41.       GO TO 275
  42. 200   DO 250 K=1,NTORPS
  43.       IF(TORPS(K,1).EQ.0.)GO TO 275
  44. 250   CONTINUE
  45.       GO TO 500
  46. 275   NT=K
  47.       GHOST(12)=GHOST(12)-1.
  48.       VPX=COSD(GHOST(5))*GHOST(4)+COSD(RTBRG(1))*.4
  49.       VPY=SIND(GHOST(5))*GHOST(4)+SIND(RTBRG(1))*.4
  50.       TORPS(NT,3)=SQRT(VPX*VPX+VPY*VPY)
  51.       TORPS(NT,1)=GHOST(1)+VPX
  52.       TORPS(NT,2)=GHOST(2)+VPY
  53.       RTBRG(1)=-1.
  54.       VSX=0.
  55.       VSY=0.
  56.       CALL GETBRG(DELTA,VSX,VPX,VSY,VPY,X,Y)
  57. C     ...RESET TORP BEARING TO 360-720 RANGE.
  58.       TORPS(NT,4)=DELTA+360.
  59.       GHOST(8)=0.
  60.       IF(RTBRG(2).LT.0.)GO TO 271
  61.       GHOST(8)=NTSTPS+1+FLOAT(MIN0(MXCRGH,ITRMEN(20)))/FLOAT(ITRMEN(20))1929
  62.       DO 270 K=1,4
  63. 270   RTBRG(K)=RTBRG(K+1)
  64.       RTBRG(5)=-1.
  65. 271   WRITE(6,3)
  66. 3     FORMAT(' G TORPEDO LAUNCHED')
  67. C     ...FIRES PHASERS.
  68. 500   IF(GHOST(10).EQ.0..OR.GHOST(10).GT.NTSTPS)GO TO 1000
  69.       IF(GHOST(11).LE.0.)GO TO 2350
  70. C     ...USES EPHIT, SO MUST MAY G LOOK LIKE E TO IT.
  71.       WRITE(6,4)
  72. 4     FORMAT(' G FIRING PHASERS')
  73.       ysav(1)=XQE
  74.       ysav(2)=YQE
  75.       ysav(3)=PDEG
  76.       ysav(4)=EFP(3)
  77.       ysav(5)=EFP(2)
  78.       ysav(6)=DISTPE
  79.       XQE=GHOST(1)
  80.       YQE=GHOST(2)
  81.       PDEG=GHOST(5)
  82.       EFP(3)=AMIN1(GHPHEN,GHOST(11))
  83.       GHOST(11)=GHOST(11)-EFP(3)
  84.       EFP(2)=1.
  85.       DISTPE=TNRGY
  86.       IF(KLNGNS.EQ.0)GO TO 2320
  87.       DO 2310 J=1,KLNGNS
  88.       IF(XKL(J,1).EQ.0.)GO TO 2310
  89.       IF(ICNTL(J+1).EQ.1)GO TO 2310
  90.       CALL EPHIT(XKL(J,1),XKL(J,2),XKL(J,7),XKLHIT,I3,J)
  91. 2310  CONTINUE
  92. 2320  IF(NROM.EQ.0)GO TO 2340
  93. C     ...HIT ON ROMULANS
  94.       DO 2330 J=1,NROM
  95.       IF(XROM(J,1).EQ.0.)GO TO 2330
  96.       IF(ICNTL(J+10).EQ.1)GO TO 2330
  97.       CALL EPHIT(XROM(J,1),XROM(J,2),XROM(J,3),XRMHIT,I4,J)
  98. 2330  CONTINUE
  99. C     ...RESTORE VALUES.
  100. 2340  XQE=ysav(1)
  101.       YQE=ysav(2)
  102.       PDEG=ysav(3)
  103.       EFP(3)=ysav(4)
  104.       EFP(2)=ysav(5)
  105.       DISTPE=ysav(6)
  106.       GHOST(10)=0.
  107. 2350  N GHTFP=NGHTFP-1
  108.       IF(NGHTFP.EQ.0)GO TO 1000
  109.       GHOST(10)=NTSTPS+1+FLOAT(MIN0(MXCRGH,ITRMEN(20)))/      FLOAT(ITRM1977
  110.      1EN(20))
  111.       GO TO 1000
  112. C     ...G OUT OF QUAD.
  113. 900   CALL DLETE(5,1)
  114. 1000  RETURN
  115.       END
  116.