C    Copyright(C) 2014-2017 National Technology & Engineering Solutions of
C    Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C    NTESS, the U.S. Government retains certain rights in this software.
C    
C    Redistribution and use in source and binary forms, with or without
C    modification, are permitted provided that the following conditions are
C    met:
C    
C    * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C    
C    * Redistributions in binary form must reproduce the above
C      copyright notice, this list of conditions and the following
C      disclaimer in the documentation and/or other materials provided
C      with the distribution.
C    
C    * Neither the name of NTESS nor the names of its
C      contributors may be used to endorse or promote products derived
C      from this software without specific prior written permission.
C    
C    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C    OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
C    

C $Id: bisect.F,v 1.1 1998/04/10 04:30:07 gdsjaar Exp $
C $Log: bisect.F,v $
C Revision 1.1  1998/04/10 04:30:07  gdsjaar
C Added the ifdef needsdoubleescape to the graphics symbol
C plotting. Required moving some .f to .F files and specifying in Imakefile
C
C Revision 1.1.1.1  1990/11/30 11:04:02  gdsjaar
C FASTQ Version 2.0X
C
c Revision 1.1  90/11/30  11:04:00  gdsjaar
c Initial revision
c 
C
CC* FILE: [.MAIN]BISECT.FOR
CC* MODIFIED BY: TED BLACKER
CC* MODIFICATION DATE: 7/6/90
CC* MODIFICATION: COMPLETED HEADER INFORMATION
C
      SUBROUTINE BISECT (MP, ML, MS, MR, MSNAP, N, IPOINT, COOR, IPBOUN,
     &   ILINE, LTYPE, NINT, FACTOR, LCON, ILBOUN, ISBOUN, ISIDE, NLPS,
     &   IFLINE, ILLIST, IREGN, IMAT, NSPR, IFSIDE, ISLIST, IRPB, IPBF,
     &   NPPF, IFPB, LISTPB, ILBF, NLPF, IFLB, LISTLB, ISBF, NSPF, IFSB,
     &   LISTSB, LINKP, LINKL, LINKS, LINKR, LINKM, LINKPB, LINKLB,
     &   LINKSB, IHOLDP, IHOLDL, IHOLDS, IHOLDR, IHOLDM, IHOLD2, IHOLD3,
     &   IWTPBF, IWTLBF, IWTSBF, IRGFLG, X, Y, MERGE, LASTP, ALPHA,
     &   NOROOM, SNAP, SNAPDX, NSNAP)
C***********************************************************************
C
C  SUBROUTINE BISECT = FINDS CLOSEST PERPENDICULAR BISECTED LINE
C
C***********************************************************************
C
C  SUBROUTINE CALLED BY:
C     INPUT  = INPUTS MESH DEFINITIONS FROM THE LIGHT TABLE
C
C***********************************************************************
C
C  SUBROUTINES CALLED:
C     DLPARA = DETERMINES LINE PARAMETERS FROM TWO POINTS
C
C***********************************************************************
C
      DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP)
      DIMENSION ILINE(ML), LTYPE(ML), NINT(ML), FACTOR(ML), LCON(3, ML)
      DIMENSION ILBOUN(ML), ISBOUN(ML)
      DIMENSION ISIDE(MS), NLPS(MS), IFLINE(MS), ILLIST(MS*3)
      DIMENSION IREGN(MR), IMAT(MR), NSPR(MR), IFSIDE(MR), ISLIST(MR*4)
      DIMENSION IRPB(MR)
      DIMENSION IPBF(MP), NPPF(MP), IFPB(MP), LISTPB(2, MP)
      DIMENSION ILBF(ML), NLPF(ML), IFLB(ML), LISTLB(2, ML)
      DIMENSION ISBF(ML), NSPF(ML), IFSB(ML), LISTSB(2, ML)
      DIMENSION IWTPBF(3, MP), IWTLBF(3, ML), IWTSBF(3, ML)
      DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS), LINKR(2, MR)
      DIMENSION LINKM(2, (MS + MR)), LINKPB(2, MP), LINKLB(2, ML)
      DIMENSION LINKSB(2, ML)
      DIMENSION IHOLDP(2*MP), IHOLDL(ML*2), IHOLDR(2, MR), IHOLD2(2, ML)
      DIMENSION IHOLDM(2, (MS + MR)), IHOLD3(2, ML), IHOLDS(2, MS)
      DIMENSION IRGFLG(MR)
      DIMENSION N(29), SNAPDX(2, MSNAP), NSNAP(2)
C
      LOGICAL BIFIND, ADDLNK, NOROOM, ALPHA, TEST, MERGE, NUMPLT, NEWNUM
      LOGICAL ADDCEN, CHANGE, ADJUST, ADDOLD, SIDEOK, GETMAX, SNAP
C
      NUMPLT = .FALSE.
C
C  FIND THE CLOSEST LINE ABOVE THE POINT INPUT
C
      ADDLNK = .FALSE.
      TEST = .FALSE.
      GETMAX = .FALSE.
      N3OLD = N(3)
      CALL CLOSEL (MP, ML, N, COOR, ILINE, LTYPE, LCON, LINKP, LINKL,
     &   X, Y, BIFIND, IFIND, ADDCEN, XCHOLD, YCHOLD)
C
C  INPUT THE NEW POINT
C
      IF (BIFIND) THEN
         CALL LTSORT (ML, LINKL, IFIND, L1, ADDLNK)
         LT = LTYPE(L1)
         KNUM = ILINE(L1)
         CALL LINEPR (ML, MP, LINKP, LCON, L1, I1, I2, I3, J1, J2, J3)
         IF (.NOT.ALPHA) THEN
            CALL PLTSTD (1, 0.)
            CALL DLINE (MP, ML, COOR, LINKP, KNUM, LT, I1, I2, I3,
     &         NUMPLT, DUM1, DUM2, TEST, GETMAX, DUM3, DUM4, DUM5, DUM6)
            CALL PLTSTD (1, 7.)
            CALL PLTFLU
         END IF
CC
CC  ADJUST THE NEW POINT TO A SNAP GRID IF APPROPRIATE
CC
C         IF (SNAP) THEN
C            XTEST = X
C            YTEST = Y
C            CALL SNAPPT (MSNAP, SNAPDX, NSNAP, XTEST, YTEST)
CC
CC  CHECK TO MAKE SURE IT DOESN'T SNAP TO THE LINE END POINTS OR THE
CC  CENTER POINT OF THE ARC
CC
C            DIVX = MAX (ABS(XTEST), ABS(COOR(1, J1)), ABS(COOR(1, J2)),
C     &         ABS(COOR(1, J3)))
C            IF (DIVX .EQ. 0.0) DIVX = 1.0
C            DIVY = MAX (ABS(YTEST), ABS(COOR(2, J1)), ABS(COOR(2, J2)),
C     &         ABS(COOR(2, J3)))
C            IF (DIVY .EQ. 0.0) DIVY = 1.0
C            IF (.NOT.(((ABS(XTEST - COOR(1, J1))/DIVX .LT. 1.0E-6) .AND.
C     &         (ABS(YTEST - COOR(2, J1))/DIVY .LT. 1.0E-6))
C     &         .OR.
C     &         ((ABS(XTEST - COOR(1, J2))/DIVX .LT. 1.0E-6) .AND.
C     &         (ABS(YTEST - COOR(2, J2))/DIVY .LT. 1.0E-6))
C     &         .OR.
C     &         ((ABS(XTEST - COOR(1, J3))/DIVX .LT. 1.0E-6) .AND.
C     &         (ABS(YTEST - COOR(2, J3))/DIVY .LT. 1.0E-6)) ) ) THEN
C               X = XTEST
C               Y = YTEST
C            END IF
C         END IF
         JJ = N(18) + 1
         CALL INPOIN (MP, N(1), N(18), JJ, X, Y, NHOLDP, IHOLDP, IPOINT,
     &      COOR, IPBOUN, LINKP, MERGE, NOROOM)
         IF (NOROOM)RETURN
         LASTP = JJ
         CALL LTSORT (MP, LINKP, LASTP, I, ADDLNK)
         IF (.NOT.ALPHA) THEN
            CALL PLTSTD (1, 3.)
#if NeedsDoubleEscape
            CALL MPD2SY (1, COOR(1, I), COOR(2, I), '\\CX')
#else
            CALL MPD2SY (1, COOR(1, I), COOR(2, I), '\CX')
#endif
            CALL PLTSTD (1, 7.)
            CALL PLTFLU
         END IF
C
C  INPUT THE NEW CENTER IF NEEDED
C
         IF (ADDCEN) THEN
            JJ = N(18) + 1
            CALL INPOIN (MP, N(1), N(18), JJ, XCHOLD, YCHOLD, NHOLDP,
     &         IHOLDP, IPOINT, COOR, IPBOUN, LINKP, MERGE, NOROOM)
            IF (NOROOM)RETURN
            CALL LTSORT (MP, LINKP, JJ, I, ADDLNK)
            IF (.NOT.ALPHA) THEN
               CALL PLTSTD (1, 3.)
#if NeedsDoubleEscape
               CALL MPD2SY (1, COOR(1, I), COOR(2, I), '\\CX')
#else
               CALL MPD2SY (1, COOR(1, I), COOR(2, I), '\CX')
#endif
               CALL PLTSTD (1, 7.)
               CALL PLTFLU
            END IF
            I3 = JJ
         END IF
C
C  CALCULATE HOW TO DIVIDE UP THE ORIGINAL INERVALS
C
         IF (NINT(L1) .EQ. 0) THEN
            NN1 = 0
            NN2 = 0
         ELSE
            D1 = SQRT((COOR(1, J1) - COOR(1, J3))**2 +
     &         (COOR(2, J1) - COOR(2, J3))**2)
            D2 = SQRT((COOR(1, J2) - COOR(1, J3))**2 +
     &         (COOR(2, J2) - COOR(2, J3))**2)
            NN1 = (FLOAT(NINT(L1))*D1)/(D1 + D2)
            NN1 = MAX0(1, NN1)
            NN2 = MAX0(1, NINT(L1) - NN1)
         END IF
C
C  INPUT THE ORIGINAL LINE
C
         FACT = FACTOR(L1)
         ILB = ILBOUN(L1)
         ISB = ISBOUN(L1)
         KNUM = 0
         IF (LT .GT. 3)LT = 3
         CALL INLINE (ML, N(2), N(19), IFIND, LT, I1, LASTP, I3, NN1,
     &      FACT, NHOLDL, IHOLDL, ILINE, LTYPE, NINT, FACTOR, LCON,
     &      ILBOUN, ISBOUN, LINKL, MERGE, NOROOM)
         IF (NOROOM)RETURN
C
C  PLOT THE LINE
C
         IF (.NOT.ALPHA) THEN
            CALL DLINE (MP, ML, COOR, LINKP, KNUM, LT, I1, LASTP, I3,
     &         NUMPLT, DUM1, DUM2, TEST, GETMAX, DUM3, DUM4, DUM5, DUM6)
            CALL PLTFLU
         END IF
C
C  INPUT THE NEW LINE
C
         JJ = N(19) + 1
         CALL INLINE (ML, N(2), N(19), JJ, LT, LASTP, I2, I3, NN2, FACT,
     &      NHOLDL, IHOLDL, ILINE, LTYPE, NINT, FACTOR, LCON, ILBOUN,
     &      ISBOUN, LINKL, MERGE, NOROOM)
         IF (NOROOM)RETURN
C
C  INPUT THE NEW LINE'S FLAGS AND THEN LINK UP FLAGS FOR BOTH LINES
C
         SIDEOK = .TRUE.
         NHOLD2 = 0
         IF (ILB .NE. 0) THEN
            ADDOLD = .TRUE.
            CALL INBOUN (ML, ILB, 1, N(19), N(26), N(13), N(14), IDUM,
     &         MERGE, NOROOM, NEWNUM, NHOLD2, IHOLD2, ILBF, NLPF, IFLB,
     &         LISTLB, LINKLB, IWTLBF, JHOLD, ADDOLD)
            IF (NOROOM)RETURN
            SIDEOK = .TRUE.
            CALL LINKBC (ML, MS, 1, N(13), N(2), N(26), N(13), N(14),
     &         N(20), ILBF, IFLB, NLPF, LISTLB, NLPS, IFLINE, ILLIST,
     &         ILBOUN, LINKLB, IWTLBF, LINKL, LINKS, SIDEOK, NOROOM)
            IF (NOROOM)RETURN
         END IF
         NHOLD3 = 0
         IF (ISB .NE. 0) THEN
            ADDOLD = .TRUE.
            CALL INBOUN (ML, ISB, 1, N(19), N(27), N(15), N(16), IDUM,
     &         MERGE, NOROOM, NEWNUM, NHOLD3, IHOLD3, ISBF, NSPF, IFSB,
     &         LISTSB, LINKSB, IWTSBF, JHOLD, ADDOLD)
            SIDEOK = .TRUE.
            CALL LINKBC (ML, MS, 1, N(15), N(2), N(27), N(15), N(16),
     &         N(20), ISBF, IFSB, NSPF, LISTSB, NLPS, IFLINE, ILLIST,
     &         ISBOUN, LINKSB, IWTSBF, LINKL, LINKS, SIDEOK, NOROOM)
            IF (NOROOM)RETURN
         END IF
C
C  PLOT THE NEW LINE
C
         IF (.NOT.ALPHA) THEN
            CALL DLINE (MP, ML, COOR, LINKP, KNUM, LT, LASTP, I2, I3,
     &         NUMPLT, DUM1, DUM2, TEST, GETMAX, DUM3, DUM4, DUM5, DUM6)
            CALL PLTFLU
         END IF
C
C  UPDATE ANY REGION OR SIDE DEFINITIONS TO INCLUDE THE NEW LINES
C
         IEND = N(22)
         DO 120 I = 1, IEND
            CALL LTSORT (MR, LINKR, I, II, ADDLNK)
            IF (II .GT. 0) THEN
               ADJUST = .FALSE.
               KKOUNT = 0
C
C  GET THE MATCH POINTS FROM THE LAST LINE IN THE REGION
C
               JBEGIN = IFSIDE(II)
               JEND = IFSIDE(II) + NSPR(II) - 1
               CALL LTSORT (MS, LINKS, ISLIST(JEND), IPNTR, ADDLNK)
               IF ((ISLIST(JEND) .GT. 0) .AND. (IPNTR .GT. 0)) THEN
                  KFIRST = IFLINE(IPNTR) + NLPS(IPNTR) - 1
                  CALL LTSORT (ML, LINKL, ILLIST(KFIRST), KK, ADDLNK)
                  IF (KK .GT. 0.) THEN
                     J1END = LCON(1, KK)
                     J2END = LCON(2, KK)
                  ELSE
                     J1END = 0
                     J2END = 0
                  END IF
                  KEND = IFLINE(IPNTR) + NLPS(IPNTR) - 1
                  CALL LTSORT (ML, LINKL, ILLIST(KEND), KK, ADDLNK)
                  IF (KK .GT. 0.) THEN
                     I1END = LCON(1, KK)
                     I2END = LCON(2, KK)
                  ELSE
                     I1END = 0
                     I2END = 0
                  END IF
               ELSE IF (ISLIST(JEND) .LT. 0) THEN
                  JJ = IABS(ISLIST(JEND))
                  CALL LTSORT (ML, LINKL, JJ, KK, ADDLNK)
                  IF (KK .GT. 0.) THEN
                     I1END = LCON(1, KK)
                     I2END = LCON(2, KK)
                  ELSE
                     I1END = 0
                     I2END = 0
                  END IF
                  J1END = 0
                  J2END = 0
               ELSE
                  I1END = 0
                  I2END = 0
                  J1END = 0
                  J2END = 0
               END IF
C
C  NOW LOOP THROUGH THE SIDES/LINES AND CHECK FOR REPLACEMENT
C
               DO 110 J = JBEGIN, JEND
                  KKOUNT = KKOUNT + 1
                  IHOLDL(KKOUNT) = ISLIST(J)
                  CALL LTSORT (MS, LINKS, ISLIST(J), IPNTR, ADDLNK)
                  IF ((ISLIST(J) .GT. 0) .AND. (IPNTR .GT. 0) .AND.
     &               (ISIDE(IPNTR) .GT. 0)) THEN
C
C  CHECK THE SIDE FOR LINE INCLUSION IF THE SIDE EXISTS, AND IT
C  HAS NOT ALREADY BEEN FIXED (ISIDE(IPNTR)  .LT.  0)
C
                     JJ = ISLIST(J)
                     KOUNT = 0
                     CHANGE = .FALSE.
                     KBEGIN = IFLINE(IPNTR)
                     KEND = IFLINE(IPNTR) + NLPS(IPNTR) - 1
C
C  GET THE BEGINNING OF THE SIDE FOR SWITCHING
C
                     CALL LTSORT (ML, LINKL, ILLIST(KBEGIN), KK, ADDLNK)
                     IF (KK .GT. 0.) THEN
                        J1END = LCON(1, KK)
                        J2END = LCON(2, KK)
                     ELSE
                        J1END = 0
                        J2END = 0
                     END IF
                     DO 100 K = KBEGIN, KEND
                        KOUNT = KOUNT + 1
                        IHOLDP(KOUNT) = ILLIST(K)
                        CALL LTSORT (ML, LINKL, ILLIST(K), KK, ADDLNK)
                        IF ((KK .GT. 0.) .AND.
     &                     (ILLIST(K) .EQ. IFIND)) THEN
                           CHANGE = .TRUE.
                           KOUNT = KOUNT + 1
                           IHOLDP(KOUNT) = N(19)
C
C  CHECK TO MAKE SURE THE TWO LINES DON'T NEED SWITCHING
C
                           IF ((I2 .EQ. I1END) .OR.
     &                        (I2 .EQ. I2END)) THEN
                              I1END = I1
                              I2END = LASTP
                              IHOLDP(KOUNT) = IHOLDP(KOUNT - 1)
                              IHOLDP(KOUNT - 1) = N(19)
                           ELSE
                              I1END = LASTP
                              I2END = I2
                           END IF
                        ELSE IF (KK .GT. 0) THEN
                           I1END = LCON(1, KK)
                           I2END = LCON(2, KK)
                        ELSE
                           I1END = 0
                           I2END = 0
                        END IF
  100                CONTINUE
C
C  INCLUDE THE LINE IN THE SIDE LIST IF NEEDED
C
                     IF (CHANGE) THEN
                        ID = JJ
                        CALL INSIDE (MS, N(3), N(4), N(20), JJ, IHOLDP,
     &                     KOUNT, ISIDE, NLPS, IFLINE, ILLIST, LINKS,
     &                     NHOLDS, IHOLDS, MERGE, NOROOM)
                        IF (NOROOM)RETURN
C
C  FLAG THE SIDE DATA AS ALREADY FIXED
C
                        CALL LTSORT (MS, LINKS, ID, KK, ADDLNK)
                        IF (KK .GT. 0)ISIDE(KK) = -IABS(ISIDE(KK))
                     END IF
C
C  CHECK THE LINE FOR INCLUSION
C
                  ELSE IF (ISLIST(J) .LT. 0) THEN
                     JJ = IABS(ISLIST(J))
                     CALL LTSORT (ML, LINKL, JJ, KK, ADDLNK)
                     IF ((KK .GT. 0.) .AND. (JJ .EQ. IFIND)) THEN
                        ADJUST = .TRUE.
                        KKOUNT = KKOUNT + 1
                        IHOLDL(KKOUNT) = -N(19)
C
C  CHECK TO MAKE SURE THE TWO LINES DON'T NEED SWITCHING
C
                        IF ((I2 .EQ. I1END) .OR. (I2 .EQ. I2END) .OR.
     &                     (I2 .EQ. J1END) .OR. (I2 .EQ. J2END)) THEN
                           I1END = I1
                           I2END = LASTP
                           IHOLDL(KKOUNT) = IHOLDL(KKOUNT - 1)
                           IHOLDL(KKOUNT - 1) = -N(19)
                        ELSE
                           I1END = LASTP
                           I2END = I2
                        END IF
                     ELSE IF (KK .GT. 0) THEN
                        I1END = LCON(1, KK)
                        I2END = LCON(2, KK)
                     ELSE
                        I1END = 0
                        I2END = 0
                     END IF
                     J1END = 0
                     J2END = 0
                  END IF
  110          CONTINUE
               IF (ADJUST) THEN
                  IMTRL = IMAT(II)
                  ID = I
                  CALL INREGN (MS, MR, N(7), N(8), N(22), N(23), ID,
     &               IMTRL, IHOLDL, KKOUNT, IREGN, IMAT, NSPR, IFSIDE,
     &               ISLIST, LINKR, LINKM, NHOLDR, IHOLDR, NHOLDM,
     &               IHOLDM, IRGFLG, MERGE, NOROOM)
                  IF (NOROOM)RETURN
               END IF
            END IF
  120    CONTINUE
C
C  RESTORE ALL THE FLAGGED SIDE DATA
C
         DO 130 I = N3OLD + 1, N(3)
            ISIDE(I) = IABS(ISIDE(I))
  130    CONTINUE
      ELSE
         LASTP = 0
      END IF
      RETURN
      END
