      SUBROUTINE NEWQUAD
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,ISHIP
      COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, 
     +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB
     +,IHT,IHNUM  
      INTEGER QUADNUM 
	REAL*8 THOLIANX
      EQUIVALENCE (CRACKS(2),SHUTUP),(SHIP,ISHIP)
      EQUIVALENCE (KSTUF(1),ITHERE),(KSTUF(2),ITHX),(KSTUF(3),ITHY) 
	BYTE IHX
	DATA IHX/'X'/
	DATA THOLIANX/8HTHOLIANX/
      JUSTIN=1
	BASEX=0
	BASEY=0
	KLHERE=0
	COMHERE=0
	PLNETX=0
	PLNETY=0
	ISHERE=0
	IRHERE=0
	IPLANET=0
	NENHERE=0
	NEUTZ=0
	INORBIT=0
	LANDED=-1
	IENTESC=0
      ITHERE=0    
      IF(ISCATE .EQ. 0) GO TO 5 
C--------ENTERPRISE TRIED TO ESCAPE FROM A SUPER-COMMANDER. 
	ISCATE=0
	IENTESC=1
C--------EMPTY QUADRANT
5      DO 15 I=1,10
      DO 15 J=1,10
15    QUAD(I,J)=IHDOT 
      QUADNUM=GALAXY(QUADX,QUADY) 
C--------COPE IF QUADRANT CONTAINS ONLY A SUPERNOVA
      IF(QUADNUM .GT. 999) RETURN
      KLHERE=QUADNUM/100
	NEWNUM=NEWSTUF(QUADX,QUADY)
	IRHERE=NEWNUM/10
	NPLAN=NEWNUM-IRHERE*10
	NENHERE=KLHERE+IRHERE
C--------POSITION STARSHIP
      QUAD(SECTX,SECTY)=ISHIP
C-----------DECIDE IF THIS QUADRANT NEEDS A THOLIAN.....  
      IF((RANF(0).GT.0.08).AND.(PASSWD.NE.THOLIANX)) GO TO 23       
C--------DECIDE POSITION FOR THOLIAN......      
17    ITHX=INT(RANF(0)+0.5)*9+1       
      ITHY=INT(RANF(0)+0.5)*9+1       
      IF(QUAD(ITHX,ITHY).NE.IHDOT) GO TO 17     
      QUAD(ITHX,ITHY)=IHT   
      ITHERE = 2.*RANF(0.) + 1    
C---------PUT AN X IN EACH UNOCCUPIED CORNER. (TO RESERVE IT)       
	DO 20 I=1,10,9
	DO 20 J=1,10,9
20	IF(QUAD(I,J).EQ.IHDOT) QUAD(I,J)=IHX
23    CONTINUE    
C--------POSITION ORDINARY KLINGON VESSELS
      IF(QUADNUM .LT.100)GO TO 34 
      QUADNUM=QUADNUM-100*KLHERE
      DO 25 I=1,KLHERE
      CALL DROPIN(IHK,IX,IY)
	KX(I)=IX
	KY(I)=IY
 25   KPOWER(I)=RANF(0)*150.0+300.+25.*SKILL
C--------IF THIS QUADRANT NEEDS A COMMANDER, PROMOTE ONE KLINGON
      IF(REMCOM .EQ. 0) GO TO 32
      DO 30 I=1,REMCOM
      IF(CX(I) .EQ. QUADX .AND. CY(I) .EQ. QUADY)GO TO 31 
 30   CONTINUE
      GO TO 32
 31   QUAD(IX,IY)=IHC 
      KPOWER(KLHERE)=950.0+400.0*RANF(0)+50.*SKILL
      COMHERE=1 
      COMX=IX 
      COMY=IY 
C--------IF THIS QUADRANT NEEDS A SUPER-COMMANDER, PROMOTE ONE KLINGON. 
 32   I=KLHERE
      IF((QUADX .NE. ISX) .OR. (QUADY .NE. ISY)) GO TO 34 
      IF(COMHERE .EQ. 0) GO TO 33 
	I=KLHERE-1
	IX=KX(I)
	IY=KY(I)
 33   QUAD(IX,IY) = IHS 
      KPOWER(I)=1175.0+400.0*RANF(0)+125.0*SKILL
	ISCATE=1
	ISHERE=1
C--------PUT IN ROMULANS IF NEEDED. 
34	IF(IRHERE .EQ. 0) GO TO 37
      ITEMP1=KLHERE+1 
      DO 36 I=ITEMP1, NENHERE 
      CALL DROPIN(IHR,IX,IY)
	KX(I)=IX
	KY(I)=IY
 36   KPOWER(I)=450.+400.*RANF(0)+50.*SKILL 
37	CALL RESETD
	CALL SORTKL
C--------IF QUADRANT CONTAINS A STARBASE, CHOOSE ITS POSITION 
      IF(QUADNUM .LT. 10)GO TO 50     
      QUADNUM =QUADNUM - 10 
      CALL DROPIN(IHB,BASEX,BASEY)
C--------IF QUADRANT NEEDS A PLANET, PUT ONE IN.
 50   IF(NPLAN .EQ. 0) GO TO 54 
      DO 51 I=1,INPLAN
      IPLANET=I 
      IF(PLNETS(I,1) .EQ. QUADX .AND. PLNETS(I,2) .EQ. QUADY) GO TO 52
 51   CONTINUE
	IPLANET=0
	GO TO 54
 52   CALL DROPIN(IHP,PLNETX,PLNETY)
C--------AND FINALLY, THE STARS 
54    CALL NEWCOND
      IF(QUADNUM .LT. 1)GO TO 62
      DO 60I=1,QUADNUM
 60   CALL DROPIN(IHSTAR,IX,IY) 
C--------IF ROMULANS PRESENT WITHOUT KLINGONS OR BASE, PRINT SPECIAL MESSAGE. 
 62   IF((IRHERE .EQ. 0) .OR. (KLHERE .NE. 0) .OR. (BASEX .NE. 0))GOTO66
      IF(DAMAGE(9) .GT. 0.) GO TO 64
      CALL SKIP(1)
      CALL PROUT(41HLT. UHURA:  "CAPTAIN, AN URGENT MESSAGE.       ,41)
      CALL PROUT(31H  I'LL PUT IT ON AUDIO." CLICK    ,31) 
      CALL SKIP(1)
      CALL PROUT(58H  "INTRUDER!  YOU HAVE VIOLATED THE ROMULAN NEUTRAL       
     CZONE."    ,58) 
      CALL PROUT(44H  "LEAVE AT ONCE, OR YOU WILL BE DESTROYED!"    ,44)       
 64   NEUTZ=1 
C--------PUT IN "THING" IF NEEDED 
 66   IF(SHUTUP.NE.0.) GO TO 67       
      IF(THINGX.NE.QUADX .OR. THINGY.NE.QUADY) GO TO 67 
      CALL DROPIN(IHQUEST,IX,IY)
	THINGX=0
	THINGY=0
      IF(DAMAGE(1)) GO TO 67
      CALL SKIP(1)
       CALL PROUT(43HMR. SPOCK:  "CAPTAIN, THIS IS MOST UNUSUAL.,43)
       CALL PROUT(43H     PLEASE EXAMINE YOUR SHORT-RANGE SCAN.",43)
C--------DROP IN A FEW BLACK HOLES
 67   DO 68 I=1,3 
 68   IF(RANF(0) .GT. 0.89) CALL DROPIN(IHBLANK,IX,IY)    
C----------IF THOLIAN HERE, TAKE THE X OUT OF EACH CORNER.
      IF(ITHERE.EQ.0) RETURN
	DO 69 I=1,10
	DO 69 J=1,10
69	IF(QUAD(I,J).EQ.IHX) QUAD(I,J)=IHDOT
      RETURN      
      END 
