Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

214 lines
6.5 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 GEOM3D (LENF, NLNKF, LINKF, IF2EL,
& LENL, LINSET, LINDEF, LREF)
C=======================================================================
C --*** GEOM3D *** (MESH) Group 3D lines connecting nodes
C -- Written by Amy Gilkey - revised 03/29/88
C -- Sam Key, 04/85
C --
C --GEOM3D finds all lines making up the surface faces.
C --The lines are classified and sorted into the following parts:
C -- -1) Edge
C -- 0) Element block boundary
C -- n) Interior within element block 'n'
C --
C --Parameters:
C -- LENF - IN - the cumulative face counts by element block
C -- NLNKF - IN - the number of nodes per face
C -- LINKF - IN - the connectivity for all faces
C -- IF2EL - IN - the element number of each face
C -- LENL - OUT - the cumulative line counts by element block
C -- LINSET - OUT - the sorted line set, for surface faces only
C -- LINDEF - SCRATCH - the line set scratch array;
C -- size = 6 * maximum number of lines
C -- LREF - SCRATCH - the last line set index for node, length = NUMNPF
C --
C --Common Variables:
C -- Uses NELBLK of /DBNUMS/
C -- Uses NUMNPF, LLNSET of /D3NUMS/
common /debugc/ cdebug
common /debugn/ idebug
character*8 cdebug
include 'dbnums.blk'
COMMON /D3NUMS/ IS3DIM, NNPSUR, NUMNPF, LLNSET
LOGICAL IS3DIM
INTEGER LENF(0:NELBLK)
INTEGER NLNKF(NELBLK)
INTEGER LINKF(*)
INTEGER IF2EL(*)
INTEGER LENL(-2:NELBLK), LINSET(LLNSET,*)
INTEGER LINDEF(0:5,*)
INTEGER LREF(*)
CALL INIINT (NUMNPF, 0, LREF)
C --Define line set for surface faces only
NHEAP = 0
DO 170 IELB = 1, NELBLK
IXL0 = IDBLNK (IELB, 0, LENF, NLNKF) - 1
C --Handle normal multi-sided elements
IF (NLNKF(IELB) .GT. 2) THEN
DO 130 IFAC = LENF(IELB-1)+1, LENF(IELB)
IEL = IF2EL(IFAC)
C --Extract element lines
N2 = LINKF(IXL0+NLNKF(IELB))
LREFN2 = LREF(N2)
LSTREF = LREFN2
DO 120 ILINK = 1, NLNKF(IELB)
N1 = N2
N2 = LINKF(IXL0+ILINK)
if (n1 .eq. n2) goto 120
NMIN = MIN (N1, N2)
NMAX = MAX (N1, N2)
C --Search for line in existing lines
LREFN1 = LREFN2
IF (ILINK .LT. NLNKF(IELB)) THEN
LREFN2 = LREF(N2)
ELSE
LREFN2 = LSTREF
END IF
IL = MIN (LREFN1, LREFN2)
100 CONTINUE
IF (IL .GT. 0) THEN
IF (LINDEF(1,IL) .EQ. NMIN) THEN
IF (LINDEF(2,IL) .EQ. NMAX) GOTO 110
IL = LINDEF(4,IL)
ELSE IF (LINDEF(1,IL) .EQ. NMAX) THEN
IL = LINDEF(4,IL)
ELSE
IL = LINDEF(5,IL)
END IF
GOTO 100
END IF
110 CONTINUE
IF (IL .GT. 0) THEN
IOLELB = IABS (LINDEF(0,IL))
IF (IELB .EQ. IOLELB) THEN
C --If both faces of the same element (i.e., an edge),
C --change from element block n set to edge set,
C --else change to element block n set
IF (IEL .EQ. LINDEF(3,IL)) THEN
LINDEF(0,IL) = -1
ELSE
LINDEF(0,IL) = IELB
END IF
ELSE
C --If not same element block, change line from
C --element block n set to element block boundary set
LINDEF(0,IL) = 0
END IF
ELSE
C --No match, add to edge set and point to face
NHEAP = NHEAP + 1
LINDEF(0,NHEAP) = -IELB
LINDEF(1,NHEAP) = NMIN
LINDEF(2,NHEAP) = NMAX
LINDEF(3,NHEAP) = IEL
LINDEF(4,NHEAP) = LREF(NMIN)
LINDEF(5,NHEAP) = LREF(NMAX)
LREF(N1) = NHEAP
LREF(N2) = NHEAP
END IF
120 CONTINUE
IXL0 = IXL0 + NLNKF(IELB)
130 CONTINUE
C --Handle 2-node truss elements
ELSE IF (NLNKF(IELB) .EQ. 2) THEN
DO 150 IFAC = LENF(IELB-1)+1, LENF(IELB)
IEL = IF2EL(IFAC)
C --Extract element lines for 2-node elements
N2 = LINKF(IXL0+NLNKF(IELB))
DO 140 ILINK = 1, NLNKF(IELB)
N1 = N2
N2 = LINKF(IXL0+ILINK)
NMIN = MIN (N1, N2)
NMAX = MAX (N1, N2)
C --Add to edge set as element block n set
NHEAP = NHEAP + 1
LINDEF(0,NHEAP) = IELB
LINDEF(1,NHEAP) = NMIN
LINDEF(2,NHEAP) = NMAX
LINDEF(3,NHEAP) = IEL
LINDEF(4,NHEAP) = 0
LINDEF(5,NHEAP) = 0
140 CONTINUE
IXL0 = IXL0 + NLNKF(IELB)
150 CONTINUE
ELSE
DO 160 IFAC = LENF(IELB-1)+1, LENF(IELB)
IXL0 = IXL0 + NLNKF(IELB)
160 CONTINUE
END IF
170 CONTINUE
C --Count lines in each line set
DO 180 IELB = -2, NELBLK
LENL(IELB) = 0
180 CONTINUE
DO 190 IL = 1, NHEAP
IF (LINDEF(0,IL) .LT. -1) LINDEF(0,IL) = -1
IELB = LINDEF(0,IL)
LENL(IELB) = LENL(IELB) + 1
190 CONTINUE
C --Get starting indices for each line set
LENL(-2) = 0
NHEAP = 0
DO 200 IELB = -1, NELBLK
L = LENL(IELB)
LENL(IELB) = NHEAP
NHEAP = NHEAP + L
200 CONTINUE
C --Move lines into appropriate line set
DO 210 IL = 1, NHEAP
IELB = LINDEF(0,IL)
IX = LENL(IELB) + 1
LENL(IELB) = IX
C... CALL CPYINT (2, LINDEF(1,IL), LINSET(1,IX))
linset(1,ix) = lindef(1,il)
linset(2,ix) = lindef(2,il)
210 CONTINUE
RETURN
END