SUBROUTINE MHOMER
C
C     MOVE HOMING TORPEDOES
C
C     COMMON
      PARAMETER MAXSHP = 8, MAXHOM = 4, MAXTRP = 10
      COMMON/TORPE/TLOCS(MAXSHP, MAXTRP, 2), TDIR(MAXSHP, MAXTRP), IT(MA
     *XSHP)
      COMMON/TRKDAT/ENERGY(MAXSHP), SHIELD(MAXSHP), XCORD(MAXSHP), YCORD
     *(MAXSHP), TORPS(MAXSHP), HOLX, HOLY, HOLW, CDRAIN, NDRAIN, TDRAIN,
     * SCAN(MAXSHP), PHA(MAXSHP), I1, I2, HYPER(MAXSHP), ISENT(MAXSHP, 1
     *0), XPOD(MAXSHP), YPOD(MAXSHP), DPOD(MAXSHP), IPODST(MAXSHP), WPOD
     *(MAXSHP), XHOM(MAXSHP, MAXHOM), YHOM(MAXSHP, MAXHOM), WHOM(MAXSHP,
     * MAXHOM), NHOM(MAXSHP), TRBEAM(MAXSHP), SCORE(MAXSHP), CREW(MAXSHP
     *), DIR(MAXSHP), WARP(MAXSHP), LAUNCH(MAXSHP), UNIV(100, 100), MESS
     *AG(480), THRU, SHPACT(MAXSHP), CLOAK(MAXSHP), NET(MAXSHP), SHPNAM(
     *10, MAXSHP)
      REAL LAUNCH, NDRAIN
      INTEGER*2SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM
      LOGICAL*1THRU, SHPACT, CLOAK, NET
      BYTE UNIV, MESSAG
      BYTE SHPNAM
C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE
C       AND EMPTY SPACE.
C END COMMON
      COMMON/DOLOOP/SHIPS
      INTEGER SHIPS(8)
      BYTE CHAR
      LOGICAL*1MYTORP
C
      CALL PERM(SHIPS, I1, I2)
      DO 2000 I = 1, 8
        ISHP = SHIPS(I)
        DO 2020 IH = 1, MAXHOM
C TARGET SHIP TO HOME ON
          ITSHP = WHOM(ISHP, IH)
          IF (.NOT.(ITSHP .GT. 0)) GOTO 2040
C
C     * CHECK TO SEE IF IT'S STILL ACTIVE
C
            XH = XHOM(ISHP, IH)
            YH = YHOM(ISHP, IH)
            IX = XH
            IY = YH
            IF (.NOT.(UNIV(IX, IY) .EQ. '^')) GOTO 2060
C
C          * CALCULATE COURSE
C
              CALL DIRDIS(XH, YH, XCORD(ITSHP), YCORD(ITSHP), DIREC, DIS
     *)
              CALL MOVE(XH, YH, X, Y, DIREC, 10., CHAR, UNIV, ' ')
              KX = X
              KY = Y
              IF (.NOT.(CHAR .NE. ' ')) GOTO 2080
                IF (.NOT.(.NOT.MYTORP(ISHP, KX, KY, CHAR))) GOTO 2100
                  CALL THIT(ISHP, KX, KY, CHAR, DIREC, 300.)
                  UNIV(IX, IY) = ' '
                  WHOM(ISHP, IH) = 0
2100            CONTINUE
                GOTO 2090
2080           CONTINUE
                UNIV(IX, IY) = ' '
                UNIV(KX, KY) = '^'
                XHOM(ISHP, IH) = X
                YHOM(ISHP, IH) = Y
2090          CONTINUE
              GOTO 2070
2060         CONTINUE
              WHOM(ISHP, IH) = 0
2070        CONTINUE
            GOTO 2050
2040       CONTINUE
            IF (.NOT.(ITSHP .LT. 0)) GOTO 2120
C
C     * LAUNCH AT SHIP -ITSHP
C
C SHIP TO HOME ON
              ITSHP =  - ITSHP
              XH = XCORD(ISHP)
              YH = YCORD(ISHP)
              CALL DIRDIS(XH, YH, XCORD(ITSHP), YCORD(ITSHP), DIREC, DIS
     *)
              CALL MOVE(XH, YH, X, Y, DIREC, 10., CHAR, UNIV, ' ')
              KX = X
              KY = Y
              IX = XCORD(ISHP)
              IY = YCORD(ISHP)
              IF (.NOT.((IX .EQ. KX) .AND. (IY .EQ. KY))) GOTO 2140
C	   MAKE SURE IT MOVES OUT OF OUR SQUARE
                CALL MOVE(X, Y, X1, Y1, DIREC, 10., CHAR, UNIV, ' ')
                X = X1
                Y = Y1
2140          CONTINUE
              KX = X
              KY = Y
              IF (.NOT.(CHAR .NE. ' ')) GOTO 2160
                IF (.NOT.(.NOT.MYTORP(ISHP, KX, KY, CHAR))) GOTO 2180
                  CALL THIT(ISHP, KX, KY, CHAR, DIREC, 300.)
                  WHOM(ISHP, IH) = 0
2180            CONTINUE
                GOTO 2170
2160           CONTINUE
                UNIV(KX, KY) = '^'
                XHOM(ISHP, IH) = X
                YHOM(ISHP, IH) = Y
                WHOM(ISHP, IH) = ITSHP
2170          CONTINUE
2120        CONTINUE
2050      CONTINUE
2020    CONTINUE
2030    CONTINUE
2000  CONTINUE
2010  CONTINUE
      RETURN
      END