You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
404 lines
15 KiB
404 lines
15 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of 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 See packages/seacas/LICENSE for details
|
|
|
|
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 SUBROUTINE BISECT = FINDS CLOSEST PERPENDICULAR BISECTED LINE
|
|
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE CALLED BY:
|
|
C INPUT = INPUTS MESH DEFINITIONS FROM THE LIGHT TABLE
|
|
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINES CALLED:
|
|
C DLPARA = DETERMINES LINE PARAMETERS FROM TWO POINTS
|
|
|
|
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)
|
|
|
|
LOGICAL BIFIND, ADDLNK, NOROOM, ALPHA, TEST, MERGE, NUMPLT, NEWNUM
|
|
LOGICAL ADDCEN, CHANGE, ADJUST, ADDOLD, SIDEOK, GETMAX, SNAP
|
|
|
|
NUMPLT = .FALSE.
|
|
|
|
C FIND THE CLOSEST LINE ABOVE THE POINT INPUT
|
|
|
|
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 INPUT THE NEW POINT
|
|
|
|
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 INPUT THE NEW CENTER IF NEEDED
|
|
|
|
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 CALCULATE HOW TO DIVIDE UP THE ORIGINAL INERVALS
|
|
|
|
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 = (DBLE(NINT(L1))*D1)/(D1 + D2)
|
|
NN1 = MAX0(1, NN1)
|
|
NN2 = MAX0(1, NINT(L1) - NN1)
|
|
END IF
|
|
|
|
C INPUT THE ORIGINAL LINE
|
|
|
|
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 PLOT THE LINE
|
|
|
|
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 INPUT THE NEW LINE
|
|
|
|
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 INPUT THE NEW LINE'S FLAGS AND THEN LINK UP FLAGS FOR BOTH LINES
|
|
|
|
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 PLOT THE NEW LINE
|
|
|
|
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 UPDATE ANY REGION OR SIDE DEFINITIONS TO INCLUDE THE NEW LINES
|
|
|
|
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 GET THE MATCH POINTS FROM THE LAST LINE IN THE REGION
|
|
|
|
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 NOW LOOP THROUGH THE SIDES/LINES AND CHECK FOR REPLACEMENT
|
|
|
|
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 CHECK THE SIDE FOR LINE INCLUSION IF THE SIDE EXISTS, AND IT
|
|
C HAS NOT ALREADY BEEN FIXED (ISIDE(IPNTR) .LT. 0)
|
|
|
|
JJ = ISLIST(J)
|
|
KOUNT = 0
|
|
CHANGE = .FALSE.
|
|
KBEGIN = IFLINE(IPNTR)
|
|
KEND = IFLINE(IPNTR) + NLPS(IPNTR) - 1
|
|
|
|
C GET THE BEGINNING OF THE SIDE FOR SWITCHING
|
|
|
|
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 CHECK TO MAKE SURE THE TWO LINES DON'T NEED SWITCHING
|
|
|
|
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 INCLUDE THE LINE IN THE SIDE LIST IF NEEDED
|
|
|
|
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 FLAG THE SIDE DATA AS ALREADY FIXED
|
|
|
|
CALL LTSORT (MS, LINKS, ID, KK, ADDLNK)
|
|
IF (KK .GT. 0)ISIDE(KK) = -IABS(ISIDE(KK))
|
|
END IF
|
|
|
|
C CHECK THE LINE FOR INCLUSION
|
|
|
|
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 CHECK TO MAKE SURE THE TWO LINES DON'T NEED SWITCHING
|
|
|
|
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 RESTORE ALL THE FLAGGED SIDE DATA
|
|
|
|
DO 130 I = N3OLD + 1, N(3)
|
|
ISIDE(I) = IABS(ISIDE(I))
|
|
130 CONTINUE
|
|
ELSE
|
|
LASTP = 0
|
|
END IF
|
|
RETURN
|
|
END
|
|
|