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