SUBROUTINE SETWARP
C*BEGIN COMMON 
      COMMON SNAP,SNAPSHT(226), 
     +   DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL,
     +   KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), 
     +   NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM,
     +   NSCKILL,ICRYSTL,NPLANKL, 
     +   QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20),  
     +   INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD,
     +   INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, 
     +   QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), 
     +   LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, 
     +   KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8),FUTURE(10), 
     +   DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,
     +   DAMFAC,SHLDCHG,THINGX,THINGY,NDEVICE,PLNETX,PLNETY,INORBIT,
     +   LANDED,IPLANET,IMINE,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT,
     +   IENTESC,ISCRAFT,ISATB,ISCATE,CRYPROB,ICITE,IPHWHO,BATX,BATY, 
     +   CRACKS(12) 
      INTEGER CF,CI,SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS,
     +   REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, 
     +   SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, 
     +   ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, 
     +   THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS
      REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD,   
     +   INENRG,INLSR 
	BYTE QUAD
	REAL*8 DEVICE,PASSWD
C*END COMMON 
	LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB
	1 ,IHSTAR,IHT,IHQUEST,IHNUM
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
	REAL*8 AITEM
	COMMON/SCANBF/KEY,AITEM
	EQUIVALENCE (FNUM,AITEM)
 10   CALL SCAN
      IF(KEY .NE. IHEOL) GO TO 20 
	CALL PROMPT(18H WARP FACTOR:      ,18)
      GO TO 10
20	IF(KEY .NE. IHREAL) GO TO 40
      IF(DAMAGE(6) .GT. 10.0) GO TO 70
      IF(DAMAGE(6) .GT. 0.0  .AND. FNUM .GT. 4.0) GO TO 80
      IF(FNUM .LT. 1.0) GO TO 50 
      IF(FNUM .GT. 10.0) GO TO 60
      OLDFAC=WARPFAC
      WARPFAC=FNUM 
      WFACSQ=WARPFAC*WARPFAC
C--------GIVE ACCEPTANCE MESSAGE FOR WARP FACTORS <= 6 OR REDUCED 
      IF(WARPFAC .LE. OLDFAC .OR. WARPFAC .LE. 6.0) GO TO 31
      IF(WARPFAC .LT. 8.00) GO TO 32 
	GO TO 33
 31   CALL CRAM(29HHELMSMAN SULU:  "WARP FACTOR ) 
      CALL CRAMF(WARPFAC,0,1) 
      CALL CRAMDMP(11H, CAPTAIN.")
      RETURN
C--------GIVE WARNING MESSAGES FOR WARP FACTORS ABOVE WARP 6
 32   CALL PROUT( 
     +  61HENGINEER SCOTT:  "AYE, BUT OUR MAXIMUM SAFE SPEED IS WARP 6."
     +   ,61)
      RETURN
 33   IF(WARPFAC .EQ. 10.0) GO TO 36
      CALL PROUT( 
     +   65HENGINEER SCOTT:  "AYE, CAPTAIN, BUT OUR ENGINES MAY NOT TAKE
     + IT.",65)
      RETURN
 36   CALL PROUT( 
     +   46HENGINEER SCOTT:  "AYE, CAPTAIN, WE'LL TRY IT.",46)       
      RETURN
C--------GIVE REFUSAL MESSAGES FOR BAD WARP COMMANDS
 40   CALL BEGPARD
      RETURN
 50   CALL PROUT( 
     +   52HHELMSMAN SULU:  "WE CAN'T GO BELOW WARP 1, CAPTAIN.",52) 
      RETURN
 60   CALL PROUT( 
     +   52HHELMSMAN SULU:  "OUR TOP SPEED IS WARP 10, CAPTAIN.",52) 
      RETURN
 70   CALL PROUT(25HWARP ENGINES INOPERATIVE.,25)
      RETURN
 80   CALL PROUT(45HENGINEER SCOTT:  "I'M DOING MY BEST, CAPTAIN,,45)
      CALL PROUT(41H  BUT RIGHT NOW WE CAN ONLY GO WARP 4."  ,41)    
      RETURN
      END