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.
124 lines
4.1 KiB
124 lines
4.1 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 ERASEL (MP, ML, MS, MR, N, COOR, ILINE, LTYPE, LCON,
|
|
& NLPS, IFLINE, ILLIST, NSPR, IFSIDE, ISLIST, LINKP, LINKL,
|
|
& LINKS, LINKR, IBAD, ALPHA)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE ERASEL = ERASES A LINE, AND ALL DATA DEPENDENT ON THAT
|
|
C LINE (I.E. SIDES OR REGIONS)
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION COOR(2, MP), ILINE(ML), LTYPE(ML), LCON(3, ML), NLPS(MS)
|
|
DIMENSION NSPR(MR), IFLINE(MS), ILLIST(MS*3), IFSIDE(MR)
|
|
DIMENSION ISLIST(MR*4), LINKP(2, MP), LINKL(2, ML), LINKS(2, MS)
|
|
DIMENSION LINKR(2, MR), N(29)
|
|
|
|
LOGICAL NUMPLT, ALPHA, ADDLNK, TEST, GETMAX
|
|
|
|
IZ = 0
|
|
KNUM = 0
|
|
ADDLNK = .FALSE.
|
|
TEST = .FALSE.
|
|
GETMAX = .FALSE.
|
|
|
|
C ERASE ANY REGIONS USING THAT LINE
|
|
|
|
DO 120 I = 1, N(22)
|
|
CALL LTSORT(MR, LINKR, I, II, ADDLNK)
|
|
IF (II .GT. 0) THEN
|
|
DO 110 J = IFSIDE(II), IFSIDE(II) + NSPR(II) - 1
|
|
CALL LTSORT(MS, LINKS, ISLIST(J), IPNTR, ADDLNK)
|
|
IF ((ISLIST(J) .GT. 0) .AND. (IPNTR .GT. 0)) THEN
|
|
JJ = ISLIST(J)
|
|
DO 100 K = IFLINE(JJ), IFLINE(JJ) + NLPS(JJ) - 1
|
|
KK = ILLIST(K)
|
|
IF (KK .EQ. IBAD) THEN
|
|
ADDLNK = .TRUE.
|
|
CALL LTSORT(MR, LINKR, I, IZ, ADDLNK)
|
|
ADDLNK = .FALSE.
|
|
END IF
|
|
100 CONTINUE
|
|
ELSE IF (ISLIST(J) .LT. 0) THEN
|
|
JJ = IABS(ISLIST(J))
|
|
IF (JJ .EQ. IBAD) THEN
|
|
ADDLNK = .TRUE.
|
|
CALL LTSORT(MR, LINKR, I, IZ, ADDLNK)
|
|
ADDLNK = .FALSE.
|
|
END IF
|
|
END IF
|
|
110 CONTINUE
|
|
|
|
CALL LTSORT(MR, LINKR, I, IPNTR, ADDLNK)
|
|
IF ((.NOT.ALPHA) .AND. (IPNTR .LE. 0)) THEN
|
|
CALL REGEXT (MP, ML, MS, MR, N, II, COOR, ILINE,
|
|
& LTYPE, LCON, NLPS, IFLINE, ILLIST, NSPR, IFSIDE,
|
|
& ISLIST, LINKP, LINKL, LINKS, LINKR, XMIN, XMAX,
|
|
& YMIN, YMAX)
|
|
XMID = (XMAX + XMIN)/2.
|
|
YMID = (YMAX + YMIN)/2.
|
|
#if NeedsDoubleEscape
|
|
CALL MPD2SY(1, XMID, YMID, '\\CDI')
|
|
#else
|
|
CALL MPD2SY(1, XMID, YMID, '\CDI')
|
|
#endif
|
|
CALL PLTFLU
|
|
END IF
|
|
END IF
|
|
120 CONTINUE
|
|
|
|
C ERASE ANY SIDES USING THAT LINE
|
|
|
|
DO 150 I = 1, N(20)
|
|
CALL LTSORT(MS, LINKS, I, II, ADDLNK)
|
|
IF (II .GT. 0) THEN
|
|
DO 130 J = IFLINE(II), NLPS(II) + IFLINE(II) - 1
|
|
JJ = ILLIST(J)
|
|
IF (JJ .EQ. IBAD) THEN
|
|
ADDLNK = .TRUE.
|
|
CALL LTSORT(MS, LINKS, I, IZ, ADDLNK)
|
|
ADDLNK = .FALSE.
|
|
GO TO 140
|
|
END IF
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
END IF
|
|
150 CONTINUE
|
|
|
|
C DELETE THE LINE
|
|
|
|
CALL LTSORT(ML, LINKL, IBAD, II, ADDLNK)
|
|
IF (II .GT. 0) THEN
|
|
LT = LTYPE(II)
|
|
IP1 = LCON(1, II)
|
|
IP2 = LCON(2, II)
|
|
IP3 = LCON(3, II)
|
|
CALL LTSORT(MP, LINKP, IP1, IPNTR1, ADDLNK)
|
|
CALL LTSORT(MP, LINKP, IP2, IPNTR2, ADDLNK)
|
|
IF (IP3 .NE. 0) THEN
|
|
CALL LTSORT(MP, LINKP, IABS(IP3), IPNTR3, ADDLNK)
|
|
ELSE
|
|
IPNTR3 = 0
|
|
END IF
|
|
IF ((IPNTR1 .GT. 0) .AND. (IPNTR2 .GT. 0) .AND.
|
|
& ((LT .EQ. 1) .OR. (IPNTR3 .GT. 0))) THEN
|
|
IF (.NOT.ALPHA) THEN
|
|
CALL DLINE(MP, ML, COOR, LINKP, KNUM, LT, IP1, IP2,
|
|
& IP3, NUMPLT, DUM1, DUM2, TEST, GETMAX, DUM3, DUM4,
|
|
& DUM5, DUM6)
|
|
CALL PLTFLU
|
|
END IF
|
|
END IF
|
|
ADDLNK = .TRUE.
|
|
CALL LTSORT(ML, LINKL, IBAD, IZ, ADDLNK)
|
|
ADDLNK = .FALSE.
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
END
|
|
|