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.
171 lines
6.1 KiB
171 lines
6.1 KiB
2 years ago
|
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 ERASE (MP, ML, MS, MR, N, COOR, ILINE, LTYPE, LCON,
|
||
|
|
& NLPS, IFLINE, ILLIST, NSPR, IFSIDE, ISLIST, LINKP, LINKL,
|
||
|
|
& LINKS, LINKR, IBAD, ALPHA)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE ERASE = ERASES A POINT, AND ALL DATA DEPENDENT ON THAT
|
||
|
|
C POINT (I.E. LINES, SIDES, OR REGIONS)
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION COOR (2, MP), ILINE (ML), LTYPE (ML), LCON (3, ML)
|
||
|
|
DIMENSION NLPS (MS)
|
||
|
|
DIMENSION IFLINE (MS), ILLIST (MS * 3), NSPR (MR), IFSIDE (MR)
|
||
|
|
DIMENSION ISLIST (MR * 4)
|
||
|
|
DIMENSION LINKP (2, MP), LINKL (2, ML), LINKS (2, MS)
|
||
|
|
DIMENSION LINKR (2, MR)
|
||
|
|
DIMENSION N (29)
|
||
|
|
|
||
|
|
LOGICAL NUMPLT, ALPHA, ADDLNK, TEST, GETMAX
|
||
|
|
|
||
|
|
IZ = 0
|
||
|
|
KNUM = 0
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
TEST = .FALSE.
|
||
|
|
GETMAX = .FALSE.
|
||
|
|
|
||
|
|
C ERASE ANY REGIONS USING THAT POINT
|
||
|
|
|
||
|
|
DO 140 I = 1, N (22)
|
||
|
|
CALL LTSORT (MR, LINKR, I, II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
DO 130 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 110 K = IFLINE (JJ), IFLINE (JJ) + NLPS (JJ) - 1
|
||
|
|
CALL LTSORT (ML, LINKL, ILLIST (K), KK, ADDLNK)
|
||
|
|
IF (KK .GT. 0) THEN
|
||
|
|
DO 100 L = 1, 2
|
||
|
|
IF (IBAD .EQ. LCON (L, KK)) THEN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
100 CONTINUE
|
||
|
|
IF (IBAD .EQ. LCON (3, KK)) THEN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
ELSEIF (ISLIST (J) .LT. 0) THEN
|
||
|
|
JJ = IABS (ISLIST (J))
|
||
|
|
CALL LTSORT (ML, LINKL, JJ, KK, ADDLNK)
|
||
|
|
IF (KK .GT. 0) THEN
|
||
|
|
DO 120 L = 1, 2
|
||
|
|
IF (IBAD .EQ. LCON (L, KK)) THEN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
120 CONTINUE
|
||
|
|
IF (IBAD .EQ. LCON (3, KK)) THEN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
130 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
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
140 CONTINUE
|
||
|
|
|
||
|
|
C ERASE ANY SIDES USING THAT POINT
|
||
|
|
|
||
|
|
DO 180 I = 1, N (20)
|
||
|
|
CALL LTSORT (MS, LINKS, I, II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
DO 160 J = IFLINE (II), NLPS (II) + IFLINE (II) - 1
|
||
|
|
CALL LTSORT (ML, LINKL, ILLIST (J), JJ, ADDLNK)
|
||
|
|
DO 150 K = 1, 3
|
||
|
|
IF (IBAD .EQ. LCON (K, JJ)) THEN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MS, LINKS, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
GOTO 170
|
||
|
|
ENDIF
|
||
|
|
150 CONTINUE
|
||
|
|
160 CONTINUE
|
||
|
|
170 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
180 CONTINUE
|
||
|
|
|
||
|
|
C ERASE ANY LINES USING THAT POINT
|
||
|
|
|
||
|
|
DO 210 I = 1, N (19)
|
||
|
|
CALL LTSORT (ML, LINKL, I, II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
DO 190 J = 1, 3
|
||
|
|
IF (IBAD .EQ. LCON (J, II)) 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
|
||
|
|
ENDIF
|
||
|
|
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
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (ML, LINKL, I, IZ, ADDLNK)
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
GOTO 200
|
||
|
|
ENDIF
|
||
|
|
190 CONTINUE
|
||
|
|
200 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
210 CONTINUE
|
||
|
|
|
||
|
|
C DELETE THE POINT
|
||
|
|
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
CALL LTSORT (MP, LINKP, IBAD, II, ADDLNK)
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MP, LINKP, IBAD, IZ, ADDLNK)
|
||
|
|
IF (.NOT.ALPHA) THEN
|
||
|
|
#if NeedsDoubleEscape
|
||
|
|
CALL MPD2SY (1, COOR (1, II), COOR (2, II), '\\CX')
|
||
|
|
#else
|
||
|
|
CALL MPD2SY (1, COOR (1, II), COOR (2, II), '\CX')
|
||
|
|
#endif
|
||
|
|
CALL PLTFLU
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|