      SUBROUTINE PROCM

c	include 'tcommon.for'
	%include tcommon.for
 
      character*8 DEFLEC,moldnm

      DATA DEFLEC/'DFLECTRS'/   
C     ...PROCESS ACTIVITIES PREVIOUSLY SCHEDULED AND QUEUE THEM FOR     
C     ...ACTION.      
      PCT(A,B)=(B-A)/A*100.     
1     IF(ICM.EQ.99)GO TO 5000   
      IF(ICM.LE.0)GO TO 5000    
      CALL CHEKDG(ICM,IR)       
      IF(IR.EQ.1)GO TO 998      
      GO TO (3001,3002,3003,3004,3005,3006,4000,3008,3009,3010,3011,3012
     1       ,3013,3014,3015,3016,3017,3018,3019,3020,3031,3033),ICM    
      GO TO 5000      
C     ...MUST CHECK DAMAGE INDIVDUALLY HERE AS TWO TYPES OF MOTION      
C     ...INVOLVED.    
3001  IF(IDMG(1).EQ.0)GO TO 30013         
      IF(XDSP.LE.PSP.OR.XDSP.LE.SIM)GO TO 30011     
      WRITE(6,30019)NAMD(1)     
30019 FORMAT(1X,A10, ' DAMAGED')
      WRITE(6,30119)PSP         
30119 FORMAT(' DESIRED SPEED SET TO ',F5.3)         
      DSP=PSP         
      DDEG=XDDEG      
C     ...CHECK DAMAGE TO IMPULSE DRIVE.   
30011 IF(IDMG(2).EQ.0)GO TO 30013         
      WRITE(6,30019)NAMD(2)     
      DDEG=PDEG       
      DSP=PSP         
      WRITE(6,30119)DSP         
      GO TO 998       
30013 DDEG=XDDEG      
      DSP=XDSP        
      IF(ITRUCE.EQ.0)GO TO 4000 
      WRITE(6,33333)  
33333 FORMAT(' TRUCE BROKEN...NORMAL ACTIVITIES RESUME')      
      ITRUCE=0        
      GO TO 4000      
C     ...SHORT RANGE SCAN. STOP TIMER FOR PRINT TIME.         
3002  IF(PSP.GE.1.)GO TO 994    
      IHERE=1         
      CALL SCAN       
      CALL QTIME(JTIME)         
      ISTART=JTIME    
      GO TO 4000      
C     ...LONG RANGE SCAN. STOP TIMER FOR PRINTING.  
3003  I=ICE-1         
      J=ICE+1         
      K=JCE-1         
      L=JCE+1         
      IF(I.LT.1)I=1   
      IF(J.GT.NQUAD)J=NQUAD     
      IF(K.LT.1)K=1   
      IF(L.GT.NQUAD)L=NQUAD     
      DO 30032  M=I,J 
      DO 30032 N=K,L  
      IGAL(M,N)=JGAL(M,N)       
30032 CONTINUE        
C     CALL CPAGE      
      WRITE(6,30033)ICE,JCE     
30033 FORMAT(' LONG RANGE SENSOR SCAN AROUND QUADRANT ',I2,',',I2)      
      WRITE(6,30034)  
30034 FORMAT(' ---------------------------')        
      N=L         
30035 N=N-1 
      IF(N.LT.K)GO TO 30037     
      WRITE(6,30036)(JGAL(M,N),M=I,J)     
30036 FORMAT(3(2X,I4,' :',2X))  
      WRITE(6,30034)  
      GO TO 30035     
30037 CALL QTIME(JTIME)         
      ISTART=JTIME    
      GO TO 4000      
C     ...PHASER FIRING SETUP.   
3004  IF(PSP.GE.1.)GO TO 994    
      EFP(1)=NTSTPS+NMEN/MEN    
      EFP(2)=IDIR     
      EFP(3)=PNRGY    
      IF(ITRUCE.EQ.0)GO TO 4000 
      WRITE(6,33333)  
      ITRUCE=0        
      GO TO 4000      
C     ...TORPS SETUP FIRING AREA.         
3005  IF(PSP.GE.1.)GO TO 994    
      M=ITFIRE+1      
      ITFIRE=ITFIRE+MTORPS      
      ITORP=ITORP-MTORPS        
      NC=1  
      NF=1  
      DO 30052 J=M,ITFIRE       
C     ...SLOWDOWN DUE TO CREW REDUCTION BELOW 50% NORMAL.     
      EFT(J,1)=NTSTPS+NF+NMEN/MEN-1       
      EFT(J,2)=DTORP(J-M+1)     
      NC=NC+1         
      IF(NC.LE.IETOFT)GO TO 30052         
      NC=1  
      NF=NF+1         
30052 CONTINUE        
      IF(ITRUCE.EQ.0)GO TO 4000 
      ITRUCE=0        
      WRITE(6,33333)  
      GO TO 4000      
C     ...PULSIVE BEAMS.         
3006  IF(PSP.GE.1.)GO TO 994    
      ETR(1)=NTSTPS+NMEN/MEN    
      ETR(2)=IBTYP    
      IF(IBTYP.EQ.1)GO TO 4000  
      ETR(3)=PNRGY    
      IF(ITRUCE.EQ.0)GO TO 4000 
      ITRUCE=0        
      WRITE(6,33333)  
      GO TO 4000      
C     ...STATUS REPORT.         
3008  XNRGY=ENERGY-PNRGY        
      WRITE(6,30081)XTIME,XNRGY,ITORP,PSP,PDEG,DEFL,ISHNUM    
30081 FORMAT(' STATUS REPORT'/' DAYS LEFT: ',F6.2,6X,'ENERGY: ',F8.2,6X,
     1       'TORPS: ',I3/' SPEED: ',F6.3,6X,'BEARING: ',F4.0,'  SHIELDS
     1: ',F7.1,'  SHUTTLECRAFT ON BOARD: ',I1)      
C     ...ALSO PRINT TECHNOLOGICAL IMPROVEMENTS.     
      IF(DVWP.EQ.DVWP0)GO TO 2  
      IXRAT=PCT(DVWP0,DVWP)     
      WRITE(6,702)NAMD(1),IXRAT 
702   FORMAT(' ',A10,' ACCELERATION INCREASED ',I3,'%')       
2     IF(EWRP.EQ.EWRP0)GO TO 3  
      IXRAT=-PCT(EWRP0,EWRP)    
      WRITE(6,703)NAMD(1),IXRAT 
703   FORMAT(1X,A10,' EFFICIENCY INCREASED BY ',I3,'%')       
3     IF(DISTPE.EQ.DISTP0)GO TO 4         
      IXRAT=PCT(DISTP0,DISTPE)  
      WRITE(6,704)NAMD(3),IXRAT 
704   FORMAT(1X,A10,' EFFECTIVENESS INCREASED BY ',I3,'%')    
4     IF(ETVEL.EQ.ETVEL0)GO TO 5
      WRITE(6,705)NAMD(4),ETVEL 
705   FORMAT(1X,A10,' VELOCITY INCREASED TO ',F5.3) 
5     IF(IETOFT.EQ.IETOF0)GO TO 6         
      WRITE(6,706)NAMD(4),IETOFT
706   FORMAT(1X,A10,' RATE NOW ',I2,' PER STAR-MINUTE')       
6     IF(DISTGT.EQ.DISTG0)GO TO 7         
      IXRAT=PCT(DISTG0,DISTGT)  
      WRITE(6,704)NAMD(5),IXRAT 
7     IF(CODDS.EQ.CODDS0)GO TO 8
      IXRAT=PCT(CODDS0,CODDS)   
      WRITE(6,708)IXRAT         
708   FORMAT(' TROOP FIGHTING EFFECTIVENESS VS KLINGONS INCREASED BY ',I
     13,'%')
8     IF(EODDS.EQ.EODDS0)GO TO 9
      IXRAT=PCT(EODDS0,EODDS)   
      WRITE(6,709)IXRAT         
709   FORMAT(' TROOP FIGHTING EFFECTIVENESS VS ROMULANS INCREASED BY ',I
     13,'%')
9     IF(IDAMRP.EQ.IDAMR0)GO TO 14        
      IXRAT=PCT(FLOAT(IDAMR0),FLOAT(IDAMRP))        
      WRITE(6,706) NAMD(8),IDAMRP         
14    IF(TRNRG0.EQ.TRNRGY)GO TO 10        
      IXRAT=-PCT(TRNRG0,TRNRGY) 
      WRITE(6,703)NAMD(8),IXRAT 
10    IF(PJAM.EQ.PJAM0)GO TO 11 
      IXRAT=-PCT(PJAM0,PJAM)    
      WRITE(6,710)NAMD(9),IXRAT 
710   FORMAT(1X,A10,' INTERCEPTION PROBABILITY REDUCED BY ',I3,'%')     
11    IF(SHLDF.EQ.SHLDF0)GO TO 12         
      IXRAT=PCT(SHLDF0,SHLDF)   
      WRITE(6,6112)IXRAT        
6112  FORMAT(' SHIELDS IMPROVED BY ',I3,'%')        
12    IF(ICLOAK.GE.0)GO TO 13   
      SDAYS=-ICLOAK/100.        
      WRITE(6,7101)SDAYS        
7101  FORMAT(' CLOAKING DEVICE AVAILABLE FOR ',F5.2,' STARDAYS')        
13    CALL QTIME(ISTART)        
      GO TO 4000      
C     ...DAMAGE REPORT.         
3009  IF(JDAM.NE.2)GO TO 30999  
      WRITE(6,30991)  
30991 FORMAT(' REPAIR CREWS REASSIGNED')  
30999 TOTAL=0.        
      N=0   
      DO 30992 J=1,10 
      IF(JDAM.EQ.2)IPROB1(J)=IPROB2(J)    
      IF(IDMG(J).EQ.0)GO TO 30992         
      TOTAL=TOTAL+IPROB1(J)     
      N=N+1 
30992 IPROB2(J)=0     
      IF(JDAM.EQ.2)GO TO 4000   
      WRITE(6,30091)  
30091 FORMAT(' DAMAGE REPORT')  
      JJ=0  
      IF(N.EQ.0)GO TO 37379     
      DO 30092 J=1,10 
      IF(IDMG(J).EQ.0)GO TO 30092         
      JJ=1  
      SDAYS=IDMG(J)/100. *FLOAT(NMEN)/FLOAT(MEN)    
      ASSN=((100.-TOTAL)/N+IPROB1(J))/100.
      JSSN=ASSN*100.  
      DAYS=1.E7       
      IF(ASSN.LE.0.)GO TO 39899 
      DAYS=SDAYS/ASSN/ERPRRT    
39899 WRITE(6,30093)NAMD(J),DAYS,JSSN     
30093 FORMAT(1X,A8,2X,'-',F5.2,' STARDAYS',' (',I3,'%)')      
30092 CONTINUE        
37379 IF(JJ.EQ.1)GO TO 30094    
      WRITE(6,30095)  
30095 FORMAT(' NO DAMAGE')      
C     ...CHECK MEN KILLED.      
30094 IF(MEN.EQ.NMEN)GO TO 30099
      KMEN=NMEN-MEN   
      WRITE(6,30096)KMEN,MEN    
30096 FORMAT(1X,I4,' CREW KILLED - ',I4,' LEFT')    
30099 ITM=0 
      DO 30098 J=1,20 
30098 ITM=ITM+ITRMEN(J)         
      IF(ITM.EQ.IFGHTM)GO TO 4000         
      KMEN=IFGHTM-ITM 
      IF(KMEN.LT.0)KMEN=0       
      WRITE(6,30097)KMEN,ITM    
30097 FORMAT(1X,I4,' TROOPS KILLED - ',I4,' LEFT')        
      GO TO 4000      
C     ...EVASIVE MANEUVERS.     
3010  IF(PSP.GE.1.0)GO TO 994   
      DSP=EVMSP       
      IF(IDMG(1).EQ.0.OR.IDMG(2).EQ.0)GO TO 30111   
      IF(IDMG(1).EQ.0)GO TO 30104         
      WRITE(6,30019)NAMD(1)     
      IF(IDMG(2).EQ.0)GO TO 998 
30104 WRITE(6,30019)NAMD(2)     
      WRITE(6,30119)SIM         
      NBASES=0        
      GO TO 998       
30111 IF(IEVDR.EQ.1)GO TO 30101 
      IF(IEVDR.EQ.3)GO TO 30103 
      PDEG=PDEG-90.   
      IF(PDEG.LT.0.)PDEG=PDEG+360.        
      X=EVENU         
      IF(IDMG(1).NE.0)X=X*2.5   
      GO TO 30102     
30101 PDEG=PDEG+90.   
      X=EVENU         
      IF(IDMG(1).NE.0)X=X*2.5   
30105 IF(PDEG.GE.360.)PDEG=PDEG-360. 
      GO TO 30102     
30103 PDEG=PDEG+180.  
      X=EVENU*1.5     
      IF(IDMG(1).NE.0)X=X*2.5   
      GO TO 30105     
30102 ENERGY=ENERGY-X 
      IF(ENERGY.LE.0.)CALL RATING(2)      
      DDEG=PDEG       
      IF(ITRUCE.EQ.0)GO TO 4000 
      ITRUCE=0        
      WRITE(6,33333)  
      GO TO 4000      
C     ...EMERGENCY EVASIVE MANEUVERS.MUST USE WARP DRIVE.     
3011  IF(PSP.GE.1.)GO TO 994    
      DSP=EEVMSP      
      NBASES=99       
      IF(IDMG(1).EQ.0)GO TO 30111         
      GO TO 30104     
C     ...RAISE DEFLECTORS.      
3012  IF(ADDFL.LT.-DEFL)GO TO 3013        
      DEFL=DEFL+ADDFL 
      ENERGY=ENERGY-ADDFL       
      IF(ENERGY.LE.0.)CALL RATING(2)      
      GO TO 4000      
C     ...DROP DEFLECTORS.       
3013  ENERGY=ENERGY+DEFL        
      WRITE(6,30131)  
30131 FORMAT(' DROP DEFLECTORS')
      DEFL=0.         
      GO TO 4000      
C     ...PROPOSE TRUCE.         
3014  IF(PSP.GE.1.)GO TO 994    
      WRITE(6,30141)  
30141 FORMAT(' TRUCE PROPOSED') 
      X=0.  
      Y=0.  
      JJ=0  
      IF(KLNGNS.EQ.0)GO TO 30143
      DO 30142 J=1,KLNGNS       
      IF(XKL(J,1).EQ.0.)GO TO 30142       
      IF(ICNTL(J+1).EQ.1)GO TO 30142      
      IF(ITRMEN(J+1).NE.0)GO TO 30146     
      JJ=1  
      X=X+XKL(J,7)    
      Y=Y+XKLHIT      
30142 CONTINUE        
30143 IF(NROM.EQ.0)GO TO 30145  
      DO 30144 J=1,NROM         
      IF(XROM(J,1).EQ.0.)GO TO 30144      
      IF(ICNTL(J+10).EQ.1)GO TO 30144     
      IF(ITRMEN(J+10).NE.0)GO TO 30146    
      JJ=1  
      X=X+XROM(J,3)   
      Y=Y+XRMHIT      
30144 CONTINUE        
30145 IF(JJ.EQ.0)GO TO 30146    
C     ...ACCEPTED ONLY IF ALL ENEMY AT LEAST 75% DAMAGED.     
      IF(RAN(IZZ).GT.(X/Y)/THITR)GO TO 30146        
      WRITE(6,30147)  
30147 FORMAT(' TRUCE ACCEPTED') 
      ITRUCE=1        
      GO TO 4000      
30146 WRITE(6,30148)  
30148 FORMAT(' TRUCE OFFER DECLINED')     
      GO TO 4000      
C     ...SHORT RANGE TRACK.     
3015  IF(PSP.GE.1.)GO TO 994         
      WRITE(6,30151)  
30151 FORMAT(' SHORT RANGE TRACK')        
      IF(KLNGNS.EQ.0)GO TO 30154
      DO 30152 J=1,KLNGNS       
      IF(XKL(J,1).EQ.0.)GO TO 30152       
      WRITE(6,30157)LETR(3),J,(XKL(J,K),K=1,4)      
30157 FORMAT(1X,A1,I1,' AT ',F4.1,',',F4.1,' SPEED: ',F6.3,' BEARING: ',
     1F5.0) 
30153 FORMAT(1X,A1,1X,' AT ',F4.1,',',F4.1,' SPEED: ',F6.3,' BEARING: ',
     1F5.0) 
30152 CONTINUE        
30154 IF(NTORPS.EQ.0)GO TO 30156
      DO 30155 J=1,NTORPS       
      IF(TORPS(J,1).EQ.0.)GO TO 30155     
      WRITE(6,30153)LETR(7),(TORPS(J,K),K=1,4)      
30155 CONTINUE        
30156 WRITE(6,30153)LETR(2),XQE,YQE,PSP,PDEG        
      IF(ISTSH.NE.99)GO TO 30174
      WRITE(6,30153)LETR(12),SHX,SHY,SHVX,SHDEG     
30174 IF(IGH.EQ.0)GO TO 30159   
      WRITE(6,30153)LETR(5),(GHOST(K),K=1,2),(GHOST(L),L=4,5) 
30159 CALL QTIME(ISTART)        
      GO TO 4000      
C     ...GALACTIC MAP DISPLAY.  
C 3016  CALL CPAGE    
3016  WRITE(6,30163)  
30163 FORMAT(' GALACTIC UPDATE')
      I=NQUAD+1       
30161 I=I-1 
      IF(I.LT.1)GO TO 30166     
      DO 30164 J=1,NQUAD        
      IF(I.EQ.JCE.AND.J.EQ.ICE)GO TO 30165
      IPQ(J,I)=LETR(9)
      GO TO 30164     
30165 IPQ(J,I)=LETR(2)
30164 CONTINUE        
      WRITE(6,30162)(IGAL(J,I),IPQ(J,I),J=1,NQUAD)  
30162 FORMAT(1X,10(I4,A1,2X))   
      GO TO 30161     
30166 CALL QTIME(ISTART)
c#####
      GO TO 4000        
C     ....PLOT BEARING.         
3017  WRITE(6,30171)  
30171 FORMAT(' PLOT BEARING')   
      IF(PSP.GE.1.)GO TO 30176  
      IF(NSTARS.EQ.0)GO TO 30175
      DO 30172 J=1,NSTARS       
      IF(STARS(J,1).EQ.0.)GO TO 30172     
      CALL GETBRG(DELTA,XQE,STARS(J,1),YQE,STARS(J,2),VPX,VPY)
      VSX=SQRT(VPX*VPX+VPY*VPY) 
      WRITE(6,30173)LETR(1),J,STARS(J,1),STARS(J,2),DELTA,VSX ,RAD(J)   
30173 FORMAT(1X,A1,I1,' AT ',F4.1,',',F4.1,' BEARING: ',F4.0,' DISTANCE:
     1 ',F4.1,' RADIUS: ',F3.2) 
30172 CONTINUE        
30175 IF(IBASE.EQ.0)GO TO 4000  
      CALL GETBRG(DELTA,XQE,BASE(1),YQE,BASE(2),VPX,VPY)      
      VSX=SQRT(VPX*VPX+VPY*VPY) 
      WRITE(6,30180)LETR(6),BASE(1),BASE(2),DELTA,VSX   ,RADEB
30180 FORMAT(1X,A1,'  AT ',F4.1,',',F4.1,' BEARING: ',F4.0,' DISTANCE:  
     1 ',F4.1,' RADIUS: ',F3.2) 
      GO TO 4000      
C     ...IF WARP 1 OR HIGHER, GIVE QUADRANTS OF STARBASES.    
30176 DO 30177  I=1,NQUAD       
      DO 30177  J=1,NQUAD       
      IF((JGAL(I,J)-JGAL(I,J)/100*100)/10.EQ.0) GO TO 30177   
      WRITE(6,30178)I,J         
30178 FORMAT(' STARBASE IN QUADRANT ',I2,',',I2)    
30177 CONTINUE        
      DO 38179 I=1,NQUAD        
      DO 38179 J=1,NQUAD        
      IF(IGAL(I,J).LT.0.OR.IBL(I,J).LE.0)GO TO 38179
      WRITE(6,38174)I,J         
38174 FORMAT(' BLACK HOLE IN QUADRANT ',I2,',',I2)  
38179 CONTINUE        
      GO TO 4000      
C     ...SELF DESTRUCT
3018  CALL RATING(7)  
      GO TO 4000      
C     ...TRANSPORTERS.
3019  IF(PSP.GE.1.)GO TO 994    
      IF(IFROM.EQ.LETR(3))GO TO 1391      
      IF(IFROM.EQ.LETR(4))GO TO 1392      
      IF(IFROM.EQ.LETR(5))GO TO 1393      
      IF(IFROM.EQ.LETR(6))GO TO 1394      
      IF(IFROM.NE.LETR(2))GO TO 998       
      LUP=2 
      GO TO 1395      
1394  LUP=6 
      GO TO 1395      
1391  LUP=3 
      IF(KFROM.LT.1.OR.KFROM.GT.KLNGNS)GO TO 998    
      GO TO 1395      
1392  LUP=4 
      IF(KFROM.LT.1.OR.KFROM.GT.NROM)GO TO 998      
      GO TO 1395      
1393  LUP=5 
1395  CONTINUE        
      IF(ITO.EQ.LETR(3))GO TO 13901       
      IF(ITO.EQ.LETR(4))GO TO 13902       
      IF(ITO.EQ.LETR(5))GO TO 13903       
      IF(ITO.NE.LETR(2))GO TO 998         
      LDOWN=2         
      GO TO 13905     
13901 LDOWN=3         
      IF(MTO.LT.1.OR.MTO.GT.KLNGNS)GO TO 998        
      IF(ITRUCE.EQ.0.OR.ICNTL(MTO+1).EQ.1)GO TO 13905         
      ITRUCE=0        
      WRITE(6,33333)  
      GO TO 13905     
13902 LDOWN=4         
      IF(MTO.LT.1.OR.MTO.GT.NROM)GO TO 998
      IF(ITRUCE.EQ.0.OR.ICNTL(MTO+10).EQ.1)GO TO 13905        
      ITRUCE=0        
      WRITE(6,33333)  
      GO TO 13905     
13903 LDOWN=5         
C     ...COMMAND OK NOW.        
13905 ISTAT=IBMEN     
      JTO=MTO         
      JFROM=KFROM     
      JDOWN=LDOWN     
      JUP=LUP         
      GO TO 4000      
C     ...OTHER SHIP ACTIVITIES UNDER E CONTROL.     
3020  IF(PSP.GE.1.)GO TO 994    
      GO TO (30201,992,992,30204,30205,30206,992,30208,30209,992   ,992,
     130212,992,992,992,992,30217),IMSG   
C     ...K COURSE CHANGE.       
30201 IF(LTO.EQ.5)GO TO 30240   
      IF(ICNTL(KTO+1).NE.1)GO TO 992      
      IF(ITRMEN(KTO+1).LE.0)GO TO 992     
      XKL(KTO,6)=KBRG 
      XKL(KTO,5)=AMIN1(ABS(XWRP),VMXKL)   
      GO TO 4000      
C     ...K FIRE PHASER.         
30204 IF(LTO.EQ.5)GO TO 30250   
      IF(ICNTL(KTO+1).NE.1)GO TO 992      
      IF(ITRMEN(KTO+1).LE.0)GO TO 992     
      XKL(KTO,8)=NTSTPS+1+(CREWK/ITRMEN(KTO+1)*SKDLAY+RAN      (IZZ)*XKF
     1PST)  
      GO TO 4000      
C     ...R FIRE TORPEDO.        
30205 IF(LTO.EQ.5)GO TO 30260   
      IF(ICNTL(KTO+10).NE.1)GO TO 992     
      IF(ITRMEN(KTO+10).LE.0)GO TO 992    
      XROM(KTO,4)=NTSTPS+1+(SCREWR/ITRMEN(KTO+10)*SRDLY+RAN      (IZZ)*X
     1RFTS)*XRMHIT/(XRMHIT-XROM(KTO,3))   
c$$
      GO TO 4000      
C     ...SCUTTLE SHIP 
C     ...JJSTAT=0 NORMAL        
C     ...JJSTAT < 0 TRANSPORTERS QUEUED FOR USE BY AUTO-DESTRUCT.       
C     ...JJSTAT > 0 TRANSPORTERS CURRENTLY IN USE FOR AUTO-DESTRUCT.    
30206 L=LTO-2         
      IF(LTO.EQ.5)KTO=1         
      M=(L-1)*9+KTO+1 
      IF(ICNTL(M).NE.1)GO TO 992
      IF(ITRMEN(M).EQ.0)GO TO 992         
      IF(JJSTAT.NE.0)GO TO 39299
      SDAYS=0.        
      IF(ISTAT.EQ.0)GO TO 39200 
C     ...TRANSPORTERS IN USE. SET UP JJSTAT TO INDICATE WE ARE WAITNG.  
      JJSTAT=-ISTAT/(IDAMRP+1)-1
      GO TO 39202     
39200 ISTAT=ITRMEN(M) 
      JJSTAT=1        
      JFROM=KTO       
      JUP=LTO         
      JDOWN=2         
      JTO=1 
      SDAYS=(ISTAT/(IDAMRP+1)+1)/100.     
      GO TO 39204     
39202 SDAYS=SDAYS-JJSTAT/100.   
      JJFROM=KTO      
      JJUP=LTO        
      JJDOWN=2        
      JJTO=1
      SDAYS=SDAYS+(ITRMEN(M)/(IDAMRP+1)+1)/100.     
      IISTAT=ITRMEN(M)
39204 WRITE(6,39203)SDAYS       
39203 FORMAT(' DESTRUCT IN ',F5.2,' STARDAYS')      
      GO TO 4000      
39299 WRITE(6,39298)LETR(JUP),JFROM       
39298 FORMAT(' RETYPE COMMAND WHEN ',A1,I1,' DESTRUCT SEQUENCE COMPLETED
     1')    
      GO TO 998       
C     ...STATUS REPORT
30208 IF(LTO.EQ.6)GO TO 30299   
      LTO=LTO-2       
      GO TO (30281,30285,30288),LTO       
C     ...KLINGON STATUS         
30281 IF(ICNTL(KTO+1).NE.1)GO TO 992      
      WRITE(6,30282)LETR(3),KTO,(XKL(KTO,J),J=1,4),ITRMEN(KTO+1)        
30282 FORMAT(' STATUS REPORT FOR ',A1,I1,' AT ',F4.1,',',F4.1/      ' SP
     1EED: ',F5.3,' BEARING: ',F4.0,' MEN ON BOARD: ',I5)     
      GO TO 4000      
C     ...ROMULAN STATUS         
30285 IF(ICNTL(KTO+10).NE.1)GO TO 992     
      WRITE(6,30283)LETR(4),KTO,XROM(KTO,1),XROM(KTO,2),ITRMEN(KTO+10)  
30283 FORMAT(' STATUS REPORT FOR ',A1,I1,' AT ',F4.1,',',F4.1/      ' ME
     1N ON BOARD: ',I5)         
      GO TO 4000      
C     ...GHOSTSHIP STATUS       
30288 IF(IGH.EQ.0)GO TO 992     
      IF(ICNTL(20).NE.1)GO TO 992         
      WRITE(6,30284)LETR(5),GHOST(1),GHOST(2),GHOST(4),GHOST(5),      (G
     1HOST(K),K=11,13),ITRMEN(20)         
30284 FORMAT(' STATUS REPORT FOR ',A1,' AT ',F4.1,',',F4.1/      ' SPEED
     1: ',F5.3,' BEARING: ',F4.0,' ENERGY: ',F7.1,      ' TORPS: ',F3.0/
     1' SHIELD STRENGTH: ',F6.1,' MEN ON BOARD: ',I5)         
      GO TO 4000      
C     ...DAMAGE REPORT
30209 LTO=LTO-2       
      GO TO (30291,30295,30298),LTO       
C     ...KLINGON DAMAGE         
30291 IF(ICNTL(KTO+1).NE.1)GO TO 992      
      WRITE(6,30292)LETR(3),KTO,XKL(KTO,7)
30292 FORMAT(' DAMAGE REPORT FOR ',A1,I1,' HITS: ',F5.1)      
      GO TO 4000      
C     ...ROMULAN DAMAGE         
30295 IF(ICNTL(KTO+10).NE.1)GO TO 992     
      WRITE(6,30292)LETR(4),KTO,XROM(KTO,3)         
      GO TO 4000      
C     ...GHOSTSHIP DAMAGE       
30298 IF(IGH.EQ.0)GO TO 992     
      IF(ICNTL(20).NE.1)GO TO 992         
      WRITE(6,30292)LETR(5),IGH,GHOST(3)  
3991  IF(IGHPH.EQ.0)WRITE(6,30293)NAMD(3) 
30293 FORMAT(1X,A10,' DEAD')    
3992  IF(IGHTR.EQ.0)WRITE(6,30293)NAMD(4) 
3993  IF(IGHDR.EQ.0)WRITE(6,30293)NAMD(2) 
3994  IF(IGHDE.EQ.0)WRITE(6,30293)DEFLEC  
      GO TO 4000      
C     ...G RAISE DEFLECTORS.    
30212 IF(ICNTL(20).NE.1)GO TO 992         
      IF(IGHDE.EQ.0)GO TO 3994  
      IF(SDEF)30213,992,30214   
C     ...DROP         
30213 SDEF=AMAX1(SDEF,-GHOST(13))         
30215 GHOST(13)=GHOST(13)+SDEF  
      GHOST(11)=GHOST(11)-SDEF  
      GO TO 4000      
C     ...RAISE        
30214 SDEF=AMIN1(SDEF,GHOST(11))
      GO TO 30215     
C     ...CHANGE COURSE
30240 IF(ICNTL(20).NE.1)GO TO 992         
      IF(ITRMEN(20).LE.0)GO TO 992        
      IF(IGHDR.EQ.0)GO TO 3993  
      GHOST(6)=AMIN1(XWRP,GHVMX)
      GHOST(7)=KBRG   
      GO TO 4000      
C     ...G FIRE P.    
30250 IF(ICNTL(20).NE.1)GO TO 992         
      IF(ITRMEN(20).LE.0)GO TO 992        
      IF(IGHPH.EQ.0)GO TO 3991  
      GHOST(10)=NTSTPS+1+FLOAT(MIN0(MXCRGH,ITRMEN(20)))/      FLOAT(ITRM
     1EN(20))         
      GO TO 4000      
C     ...G FIRE T.    
30260 IF(ICNTL(20).NE.1)GO TO 992         
      IF(ITRMEN(20).LE.0)GO TO 992        
      IF(IGHTR.EQ.0)GO TO 3992  
      GHOST(8)=NTSTPS+1+FLOAT(MIN0(MXCRGH,ITRMEN(20)))/      FLOAT(ITRME
     1N(20))
      GO TO 4000      
C     ...COMMUNICATION WITH B.  
30299 IF(IBASE.EQ.0)GO TO 992   
      WRITE(6,30294)IBMENR      
30294 FORMAT(' STARBASE TROOPS AVAILABLE: ',I4)     
      GO TO 4000      
C     ...PLOT BEARING FROM BASE.
30217 IF(IBASE.EQ.0)GO TO 992   
      WRITE(6,30171)  
      IF(NSTARS.EQ.0)GO TO 30218
      DO 30219 J=1,NSTARS       
      IF(STARS(J,1).EQ.0.)GO TO 30219     
      CALL GETBRG(DELTA,BASE(1),STARS(J,1),BASE(2),STARS(J,2),VPX,VPY)  
      VSX=SQRT(VPX*VPX+VPY*VPY) 
      WRITE(6,30173)LETR(1),J,STARS(J,1),STARS(J,2),DELTA,VSX ,RAD(J)   
30219 CONTINUE        
30218 CALL GETBRG(DELTA,BASE(1),XQE,BASE(2),YQE,VPX,VPY)      
      VSX=SQRT(VPX*VPX+VPY*VPY) 
      WRITE(6,30180)LETR(2),XQE,YQE,DELTA,VSX,RADEB 
      GO TO 4000      
C     ...SHUTTLECRAFT ACTIVITIES.         
3031  IF(PSP.GE.1.)GO TO 994    
      IF(ISHNUM.LE.0)GO TO 30314
      GO TO (30310,30315),JSCHM 
C     ...EXPLORE.     
30310 IF(ISHSTR(1).GT.NSTARS.OR.ISHSTR(1).LE.0)GO TO 998      
      IF(STARS(ISHSTR(1),1).EQ.0.)GO TO 998         
      ISHD=ISHSTR(1)  
      IF(ISTSH.NE.99)GO TO 4000 
      SDAYS=RANGE(SHX,STARS(ISHSTR(1),1),SHY,STARS(ISHSTR(1),2))/SHVX/10
     10.    
      WRITE(6,30313)SDAYS       
30313 FORMAT(' ARRIVAL IN ',F4.2,' STARDAYS')       
      GO TO 4000      
C     ...RETURN       
30314 WRITE(6,30311)  
30311 FORMAT(' NO SHUTTLECRAFT ON BOARD') 
      GO TO 998       
30315 IF(ISTSH.EQ.0)GO TO 998   
      ISHD=99         
      IF(ISTSH.NE.99)GO TO 4000 
      SDAYS=RANGE(SHX,XQE,SHY,YQE)/100./SHVX        
      WRITE(6,30313)SDAYS       
      GO TO 4000      
C     ...COMPUTER REQUESTS.     
3033  IF(PSP.GE.1.)GO TO 994    
      GO TO (30331,30334,30338,30340,30370,30360),JSCHM       
      GO TO 998       
C     ...ENERGY FOR G.
30331 IF(IGH.EQ.0)GO TO 992     
      X=(GHOST(1)-XQE)**2+(GHOST(2)-YQE)**2         
      X=X/DISTGT*PTRGH
      WRITE(6,30332)X 
30332 FORMAT(F8.0,' UNITS ENERGY REQUIRED')         
      GO TO 4000      
C     ...WHERE HOLE WILL TAKE YOU.        
30334 IF(IHOLE.EQ.0)GO TO 992   
      I=IBL(ICE,JCE)/100        
      J=IBL(ICE,JCE)-I*100      
      WRITE(6,30335)I,J         
30335 FORMAT(' HOLE GOES TO QUADRANT ',I2,',',I2)   
      GO TO 4000      
C     ...SHUTTLECRAFT ROUND TRIP TIME.    
30338 IF(ISTSH.EQ.99)GO TO 30350
      DO 30351 I=1,9  
      IF (ISTSH.EQ.I)GO TO 30350
30351 CONTINUE        
      IF(ISHSTR(1).LE.0.OR.NSTARS.EQ.0)GO TO 992    
30350 JTIME=0         
      Y=SHX 
      Z=SHY 
      IF(ISHD.ne.99)go to 100
	X=RANGE(Y,XQE,Z,YQE)      
      JTIME=JTIME+X/SHVX        
	go to 30336
100	continue
      DO 30339 I=1,10 
      J=ISHSTR(I)     
      IF(J.LE.0)GO TO 30333     
      IF(STARS(J,1).EQ.0.)GO TO 30333     
      X=RANGE(Y,STARS(J,1),Z,STARS(J,2))  
      Y=STARS(J,1)    
      Z=STARS(J,2)    
      JTIME=JTIME+X/SHVX        
      GO TO 30339     
30333 X=RANGE(Y,XQE,Z,YQE)      
      JTIME=JTIME+X/SHVX        
      GO TO 30336     
30339 CONTINUE        
      GO TO 992       
30336 WRITE(6,30337)JTIME       
30337 FORMAT(' ROUND TRIP TIME = ',I4,' STARMINUTES')         
      GO TO 4000      
30340 CALL CPAGE      
      IIKK=0
      WRITE(6,30341)  
30341 FORMAT(' COMMUNIQUE FROM STARFLEET COMMAND! '/'  THE CURRENT RANKS
     1 HAVE BEEN OBTAINED BY THE FOLLOWING OFFICERS:')        
30342 IRNK=14         
      IIKK=IIKK+1     
      READ(3,REC=IIKK,ERR=30347)MNAME,POINTS,MPASS,X6,X7    
      IF(MNAME.EQ.MOLDNM)GO TO 30347      
      MOLDNM=MNAME    
30344 IF(POINTS.GE.RANKPT(IRNK))GO TO 30345         
      IRNK=IRNK-1     
      GO TO 30344     
30345 WRITE(6,30346)RANKS(1,IRNK),RANKS(2,IRNK),MNAME,POINTS  
30346 FORMAT(2A8,' ',A8,' CURRENTLY HAS POINTS = ',F6.2)      
      GO TO 30342     
30347 READ(3,REC=MMKEY,ERR=4000)MNAME,POINTS,MPASS,X6,X7    
      GO TO 4000      
30370 ION=0 
      IF(ICLKON.EQ.IYES)ION=1   
      GO TO 4000      
30360 CALL QTIME(ITC) 
      ITM1=ITC/3600   
      ITC=ITC-ITM1*3600         
      ITM2=ITC/60     
      ITM3=ITC-ITM2*60
      WRITE(6,30361)ITM1,ITM2,ITM3        
30361 FORMAT(' CURRENT TIME FROM COMPUTER BANKS: ',I2,':',I2,':',I2)    
      GO TO 4000      
C     ...CANCELLED COMMAND DUE TO ILLEGAL REQUEST VALUE OR CHANGE IN    
C     ...SYSTEM STATUS.         
998   WRITE(6,996)    
      IF(ICM.EQ.6)ETR(1)=0.     
      IF(ICM.EQ.5)EFT(1,1)=0.   
      IF(ICM.EQ.4)EFP(1)=0.     
      PNRGY=0.        
996   FORMAT(' ***CANCELLED***')
      GO TO 4000      
C     ...ILLEGAL COMMAND AREA.  
994   WRITE(6,993)    
      IF(ICM.GE.4.AND.ICM.LE.6)GO TO 998  
993   FORMAT(' IMPOSSIBLE - HYPERSPACE!') 
      GO TO 4000      
C     ...NEW ONE HERE.
992   WRITE(6,991)    
991   FORMAT(' NOT UNDER E CONTROL OR OTHERWISE IMPOSSIBLE')  
C     ...FINISH UP.   
4000  CALL QTIME(JTIME)         
      NSTEPS=(JTIME-ISTART)+ITRSTP*ITFCTR 
      ISTART=JTIME    
      ITRSTP=0        
      IF(NSTEPS.LE.0)NSTEPS=1   
5000  RETURN
      END
                            5438
      if(lto.eq.6)go to 998                                          