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.
337 lines
12 KiB
337 lines
12 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
|
|
|
|
C=======================================================================
|
|
SUBROUTINE HIDEDG (HIDEF, HIDENP, LENF, NLNKE, NLNKF, LINKF,
|
|
& NOTSEL, IELBST, IEDSET, NEDGES, NREF, LREF, MREF,
|
|
* ISBACK, NAMELB)
|
|
C=======================================================================
|
|
|
|
C --*** HIDEDG *** (MESH) Identify 3D lines on edge of visible mesh
|
|
C -- Written by Amy Gilkey - revised 02/26/88
|
|
C --
|
|
C --HIDEDG finds all lines that may make up the visible edge of the mesh.
|
|
C --"Edges" are lines of partially visible faces or lines of
|
|
C --totally visible faces which have no matching edge.
|
|
C --
|
|
C --Parameters:
|
|
C -- HIDEF(i) - IN - true iff face i is hidden
|
|
C -- HIDENP - IN - node status (as in HIDDEN)
|
|
C -- LENF - IN - the cumulative face counts by element block
|
|
C -- NLNKE - IN - the number of nodes per element
|
|
C -- NLNKF - IN - the number of nodes per face
|
|
C -- LINKF - IN - the connectivity for all faces
|
|
C -- NOTSEL - IN - true iff faces with selected element blocks
|
|
C -- are not needed
|
|
C -- IELBST - IN - the element block status (>0 if selected)
|
|
C -- IEDSET - OUT - the edge line set; (0) = face defining edge
|
|
C -- NEDGES - OUT - the number of lines in the edge set
|
|
C -- NREF - SCRATCH - the number of references to a node in the edge set;
|
|
C -- length = NUMNPF
|
|
C -- LREF - SCRATCH - the last edge set index of a node in the edge set;
|
|
C -- length = NUMNPF
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NELBLK of /DBNUMS/
|
|
C -- Uses NUMNPF of /D3NUMS/
|
|
|
|
PARAMETER (KFVIS=0, KFNODH=10, KFPOUT=20, KFOUT=90, KFAWAY=100)
|
|
PARAMETER (KNVIS=0, KNFOVR=10, KNHID=100)
|
|
|
|
common /debugc/ cdebug
|
|
common /debugn/ idebug
|
|
character*8 cdebug
|
|
|
|
include 'dbnums.blk'
|
|
COMMON /D3NUMS/ IS3DIM, NNPSUR, NUMNPF, LLNSET
|
|
LOGICAL IS3DIM
|
|
|
|
INTEGER HIDEF(*)
|
|
INTEGER HIDENP(*)
|
|
INTEGER LENF(0:NELBLK)
|
|
INTEGER NLNKE(NELBLK)
|
|
INTEGER NLNKF(NELBLK)
|
|
INTEGER LINKF(*)
|
|
LOGICAL NOTSEL
|
|
INTEGER IELBST(NELBLK)
|
|
INTEGER IEDSET(0:2,*)
|
|
INTEGER NREF(NUMNPF), LREF(NUMNPF), MREF(NUMNPF)
|
|
LOGICAL ISBACK(NUMNPF)
|
|
CHARACTER*(*) NAMELB(*)
|
|
|
|
LOGICAL ANYBRI, ANYSHE
|
|
|
|
ANYBRI = .FALSE.
|
|
ANYSHE = .FALSE.
|
|
DO 100 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .GT. 4) ANYBRI = .TRUE.
|
|
IF (NAMELB(IELB)(:3) .EQ. 'TET') ANYBRI = .TRUE.
|
|
IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .NE. 'TET')
|
|
$ ANYSHE = .TRUE.
|
|
100 CONTINUE
|
|
|
|
CALL INIINT (NUMNPF, 0, LREF)
|
|
|
|
IF (.NOT. ANYBRI) GOTO 200
|
|
|
|
C --Mark nodes in faces that point away
|
|
|
|
CALL INILOG (NUMNPF, .FALSE., ISBACK)
|
|
|
|
DO 130 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .GT. 4 .OR. NAMELB(IELB)(:3) .eq. 'TET') THEN
|
|
IXL0 = IDBLNK (IELB, 0, LENF, NLNKF) - 1
|
|
DO 120 IFAC = LENF(IELB-1)+1, LENF(IELB)
|
|
IF (HIDEF(IFAC) .GE. KFAWAY) THEN
|
|
DO 110 ILINK = 1, NLNKF(IELB)
|
|
ISBACK(LINKF(IXL0+ILINK)) = .TRUE.
|
|
110 CONTINUE
|
|
END IF
|
|
IXL0 = IXL0 + NLNKF(IELB)
|
|
120 CONTINUE
|
|
END IF
|
|
130 CONTINUE
|
|
|
|
NEDGES = 0
|
|
nmov = 0
|
|
DO 190 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .GT. 4 .OR. NAMELB(IELB)(:3) .eq. 'TET') THEN
|
|
|
|
C --Eliminate faces of a selected element block
|
|
IF (NOTSEL .AND. (IELBST(IELB) .GT. 0)) GOTO 190
|
|
|
|
DO 180 IFAC = LENF(IELB-1)+1, LENF(IELB)
|
|
IF (HIDEF(IFAC) .LT. KFOUT) THEN
|
|
IXL0 = IDBLNK (IELB, IFAC, LENF, NLNKF) - 1
|
|
|
|
C --Eliminate faces that do not have any nodes in faces
|
|
C --that point away
|
|
|
|
NBACK = 0
|
|
DO 140 ILINK = 1, NLNKF(IELB)
|
|
IF (ISBACK(LINKF(IXL0+ILINK))) NBACK = NBACK + 1
|
|
140 CONTINUE
|
|
IF (NBACK .LT. 2) GOTO 180
|
|
|
|
C --Extract face lines
|
|
|
|
NOLD = NEDGES
|
|
N2 = LINKF(IXL0+NLNKF(IELB))
|
|
LREFN2 = LREF(N2)
|
|
LSTREF = LREFN2
|
|
|
|
DO 170 ILINK = 1, NLNKF(IELB)
|
|
N1 = N2
|
|
N2 = LINKF(IXL0+ILINK)
|
|
LREFN1 = LREFN2
|
|
IF (ILINK .LT. NLNKF(IELB)) THEN
|
|
LREFN2 = LREF(N2)
|
|
ELSE
|
|
LREFN2 = LSTREF
|
|
END IF
|
|
|
|
IF (n1 .eq. n2) goto 170
|
|
IF (.NOT. ISBACK(N1)) GOTO 170
|
|
IF (.NOT. ISBACK(N2)) GOTO 170
|
|
IF ((HIDENP(N1) .GT. KNVIS)
|
|
& .AND. (HIDENP(N2) .GT. KNVIS)) GOTO 170
|
|
IF (HIDENP(N1) .GE. KNHID) GOTO 170
|
|
IF (HIDENP(N2) .GE. KNHID) GOTO 170
|
|
NMIN = MIN (N1, N2)
|
|
NMAX = MAX (N1, N2)
|
|
|
|
C --Search for line in existing lines
|
|
|
|
DO 150 IL = MIN (LREFN1, LREFN2, NOLD), 1, -1
|
|
IF (IEDSET(1,IL) .EQ. NMIN .AND.
|
|
* IEDSET(2,IL) .EQ. NMAX) GOTO 160
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
|
|
C --Insert new line or pointer to face if duplicate
|
|
|
|
IF (IL .GT. 0) THEN
|
|
IF (NBACK .LE. 2) IEDSET(0,IL) = IFAC
|
|
nmov = nmov + 1
|
|
ELSE
|
|
NEDGES = NEDGES + 1
|
|
IEDSET(0,NEDGES) = IFAC
|
|
IEDSET(1,NEDGES) = NMIN
|
|
IEDSET(2,NEDGES) = NMAX
|
|
LREF(N1) = NEDGES
|
|
LREF(N2) = NEDGES
|
|
END IF
|
|
170 CONTINUE
|
|
END IF
|
|
180 CONTINUE
|
|
END IF
|
|
190 CONTINUE
|
|
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'non-shell visible edge set =', nedges
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') '***removed =', nmov
|
|
200 CONTINUE
|
|
|
|
IF (.NOT. ANYSHE) GOTO 320
|
|
|
|
C --Mark nodes in shell faces with any nodes hidden
|
|
|
|
DO 210 INP = 1, NUMNPF
|
|
IF (LREF(INP) .LE. 0) THEN
|
|
NREF(INP) = 0
|
|
ELSE
|
|
NREF(INP) = 1
|
|
END IF
|
|
210 CONTINUE
|
|
|
|
CALL INILOG (NUMNPF, .FALSE., ISBACK)
|
|
|
|
DO 250 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .ne. 'TET') THEN
|
|
IXL0 = IDBLNK (IELB, 0, LENF, NLNKF) - 1
|
|
DO 240 IFAC = LENF(IELB-1)+1, LENF(IELB)
|
|
NHID = 0
|
|
DO 220 ILINK = 1, NLNKF(IELB)
|
|
IF (HIDENP(LINKF(IXL0+ILINK)) .GT. KNVIS)
|
|
& NHID = NHID + 1
|
|
220 CONTINUE
|
|
IF (NHID .GT. 0) THEN
|
|
DO 230 ILINK = 1, NLNKF(IELB)
|
|
C???? ISBACK(LINKF(IXL0+ILINK)) = .TRUE.
|
|
230 CONTINUE
|
|
END IF
|
|
IXL0 = IXL0 + NLNKF(IELB)
|
|
240 CONTINUE
|
|
END IF
|
|
250 CONTINUE
|
|
|
|
NEWEDG = NEDGES + 1
|
|
nmov = 0
|
|
|
|
call iniint(numnpf, 0, mref)
|
|
do i=nedges, 1, -1
|
|
mref(iedset(1,i)) = i
|
|
mref(iedset(2,i)) = i
|
|
end do
|
|
|
|
DO 310 IELB = 1, NELBLK
|
|
IF (NLNKE(IELB) .EQ. 4 .AND. NAMELB(IELB)(:3) .ne. 'TET') THEN
|
|
|
|
C --Eliminate faces of a selected element block
|
|
IF (NOTSEL .AND. (IELBST(IELB) .GT. 0)) GOTO 310
|
|
|
|
DO 300 IFAC = LENF(IELB-1)+1, LENF(IELB)
|
|
IF (HIDEF(IFAC) .LT. KFOUT) THEN
|
|
IXL0 = IDBLNK (IELB, IFAC, LENF, NLNKF) - 1
|
|
|
|
C --Extract face lines
|
|
|
|
NOLD = NEDGES
|
|
N2 = LINKF(IXL0+NLNKF(IELB))
|
|
LREFN2 = LREF(N2)
|
|
LSTREF = LREFN2
|
|
|
|
DO 290 ILINK = 1, NLNKF(IELB)
|
|
N1 = N2
|
|
N2 = LINKF(IXL0+ILINK)
|
|
LREFN1 = LREFN2
|
|
IF (ILINK .LT. NLNKF(IELB)) THEN
|
|
LREFN2 = LREF(N2)
|
|
ELSE
|
|
LREFN2 = LSTREF
|
|
END IF
|
|
|
|
IF ((HIDENP(N1) .GT. KNVIS)
|
|
& .AND. (HIDENP(N2) .GT. KNVIS)) GOTO 290
|
|
IF (HIDENP(N1) .GE. KNHID) GOTO 290
|
|
IF (HIDENP(N2) .GE. KNHID) GOTO 290
|
|
NMIN = MIN (N1, N2)
|
|
NMAX = MAX (N1, N2)
|
|
|
|
C --Search for line in existing lines
|
|
|
|
IMIN = max(mref(n1), mref(n2),1)
|
|
DO 260 IL = MIN (LREFN1, LREFN2, NOLD), IMIN, -1
|
|
IF (IEDSET(1,IL) .EQ. NMIN .AND.
|
|
* IEDSET(2,IL) .EQ. NMAX) GOTO 270
|
|
260 CONTINUE
|
|
270 CONTINUE
|
|
|
|
IF (IL .GT. 0) THEN
|
|
IF (IL .LT. NEWEDG) THEN
|
|
|
|
C --Leave edge matching non-shell as edge
|
|
CONTINUE
|
|
|
|
ELSE IF (ISBACK(N1) .OR. ISBACK(N2)) THEN
|
|
|
|
C --Adjust pointer to face if duplicate line and either
|
|
C --node is hidden in a shell quad
|
|
NHID = 0
|
|
DO 280 I = 1, NLNKF(IELB)
|
|
IF (HIDENP(LINKF(IXL0+I)) .GT. KNVIS)
|
|
& NHID = NHID + 1
|
|
280 CONTINUE
|
|
IF (NHID .LE. 0) IEDSET(0,NEDGES) = IFAC
|
|
C????C should check the ZQ coordinate
|
|
|
|
ELSE
|
|
|
|
C --Delete duplicate line if both nodes visible
|
|
C --in all shell quads
|
|
|
|
IEDSET(0,IL) = IEDSET(0,NEDGES)
|
|
IEDSET(1,IL) = IEDSET(1,NEDGES)
|
|
IEDSET(2,IL) = IEDSET(2,NEDGES)
|
|
NREF(N1) = NREF(N1) - 1
|
|
NREF(N2) = NREF(N2) - 1
|
|
IF (NREF(N1) .LE. 0) LREF(N1) = 0
|
|
IF (NREF(N2) .LE. 0) LREF(N2) = 0
|
|
NEDGES = NEDGES - 1
|
|
IF (NOLD .GT. NEDGES) NOLD = NEDGES
|
|
nmov = nmov + 1
|
|
END IF
|
|
ELSE
|
|
|
|
C --Insert new line
|
|
|
|
NEDGES = NEDGES + 1
|
|
IEDSET(0,NEDGES) = IFAC
|
|
IEDSET(1,NEDGES) = NMIN
|
|
IEDSET(2,NEDGES) = NMAX
|
|
NREF(N1) = NREF(N1) + 1
|
|
NREF(N2) = NREF(N2) + 1
|
|
LREF(N1) = NEDGES
|
|
LREF(N2) = NEDGES
|
|
if (mref(n1) .eq. 0) mref(n1) = nedges
|
|
if (mref(n2) .eq. 0) mref(n2) = nedges
|
|
END IF
|
|
290 CONTINUE
|
|
END IF
|
|
300 CONTINUE
|
|
END IF
|
|
310 CONTINUE
|
|
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') 'shell visible edge set =',
|
|
& nedges - newedg + 1
|
|
if ((cdebug .eq. 'HIDDEN') .and. (idebug .ge. 1))
|
|
& write (*, '(1x,a,i5)') '***removed =', nmov
|
|
320 CONTINUE
|
|
|
|
C --Make sure hidden node is in IEDSET(2,x)
|
|
|
|
DO 330 IEDG = 1, NEDGES
|
|
IF (HIDENP(IEDSET(1,IEDG)) .GT. KNVIS) THEN
|
|
I = IEDSET(1,IEDG)
|
|
IEDSET(1,IEDG) = IEDSET(2,IEDG)
|
|
IEDSET(2,IEDG) = I
|
|
END IF
|
|
330 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|