      SUBROUTINE SETUP
C*BEGIN COMMON 
      COMMON SNAP,SNAPSHT(247), 
     +   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,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY,
     +   QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20),  
     +   FUTURE(10),MESSAGE(5,10),
     +   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),
     +   DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE,
     +   DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET,
     +   IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT,
     +   IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO,
     +   CRACKS(12) 
      INTEGER 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  
      EQUIVALENCE (CRACKS(2),SHUTUP),(KSTUF(6),MESS)
C--------PREPARE THE ENTERPRISE 
      SHIP=IHE
	INENRG=5000.0
	ENERGY=5000.0
	INSHLD=2500.0
	SHLD=2500.0
	SHLDUP=0
	SHLDCHG=0
	INLSR=4.0
	LSUPRES=4.0
      CALL IRAN8(QUADX,QUADY) 
      CALL IRAN10(SECTX,SECTY)
	INTORPS=10
	TORPS=10
      WARPFAC=5.0 
      WFACSQ=25.0 
      DO 3 I=1,NDEVICE
3     DAMAGE(I)=0.0 
C--------SET UP ASSORTED GAME PARAMETERS
      SHUTUP=0.0
	MESS=0
	BATX=0
	BATY=0
      IDATE=31.0*RANF(0)+20.0 
	DATE=100*IDATE
	INDATE=DATE
	KILLK=0
	KILLC=0
	NKINKS=0
	NHELP=0
	RESTING=0
	CASUAL=0
	NROMKL=0
	ISATB=0
	ISCATE=0
	IMINE=0
	ICRYSTL=0
	ICRAFT=0
	NSCKILL=0
	NPLANKL=0
	ISCRAFT=1
	LANDED=-1
	CRYPROB=0.05
      ALIVE=1 
      DOCKFAC=0.25
      DO 4 I=1,8
      DO 4 J=1,8
      NEWSTUF(I,J)=0
4     STARCH(I,J)=0 
C--------INITIALIZE TIMES FOR EXTRANEOUS EVENTS 
      FUTURE(1)=DATE+EXPRAN(0.5*INTIME) 
      FUTURE(2)=DATE+EXPRAN(1.5*INTIME/REMCOM)
      FUTURE(3)=DATE+EXPRAN(0.5*INTIME) 
      FUTURE(4)=DATE+EXPRAN(0.3*INTIME) 
      FUTURE(5)=1E38 
      FUTURE(6)=1E38 
      IF(NSCREM.GT.0) FUTURE(6)=DATE+0.2777 
      FUTURE(7)=1E38 
C--------PUT STARS IN THE GALAXY
      INSTAR=0
      DO 5 I=1,8
      DO 5 J=1,8
      K = RANF(0) * 9 + 1 
      INSTAR=INSTAR+K 
5     GALAXY(I,J)=K 
      STARKL=0
C-------LOCATE STARBASES IN THE GALAXY (IMPROVED PLACEMENT) 
      DO 9 I=1,INBASE       
6     CALL IRAN8(IX,IY)     
      IF(GALAXY(IX,IY).GE.10) GOTO 6  
      IF(I.EQ.1) GOTO 8     
      LIM=I-1     
      DO 7 J=1,LIM
      DISTQ=(IX-BASEQX(J))**2 + (IY-BASEQY(J))**2 
      IF(DISTQ .LT. 6*(6-INBASE) .AND. RANF(0.) .LT. 0.75) GOTO 6   
7     CONTINUE    
8     BASEQX(I)=IX
      BASEQY(I)=IY
      STARCH(IX,IY)= -1     
9     GALAXY(IX,IY)=GALAXY(IX,IY)+10  
      BASEKL=0    
C--------POSITION ORDINARY KLINGON BATTLE CRUISERS
      KREM=INKLING-INCOM-NSCREM 
      KLUMPER=0.25*SKILL*(9-LENGTH)+1.0 
      KLUMPER=MIN0(9,KLUMPER) 
 10   KLUMP=(1.0-RANF(0)**2)*KLUMPER
      IF(KLUMP .GT. KREM) KLUMP=KREM
      NUM=100*KLUMP 
 15   CALL IRAN8(IX,IY) 
      IF(GALAXY(IX,IY)+NUM .GT. 999) GO TO 15 
      GALAXY(IX,IY)=GALAXY(IX,IY)+NUM 
      KREM=KREM-KLUMP 
      IF(KREM .NE. 0) GO TO 10
C--------POSITION KLINGON COMMAND SHIPS 
      DO 18 I=1,INCOM 
 16   CALL IRAN8(IX,IY) 
      IF(GALAXY(IX,IY).LT.99 .AND. RANF(0).LT.0.75) GO TO 16
      IF(GALAXY(IX,IY) .GT. 899)GO TO 16
      IF(I .EQ. 1)GO TO 17
      IM1=I-1 
      DO 1605 JJ=1,IM1
      IF(CX(JJ) .EQ. IX .AND. CY(JJ) .EQ. IY)GO TO 16 
1605  CONTINUE
17    GALAXY(IX,IY)=GALAXY(IX,IY)+100 
      CX(I)=IX
18    CY(I)=IY
C--------LOCATE PLANETS IN GALAXY 
      DO 20 I=1,INPLAN
 19   CALL IRAN8(IX,IY) 
      IF(NEWSTUF(IX,IY) .GT. 0) GO TO 19
	NEWSTUF(IX,IY)=1
	PLNETS(I,1)=IX
	PLNETS(I,2)=IY
C--------DECIDE WHAT KIND OF PLANET  M=1, N=2, O=3. 
      PLNETS(I,3)=RANF(0)*3. + 1.
C--------DECIDE WHETHER DILITHIUM CRYSTALS ARE PRESENT. 
      PLNETS(I,4)=1.2*RANF(0)
      PLNETS(I,5)=0
 20   CONTINUE
C--------LOCATE ROMULANS. 
      DO 21 I=1,NROMREM 
      CALL IRAN8(IX,IY) 
 21   NEWSTUF(IX,IY)=NEWSTUF(IX,IY)+10
C--------LOCATE THE SUPER-COMMANDER, IF NEEDED. 
      IF(NSCREM .LT. 1) GO TO 23
 22   CALL IRAN8(IX,IY) 
      IF(GALAXY(IX,IY) .GT. 899) GO TO 22 
	ISX=IX
	ISY=IY
      GALAXY(IX,IY)=GALAXY(IX,IY)+100 
 23   IDATE = DATE
      CALL SKIP(1)
      SNAP=0
C--------DECIDE IF GALAXY NEEDS A "THING" 
      IF((RANF(0) .GT. 0.04) .OR. (THINGX .EQ. -1)) GO TO 2301
      CALL IRAN8(THINGX,THINGY) 
      GO TO 24
2301	THINGX=0
	THINGY=0
C--------PRINT BRIEF INITIAL MESSAGE
 24   CALL CRAM('STARDATE') 
      CALL CRAMI(IDATE,5) 
      CALL CREND
      CALL CRAMI(INKLING,5) 
      CALL CRAMDMP(9H KLINGONS) 
      CALL PROUT(31HAN UNKNOWN NUMBER OF ROMULANS   ,31)   
      IF(NSCREM .EQ. 0) GO TO 25
      CALL PROUT(33HAND ONE (GULP) <SUPER-COMMANDER>.,33)
 25   CALL CRAMI(IFIX(INTIME),5)
      CALL CRAMDMP(10H STARDATES) 
      CALL CRAMI(INBASE,5)
      CALL CRAM(24H STARBASES:  QUADRANTS  )
      DO 50 I=1,INBASE
      CALL CRAMLOC(0,BASEQX(I),BASEQY(I)) 
      IF(I .LT. INBASE)CALL CRAM(2H,  ) 
50    CONTINUE
      CALL CREND
      CALL SKIP(1)
      CALL CRAM(30HTHE ENTERPRISE IS CURRENTLY IN)
      CALL CRAMLOC(1,QUADX,QUADY) 
      CALL CRAM(1H,)
      CALL CRAMLOC(2,SECTX,SECTY) 
      CALL CREND
	CALL SKIP(1)
	CALL CRAM(10HGOOD LUCK.)
      IF(NSCREM.GT.0)        CALL CRAM(17H  YOU'LL NEED IT.   ) 
      CALL CREND
      CALL NEWQUAD
      RETURN
      END 
