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.
 
 
 
 
 
 

150 lines
4.8 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 FACELB (IELB, LENE, NLNKE, LINKE,
& NLNKSC, LINKSC, IF2ESC, MAXNPF, NPFS, NFACES, NAMELB)
C=======================================================================
C --*** FACELB *** (MESH) Match element block faces
C -- Written by Amy Gilkey - revised 02/24/88
C -- Sam Key, 06/01/85
C --
C --FACELB makes up a list of faces for all faces in an element block.
C --All matching faces within the block are combined.
C --
C --Parameters:
C -- IELB - IN - the element block number
C -- LENE - IN - the cumulative element counts by element block
C -- NLNKE - IN - the number of nodes per element
C -- LINKE - IN - the connectivity for all elements
C -- NLNKSC - IN - the number of nodes per face
C -- LINKSC - IN/OUT - the connectivity for all faces (this block only)
C -- IF2ESC - IN/OUT - the element number(s) of each face in LINKSC
C -- MAXNPF - IN - the maximum length of the NPFS entry
C -- NPFS - SCRATCH - the list of unmatched faces containing a node;
C -- (0,i) = the length of the list
C -- NFACES - OUT - the number of unique faces in this element block
C --
C --Common Variables:
C -- Uses NUMNP of /DBNUMS/
include 'params.blk'
include 'dbnums.blk'
include 'minmax.blk'
INTEGER LENE(0:NELBLK), LINKE(NLNKE,*)
INTEGER LINKSC(*)
INTEGER IF2ESC(2,*)
INTEGER NPFS(NUMNP,0:MAXNPF)
INTEGER LINKF1(4)
CHARACTER*(MXSTLN) NAMELB
LOGICAL ISTET
istet = (namelb(:3) .eq. 'TET')
CALL ININPF (minnod, maxnod, MAXNPF, NPFS)
maxnod = 1
minnod = numnp
NOVER = 0
NFACES = 0
IXF = 1
IF (NLNKE .EQ. 8) THEN
DO 110 IEL = LENE(IELB-1)+1, LENE(IELB)
IXEL = IEL - LENE(IELB-1)
IF (LINKE(1,IXEL) .NE. 0) THEN
DO 100 IFACE = 1, 6
CALL FNODES (IFACE, LINKE(1,IXEL), LINKF1)
IF ( (NPFS(LINKF1(1),0) .GT. 0)
& .AND. (NPFS(LINKF1(2),0) .GT. 0)
& .AND. (NPFS(LINKF1(3),0) .GT. 0)
& .AND. (NPFS(LINKF1(4),0) .GT. 0)) THEN
IMATCH = MATFAC (LINKF1, MAXNPF, NPFS, iel, numnp, IERR)
else
imatch = 0
endif
IF (IMATCH .LE. 0) THEN
NFACES = NFACES + 1
CALL CPYINT (NLNKSC, LINKF1, LINKSC(IXF))
IXF = IXF + NLNKSC
IF2ESC(1,NFACES) = IEL
IF2ESC(2,NFACES) = 0
CALL FILNPF (NLNKSC, LINKF1, NFACES,
& MAXNPF, NPFS, NOVER, NUMNP)
ELSE
IF2ESC(2,IMATCH) = IEL
END IF
100 CONTINUE
end if
110 continue
ELSE IF (NLNKE .eq. 4 .and. istet) THEN
DO 210 IEL = LENE(IELB-1)+1, LENE(IELB)
IXEL = IEL - LENE(IELB-1)
IF (LINKE(1,IXEL) .NE. 0) THEN
DO 200 IFACE = 1, 4
CALL TNODES (IFACE, LINKE(1,IXEL), LINKF1)
IF ( (NPFS(LINKF1(1),0) .GT. 0)
& .AND. (NPFS(LINKF1(2),0) .GT. 0)
& .AND. (NPFS(LINKF1(3),0) .GT. 0)) THEN
IMATCH = MATFAT (LINKF1, MAXNPF, NPFS, iel, numnp, IERR)
else
imatch = 0
endif
IF (IMATCH .LE. 0) THEN
NFACES = NFACES + 1
c CALL CPYINT (4, LINKF1, LINKSC(IXF))
linksc(ixf+0) = linkf1(1)
linksc(ixf+1) = linkf1(2)
linksc(ixf+2) = linkf1(3)
linksc(ixf+3) = linkf1(4)
IXF = IXF + 4
IF2ESC(1,NFACES) = IEL
IF2ESC(2,NFACES) = 0
CALL FILNPF (4, LINKF1, NFACES,
& MAXNPF, NPFS, NOVER, NUMNP)
ELSE
IF2ESC(2,IMATCH) = IEL
END IF
200 CONTINUE
end if
210 continue
ELSE IF (NLNKE .LT. 8) THEN
DO 310 IEL = LENE(IELB-1)+1, LENE(IELB)
IXEL = IEL - LENE(IELB-1)
IF (LINKE(1,IXEL) .NE. 0) THEN
NFACES = NFACES+1
CALL CPYINT (NLNKSC, LINKE(1,IXEL), LINKSC(IXF))
IXF = IXF + NLNKSC
IF2ESC(1,NFACES) = IEL
IF2ESC(2,NFACES) = 0
end if
310 continue
END IF
IF (NOVER .GT. 0) THEN
WRITE (*, 10000) 'in FACELB, MAXNPF =', MAXNPF, ', # =', NOVER
10000 FORMAT (1X, 'PROGRAM ERROR - ', A, I5, A, I5)
END IF
RETURN
END