SUBROUTINE MHOLE
C
C     * MOVE THE "BLACK HOLE" TOWARD THE NEAREST ACTIVE SHIP
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,FBASE
	BYTE MESSAG,INITLS,CHAR
	COMMON /TORPES/ XHOM(8,15),YHOM(8,15),TLOCS(8,15,3),TDIR(8,15)
C
C	DO ALL THE UNIVERSES
C
	DO 10500 KK=1,IUNIMX
C
C     * FIND CLOSEST SHIP
C
	DO 10009, L=1,IHOLE(KK)
	DM=1.6E37
	K=0
	DO 10001 I=1,8
	IF (.NOT.XSHIP(I).OR.IUNIV(I).NE.KK)  GO TO 10001
	D=((HX(KK,L)-XCORD(I))**2 + (HY(KK,L)-YCORD(I))**2)**.5
	IF (D.GE.DM)  GO TO 10001
	DM=D
	K=I
10001	CONTINUE
C
C    *FIND DIRECTION OF CLOSEST SHIP
C
	HDIS(KK,L)=DM
	IHWHO(KK,L)=K
	IF (K.EQ.0) HDIS(KK,L)=0
	IF (K.EQ.0) GO TO 10009
	D=ATAN2((YCORD(K)-HY(KK,L)),(XCORD(K)-HX(KK,L)))*180./3.14159
C
	HDIR(KK,L)=D
	CALL MOVE(HX(KK,L),HY(KK,L),X,Y,D,HWARP(KK,L),CHAR,IMAXX,IMAXY,KK)
	IF (CHAR.NE.'.'.AND.CHAR.NE.'+'.AND.CHAR.NE.'@'.AND.CHAR.NE.'^')
	1  GOTO 10016
C
C     * JUST MUNCH THIS JUNK DOWN
C
	IX=HX(KK,L)
	IY=HY(KK,L)
	IF (CHAR.NE.'^') GOTO 10017
	DO 20000 II=1,8
	DO 20000 IJ=1,8
	IIX = XHOM(II,IJ)
	IIY = YHOM(II,IJ)
	IIU = HUNI(II,IJ)
	IF (KK.NE.IIU.OR.IX.NE.IIX.OR.IY.NE.IIY) GOTO 20000
	XHOM(II,IJ)=0
	YHOM(II,IJ)=0
	IACTRP(II)=IACTRP(II)-1
	IF (IACTRP(II).LT.0) IACTRP(II)=0
	GOTO 10017
20000	CONTINUE
	WRITE (5,100)
100	FORMAT (' MHOLE -- Munched homer without finding owner.')
10017	CALL UNIVIN(IX,IY,'.',KK)
	IX=X
	IY=Y
	CALL UNIVIN(IX,IY,'#',KK)
	HX(KK,L)=X
	HY(KK,L)=Y
C
	GO TO  10015
C
C     * CAUGHT A SHIP
C
10016	IF (CHAR.LT.'1'.OR.CHAR.GT.'8') GOTO 10018
	DECODE(1,10020,CHAR) I
10020	FORMAT (I1)
	IF (.NOT.XSHIP(I)) GOTO 10021
	CALL SENT(I,15)
	CALL RESET(I)
	GO TO  10015
10021	IX=XCORD(I)
	IY=YCORD(I)
	JX=HX(KK,L)
	JY=HY(KK,L)
	HX(KK,L)=IX
	HY(KK,L)=IY
	XCORD(I)=JX
	YCORD(I)=JY
	CALL UNIVIN(IX,IY,'#',KK)
	CALL UNIVIN(JX,JY,CHAR,KK)
	GOTO 10015
C
C     * SWAP PLACES WITH BASES STARS ETC.
C
C	IF IT IS A BASE, CHANGE COORD'S FOR THE USER.
C	WE DON'T WANT A PLAYER TO LOSE STAR BASES
C
10018	IF (CHAR.NE.'B') GOTO 23001
	IX=X
	IY=Y
	IOFF=(KK-1)*20
	DO 23000, I=1,8
	DO 23000, J=1,ICNTRL(1)*2,2
	IF ((IBASE(I,IOFF+J).NE.IX).AND.(IBASE(I,IOFF+J+1).NE.IY))
	1   GOTO 23000
	IIX = HX(KK,L)
	IIY = HY(KK,L)
	IX=IBASE(I,IOFF+J)
	IY=IBASE(I,IOFF+J+1)
	HX(KK,L)= IX
	HY(KK,L)= IY
	IBASE(I,IOFF+J)= IIX
	IBASE(I,IOFF+J+1)= IIY
	CALL UNIVIN(IX,IY,'#',KK)
	CALL UNIVIN(IIX,IIY,'B',KK)
	GOTO 10024
23000	CONTINUE
	WRITE (5,101)IX,IY,KK
101	FORMAT (' MHOLE -- Failed to find base owner at ',I3,','
	1  ,I3,' UN = ',I1)
C	CALL VFY (7)
23001	IF (CHAR.EQ.'#') GOTO 10024
C
C	CAUGHT A FREIGHTER
C
	IF (CHAR.NE.'F') GOTO 23005
	IX=X
	IY=Y
	DO 23002, II =1,8
	IF (FLOAD(KK,II).EQ.0) GOTO 23002
	IIX = FXCORD(KK,II)
	IIY = FYCORD(KK,II)
	IF (IIX.NE.IX.OR.IIY.NE.IY) GOTO 23002
C
C	FOUND THE OWNER
C
	CALL SENT(II,39)
	FLOAD(KK,II) = 0
	CALL UNIVIN(IX,IY,'.',KK)
	GOTO 10024
23002	CONTINUE
	WRITE (5,23003) IX,IY
23003	FORMAT (' MHOLE -- Failed to find freighter owner at ',I3,',',I3)
C	CALL VFY (6)
23005	IF (CHAR.NE.'H') GOTO 23015
C
C	Relocate hyperspace ports to the desired coords
C
	IX=X
	IY=Y
	DO 23007, II = 1,6
	IF (IHYP(KK,II,1).EQ.IX.AND.IHYP(KK,II,2).EQ.IY) GOTO 23010
23007	CONTINUE
	WRITE (5,23008) IX,IY
23008	FORMAT (' MHOLE -- Failed to find hyper-space port at ',I3,',',I3)
	GOTO 23015
23010	IIX = HX(KK,L)
	IIY = HY(KK,L)
	IHYP(KK,II,1) = IIX
	IHYP(KK,II,2) = IIY
23015	IX=HX(KK,L)
	IY=HY(KK,L)
	CALL UNIVIN(IX,IY,CHAR,KK)
	IX=X
	IY=Y
	HX(KK,L)=IX
	HY(KK,L)=IY
	CALL UNIVIN(IX,IY,'#',KK)
10024	CONTINUE
10015	CONTINUE
10009	CONTINUE
C
10500	CONTINUE
C
	RETURN
	END