
      SUBROUTINE ACTION                                                 0001

c	include 'tcommon.for'
	%include tcommon.for

C     ...LOOP ON NUMBER OF SECONDS(STEPS) SINCE LAST TIME.              0028
      DO 1999 NS=1,NSTEPS   ,ITFCTR                                     0029
C     ...SUBTRACT ENERGY FOR LIFE SUPPORT.                              0030
      ENERGY=ENERGY-DECR                                                0031
      IF(ENERGY.LE.0.)CALL RATING(2)                                    0032
C     ...CHANGE STARDATE.                                               0033
      XTIME=XTIME-.01                                                   0034
      IF(XTIME.LE.0.)CALL RATING(3)                                     0035
      SDATE=SDATE+.01                                                   0036
      NTSTPS=NTSTPS+1                                                   0037
C     ...ENEMY MOVES FROM QUAD TO QUAD ONCE PER STARDAY.                0038
      IF(NTSTPS.EQ.NTSTPS/100*100.AND.LEVEL.NE.1)CALL QQMOVE            0039
      IF(ISHD.EQ.0)GO TO 2025                                           0040
      CALL TSHUTL                                                       0041
C     ...IF TRUCE, ONLY CERTAIN ACTIVITIES ALLOWED.                     0042
2025  IF(ITRUCE.EQ.1)GO TO 2150                                         0043
      IS=0                                                              0044
C     ...ENTERPRISE MOVEMENT ROUTINE. ON RETURN:                        0045
C     .......IS=0 NORMAL RETURN                                         0046
C     .......IS=1 TRAVELLING AT WARP SPEED                              0047
C     .......IS=2 EXCEEDED GALACTIC LIMITS                              0048
      IF(PSP.EQ.0..AND.DSP.EQ.0..AND.PDEG.EQ.DDEG)GO TO 2050            0049
      CALL EPMOVE(IS)                                                   0050
2050  GO TO (2800,1999),IS                                              0051
      IF(IDOCK.EQ.2)GO TO 2200                                          0052
C     ...ENTERPRISE TORP FIRING ROUTINE                                 0053
      IF(EFT(1,1).EQ.0..OR.EFT(1,1).GT.NTSTPS)GO TO 2100                0054
      CALL EFTSUB                                                       0055
C     ...ENTERPRISE PHASER FIRING ROUTINE                               0056
2100  IF(EFP(1).EQ.0..OR.EFP(1).GT.NTSTPS)GO TO 2150                    0057
      CALL EFPHSR                                                       0058
C     ...ENTERPRISE PULSIVE BEAMS ROUTINE                               0059
2150  IF(ETR(1).EQ.0..OR.ETR(1).GT.NTSTPS.OR.ETR(2).NE.1..AND.ITRUCE.EQ.0060
     11)GO TO 2200                                                      0061
      CALL EPULSE                                                       0062
C     ...ENTERPRISE TRANSPORTER ROUTINE                                 0063
2200  IF(ISTAT.EQ.0)GO TO 2250                                          0064
      CALL BEAM                                                         0065
2250  IF(ITRUCE.EQ.1)GO TO 2600                                         0066
      JJ=0                                                              0067
      DO 2260 K=2,19                                                    0068
      IF(ITRMEN(K).EQ.0)GO TO 2260                                      0069
      IF(ICNTL(K).EQ.1)GO TO 2260                                       0070
      JJ=1                                                              0071
2260  CONTINUE                                                          0072
      IF(JJ.EQ.0)GO TO 2300                                             0073
C     ...ENTERPRISE TROOPS FIGHTING ROUTINE                             0074
      CALL FIGHT                                                        0075
2300  IF(IGH.EQ.0)GO TO 2350                                            0076
C     ...GHOSTSHIP ACTIVITIES ROUTINE                                   0077
      CALL GHACTV                                                       0078
2350  IF(NTORPS.EQ.0)GO TO 2400                                         0079
C     ...TORP MOVEMENT ROUTINE                                          0080
      CALL TRPMV                                                        0081
2400  IF(KLNGNS.EQ.0)GO TO 2450                                         0082
C     ...KLINGON ACTIVITIES ROUTINE                                     0083
      CALL KLNGN                                                        0084
2450  IF(NROM.EQ.0)GO TO 2500                                           0085
C     ...ROMULAN ACTIVITIES ROUTINE                                     0086
      CALL ROMLN                                                        0087
2500  IF(PSP.GE.1.)GO TO 2550                                           0088
C     ...COLLISION DETERMINATION ROUTINE                                0089
2600  IF(IBL(ICE,JCE).GT.0)CALL BHOLE                                   0090
      CALL COLLIS                                                       0091
      IF(ISTORM.EQ.0)GO TO 2550                                         0092
      CALL STORM                                                        0093
2550  IF(IDOCK.EQ.1)GO TO 2900                                          0094
C     ...DAMAGE REPAIR ROUTINE                                          0095
2800  CALL REPAIR                                                       0096
      GO TO 1999                                                        0097
C     ...ENTERPRISE DOCKING ROUTINE                                     0098
2900  CALL DOCK                                                         0099
1999  CONTINUE                                                          0100
      RETURN                                                            0101
      END                                                               0102
     
      WRITE(6,7101)SDAYS  