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.
177 lines
6.0 KiB
177 lines
6.0 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 FACE3D (A, LENE, NLNKE, LINKE,
|
|
& NFACES, LENLNK, LENSC, NLNKSC, LINKSC, IF2ESC, NAMELB)
|
|
C=======================================================================
|
|
|
|
C --*** FACE3D *** (MESH) Break 3D elements into faces
|
|
C -- Written by Amy Gilkey - revised 03/29/88
|
|
C -- Sam Key, 04/85
|
|
C --
|
|
C --FACE3D finds all the faces in the 3D mesh.
|
|
C --
|
|
C --Dynamic memory is manipulated by the routine and should be checked
|
|
C --for errors after call.
|
|
C --
|
|
C --Parameters:
|
|
C -- A - IN - the dynamic memory base array
|
|
C -- LENE - IN - the cumulative element counts by element block
|
|
C -- NLNKE - IN - the number of nodes per element
|
|
C -- LINKE - IN - the original connectivity; connectivity all zero
|
|
C -- if element is undefined
|
|
C -- NFACES - OUT - returned number of non-duplicate faces
|
|
C -- LENLNK - OUT - the length of the face connectivity array without
|
|
C -- duplicates
|
|
C -- LENSC - OUT - the cumulative face counts by element block
|
|
C -- NLNKSC - OUT - the number of nodes per face
|
|
C -- LINKSC - OUT - the face connectivity
|
|
C -- IF2ESC - OUT - the element number(s) of each face in LINKSC;
|
|
C -- size = 2*NFACES
|
|
C -- IF2ESC(2,x) = 0 iff surface face
|
|
C -- IF2ESC(2,x) > 0 iff interior face
|
|
C -- IF2ESC(2,x) < 0 iff duplicate interior face
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NUMNP, NELBLK of /DBNUMS/
|
|
|
|
common /debugc/ cdebug
|
|
common /debugn/ idebug
|
|
character*8 cdebug
|
|
|
|
include 'params.blk'
|
|
include 'dbnums.blk'
|
|
include 'd3nums.blk'
|
|
include 'minmax.blk'
|
|
|
|
DIMENSION A(*)
|
|
INTEGER LENE(0:NELBLK), LINKE(*)
|
|
INTEGER NLNKE(NELBLK)
|
|
INTEGER LENSC(0:NELBLK), LINKSC(*)
|
|
INTEGER NLNKSC(NELBLK)
|
|
INTEGER IF2ESC(2,*)
|
|
CHARACTER*(MXSTLN) NAMELB(*)
|
|
|
|
logical hastet
|
|
|
|
INTEGER NPFRAT(8)
|
|
SAVE NPFRAT
|
|
|
|
C --NPFRAT(i) is the maximum number of faces that a node can be
|
|
C in if the number of elements that the node is in = i
|
|
C NOTE: Will fail for collapsed hexes...
|
|
C For i <= 4, assumes possible strange connections, for
|
|
C i > 4, assumes a somewhat regular connectivity
|
|
DATA NPFRAT / 3, 6, 9, 12, 12, 12, 12, 12 /
|
|
C --Reserve storage for node-to-face pointers
|
|
|
|
C --MAXNPF is the maximum number of faces with a given node
|
|
C --that are unmatched as the face matching routine is executed
|
|
CALL MDRSRV ('NFPN', KNFPN, 1+NUMNP)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 150
|
|
CALL INIINT (1+NUMNP, 0, A(KNFPN))
|
|
MAXEPN = 0
|
|
HASTET = .FALSE.
|
|
DO 100 IELB = 1, NELBLK
|
|
IXL = IDBLNK (IELB, 0, LENE, NLNKE)
|
|
NUME = LENE(IELB) - LENE(IELB-1)
|
|
CALL MXEPN (NUME, NLNKE(IELB), LINKE(IXL), A(KNFPN))
|
|
if (namelb(ielb)(:3) .eq. 'TET') hastet = .true.
|
|
100 CONTINUE
|
|
MAXEPN = MXEPNMX(A(KNFPN))
|
|
|
|
C ... NOTE: I think this needs to be fixed for tet elements.
|
|
IF (MAXEPN .LE. 8) THEN
|
|
MAXNPF = NPFRAT(MAXEPN)
|
|
ELSE
|
|
if (hastet) then
|
|
C ... Not sure whether this is the correct number or not...
|
|
MAXNPF = MAXEPN * 3
|
|
else
|
|
MAXNPF = (MAXEPN * 3) / 2
|
|
end if
|
|
END IF
|
|
CALL MDDEL ('NFPN')
|
|
|
|
CALL MDRSRV ('NPFS', KNPFS, (1+MAXNPF) * NUMNP)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 150
|
|
|
|
C --Find all faces, matching faces in same element block
|
|
|
|
LENSC(0) = 0
|
|
IXL = 1
|
|
minnod = 1
|
|
maxnod = numnp
|
|
DO 110 IELB = 1, NELBLK
|
|
IXE = IDBLNK (IELB, 0, LENE, NLNKE)
|
|
NUME = LENE(IELB) - LENE(IELB-1)
|
|
CALL FACELB (IELB, LENE, NLNKE(IELB), LINKE(IXE),
|
|
& NLNKSC(IELB), LINKSC(IXL), IF2ESC(1,LENSC(IELB-1)+1),
|
|
& MAXNPF, A(KNPFS), NFELB, NAMELB(IELB))
|
|
LENSC(IELB) = LENSC(IELB-1) + NFELB
|
|
IXL = IXL + NLNKSC(IELB) * NFELB
|
|
110 CONTINUE
|
|
|
|
NFACES = LENSC(NELBLK)
|
|
LENLNK = IXL - 1
|
|
|
|
C --Match faces in different element blocks
|
|
|
|
NOVER = 0
|
|
minnod = 1
|
|
maxnod = numnp
|
|
|
|
DO 140 IELBLK = 1, NELBLK
|
|
if (nlnksc(ielblk) .ge. 4) then
|
|
CALL ININPF (minnod, maxnod, MAXNPF, A(KNPFS))
|
|
minnod = numnp
|
|
maxnod = 1
|
|
DO 130 IELB = IELBLK, NELBLK
|
|
IF ((NLNKSC(IELB) .EQ. NLNKSC(IELBLK))
|
|
& .AND. (NAMELB(IELB)(:3) .NE. 'SHE')
|
|
$ .AND. (NAMELB(IELB) .EQ. NAMELB(IELBLK))) THEN
|
|
IXL = IDBLNK (IELB, 0, LENSC, NLNKSC)
|
|
DO 120 IFAC = LENSC(IELB-1)+1, LENSC(IELB)
|
|
IF (IF2ESC(2,IFAC) .EQ. 0) THEN
|
|
IF (IELB .NE. IELBLK) THEN
|
|
if (NAMELB(IELB)(:3) .eq. 'TET') THEN
|
|
IMATCH = MATFAT
|
|
$ (LINKSC(IXL), MAXNPF, A(KNPFS),
|
|
$ IF2ESC(1,IFAC), numnp, IERR)
|
|
ELSE
|
|
IMATCH = MATFAC
|
|
& (LINKSC(IXL), MAXNPF, A(KNPFS),
|
|
* IF2ESC(1,IFAC), numnp, IERR)
|
|
END IF
|
|
ELSE
|
|
IMATCH = 0
|
|
END IF
|
|
|
|
IF (IMATCH .GT. 0) THEN
|
|
NFACES = NFACES - 1
|
|
LENLNK = LENLNK - NLNKSC(IELB)
|
|
IF2ESC(2,IMATCH) = IF2ESC(1,IFAC)
|
|
IF2ESC(1,IFAC) = -999
|
|
IF2ESC(2,IFAC) = -999
|
|
ELSE
|
|
CALL FILNPF (NLNKSC(IELB), LINKSC(IXL), IFAC,
|
|
& MAXNPF, A(KNPFS), NOVER, numnp)
|
|
END IF
|
|
END IF
|
|
IXL = IXL + NLNKSC(IELB)
|
|
120 CONTINUE
|
|
END IF
|
|
130 CONTINUE
|
|
end if
|
|
140 CONTINUE
|
|
|
|
CALL MDDEL ('NPFS')
|
|
150 CONTINUE
|
|
RETURN
|
|
END
|
|
|