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.
358 lines
13 KiB
358 lines
13 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 NEWESS (IDFRO, IDBCK, LINK,
|
|
& ISSFRO, ISSBCK, NSSUR, NESUR, NSSFRO, NSSBCK,
|
|
& IDESS, NEESS, NEES3, NNESS, NNES3,
|
|
& IXEESS, IXEES3, IXNESS, IXNES3,
|
|
& LTEESS, LTEES3, LTSESS, LTSES3, LTNESS, LTNES3, FACESS, FACES3,
|
|
& IXEL, INCEL, NREL, IELCOL, IXNP, NRNP, IROT)
|
|
C=======================================================================
|
|
|
|
C --*** NEWESS *** (GEN3D) Calculate 3D side sets
|
|
C -- Written by Amy Gilkey - revised 01/12/88
|
|
C --
|
|
C --NEWESS calculates the side set information for the 3D database.
|
|
C --The elements in the front and back side sets are not calculated
|
|
C --(since they are easily derived), and they are not included in the
|
|
C --length tally. The nodes in the front and back node sets are
|
|
C --calculated, and their number is returned, but they are not included
|
|
C --in the length tally.
|
|
C --
|
|
C --Parameters:
|
|
C -- IDFRO - IN - ids for front surface side sets; (0) = length
|
|
C -- IDBCK - IN - ids for back surface side sets; (0) = length
|
|
C -- LINK - IN - the connectivity for the 2D elements, always 4 nodes
|
|
C -- ISSFRO - OUT - the elements in the front surface side set
|
|
C -- ISSBCK - OUT - the elements in the back surface side set
|
|
C -- NSSUR - OUT - the number of nodes in the surface side set
|
|
C -- NESUR - OUT - the number of elements in the surface side set
|
|
C -- NSSFRO - OUT - the nodes in the front surface side set
|
|
C -- NSSBCK - OUT - the nodes in the back surface side set
|
|
C -- IDESS - IN - the ids for each 2D set
|
|
C -- NEESS - IN - the number of elements for each 2D set
|
|
C -- NEES3 - OUT - the number of elements for each 3D set
|
|
C -- NNESS - IN - the number of nodes for each 2D set
|
|
C -- NNES3 - OUT - the number of nodes for each 3D set
|
|
C -- IXEESS - IN - the index of the first element for each 2D set
|
|
C -- IXEES3 - OUT - the index of the first element for each 3D set
|
|
C -- IXNESS - IN - the index of the first node for each 2D set
|
|
C -- IXNES3 - OUT - the index of the first node for each 3D set
|
|
C -- LTEESS - IN - the elements for all 2D sets
|
|
C -- LTEES3 - OUT - the elements for all 3D sets
|
|
C -- LTSESS - IN - the element sides for all 2D sets
|
|
C -- LTSES3 - OUT - the element sides for all 3D sets
|
|
C -- LTNESS - IN - the nodes for all 2D sets
|
|
C -- LTNES3 - OUT - the nodes for all 3D sets
|
|
C -- FACESS - IN - the distribution factors for all 2D sets
|
|
C -- FACES3 - OUT - the distribution factors for all 3D sets
|
|
C -- IXEL - IN - the new index for each element
|
|
C -- INCEL - IN - the increment for each element, needed for blocks
|
|
C -- that become multiple blocks
|
|
C -- NREL - IN - the number of new elements generated for each element
|
|
C -- IELCOL - IN - the row number for each element, 0 if not needed
|
|
C -- IXNP - IN - the new index for each node
|
|
C -- NRNP - IN - the number of new nodes generated for each node
|
|
C -- IROT - IN - offset from original link order
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NDBOUT of /DBASE/
|
|
C -- Uses NUMESS, LESSEL, LESSNL of /DBNUMS/
|
|
C -- Sets LESSEO, LESSNO of /DBNUM3/
|
|
C -- Uses NNREPL, NEREPL, DIM3 of /PARAMS/
|
|
|
|
INCLUDE 'g3_dbase.blk'
|
|
INCLUDE 'g3_dbnums.blk'
|
|
INCLUDE 'g3_dbnum3.blk'
|
|
INCLUDE 'g3_params.blk'
|
|
|
|
INTEGER IDFRO(0:*)
|
|
INTEGER IDBCK(0:*)
|
|
INTEGER LINK(4,*)
|
|
INTEGER ISSFRO(NUMEL), ISSBCK(NUMEL)
|
|
INTEGER NSSFRO(*), NSSBCK(*)
|
|
INTEGER IDESS(*)
|
|
INTEGER NEESS(*), NEES3(*)
|
|
INTEGER NNESS(*), NNES3(*)
|
|
INTEGER IXEESS(*), IXEES3(*)
|
|
INTEGER IXNESS(*), IXNES3(*)
|
|
INTEGER LTEESS(*), LTEES3(*)
|
|
INTEGER LTSESS(*), LTSES3(*)
|
|
INTEGER LTNESS(*), LTNES3(*)
|
|
REAL FACESS(*), FACES3(*)
|
|
INTEGER IXEL(*), INCEL(*), NREL(*), IELCOL(*)
|
|
INTEGER IXNP(*), NRNP(*), IROT(*)
|
|
|
|
LOGICAL ROT360
|
|
LOGICAL SWAPIT
|
|
|
|
ROT360 = (NEREPL .EQ. NNREPL)
|
|
N4 = NINT (DIM3 / 90)
|
|
|
|
C --Side set ids - unchanged
|
|
|
|
CONTINUE
|
|
|
|
C --Side set elements - 2D array must be different from 3D array to prevent
|
|
C --overwriting; add on elements for each plate/slice
|
|
|
|
C --Side set nodes and distribution factors - 2D array must be different
|
|
C --from 3D array to prevent overwriting; first swap 2D side set nodes;
|
|
C --then complete 2D side set by adding nodes from next plate/slice in
|
|
C --reverse order (2-1-5-6), then add on nodes for each plate/slice
|
|
|
|
C --Swap nodes to reverse order
|
|
|
|
DO 30 IESS = 1, NUMESS
|
|
IP0 = IXNESS(IESS) - 1
|
|
NES = 2
|
|
DO 20 J = 1, NEESS(IESS)
|
|
IDOWN = NES
|
|
DO 10 I = 1, NES/2
|
|
ISV = LTNESS(IP0+I)
|
|
LTNESS(IP0+I) = LTNESS(IP0+IDOWN)
|
|
LTNESS(IP0+IDOWN) = ISV
|
|
IDOWN = IDOWN - 1
|
|
10 CONTINUE
|
|
IP0 = IP0 + NES
|
|
20 CONTINUE
|
|
30 CONTINUE
|
|
|
|
NE = 0
|
|
N = 0
|
|
DO 130 IESS = 1, NUMESS
|
|
C --Index of each side set elements
|
|
IXEES3(IESS) = NE + 1
|
|
C --Index of each side set nodes
|
|
IXNES3(IESS) = N + 1
|
|
|
|
IP0 = IXNESS(IESS) - 1
|
|
IXE0 = IXEESS(IESS) - 1
|
|
NES = 2
|
|
|
|
DO 120 J = 1, NEESS(IESS)
|
|
IEL = LTEESS(IXE0+J)
|
|
C ... If IROT(IEL) .ne. 1, then the connectivity of the 2D element
|
|
C was rotated in ixlink. Update the side number to match the
|
|
C new connectivity.
|
|
ISD = LTSESS(IXE0+J) - IROT(IEL) + 1
|
|
if (isd .le. 0) isd = isd + 4
|
|
JEL = IXEL(IEL)
|
|
|
|
IF (IELCOL(IEL) .EQ. 0) THEN
|
|
DO 40 NR = 1, NREL(IEL)
|
|
NE = NE + 1
|
|
LTEES3(NE) = JEL
|
|
LTSES3(NE) = ISD
|
|
JEL = JEL + INCEL(IEL)
|
|
40 CONTINUE
|
|
|
|
DO 60 NR = 1, NREL(IEL)
|
|
NEND = N + 2*NES + 1
|
|
DO 50 I = 1, NES
|
|
INP = LTNESS(IP0+I)
|
|
JNP = IXNP(INP)
|
|
N = N + 1
|
|
LTNES3(N) = JNP + NR-1
|
|
IF (NR .LT. NNREPL) THEN
|
|
LTNES3(NEND-I) = JNP + NR
|
|
ELSE
|
|
LTNES3(NEND-I) = JNP
|
|
END IF
|
|
FACES3(N) = FACESS(IP0+I)
|
|
FACES3(NEND-I) = FACESS(IP0+I)
|
|
50 CONTINUE
|
|
N = N + NES
|
|
60 CONTINUE
|
|
|
|
ELSE
|
|
|
|
C --Handle center element
|
|
|
|
NE4 = NREL(IEL) / N4
|
|
NCORN = INT (NE4/2) + 1
|
|
|
|
INP1 = LTNESS(IP0+1)
|
|
INP2 = LTNESS(IP0+2)
|
|
|
|
IF (NRNP(INP1) .EQ. NRNP(INP2)) THEN
|
|
|
|
DO 70 NR = 1, NREL(IEL)
|
|
IF (NR .EQ. NCORN) THEN
|
|
IF (NRNP(INP2) .GT. NREL(IEL)) THEN
|
|
NE = NE + 1
|
|
LTEES3(NE) = JEL
|
|
LTSES3(NE) = ISD
|
|
NE = NE + 1
|
|
LTEES3(NE) = JEL
|
|
LTSES3(NE) = ISD
|
|
ELSE
|
|
CONTINUE
|
|
END IF
|
|
NCORN = NCORN + NE4
|
|
ELSE
|
|
NE = NE + 1
|
|
LTEES3(NE) = JEL
|
|
LTSES3(NE) = ISD
|
|
END IF
|
|
JEL = JEL + INCEL(IEL)
|
|
70 CONTINUE
|
|
|
|
DO 90 NR = 1, NRNP(INP2)
|
|
NEND = N + 2*NES + 1
|
|
DO 80 I = 1, NES
|
|
INP = LTNESS(IP0+I)
|
|
JNP = IXNP(INP)
|
|
N = N + 1
|
|
LTNES3(N) = JNP + NR-1
|
|
FACES3(N) = FACESS(IP0+I)
|
|
IF (.NOT. ROT360 .OR. NR .LT. NRNP(INP2)) THEN
|
|
LTNES3(NEND-I) = JNP + NR
|
|
ELSE
|
|
LTNES3(NEND-I) = JNP
|
|
END IF
|
|
FACES3(NEND-I) = FACESS(IP0+I)
|
|
80 CONTINUE
|
|
N = N + NES
|
|
90 CONTINUE
|
|
|
|
ELSE
|
|
DO 100 NR = 1, NREL(IEL)
|
|
NE = NE + 1
|
|
LTEES3(NE) = JEL
|
|
LTSES3(NE) = ISD
|
|
JEL = JEL + INCEL(IEL)
|
|
100 CONTINUE
|
|
|
|
SWAPIT = (NRNP(INP1) .GT. NRNP(INP2))
|
|
IF (SWAPIT) THEN
|
|
I = INP1
|
|
INP1 = INP2
|
|
INP2 = I
|
|
END IF
|
|
JNP1 = IXNP(INP1)
|
|
JNP2 = IXNP(INP2)
|
|
I1 = 0
|
|
I2 = 0
|
|
DO 110 NR = 1, NREL(IEL)
|
|
LTNES3(N+1) = JNP1 + I1
|
|
LTNES3(N+2) = JNP2 + I2
|
|
IF (NR .EQ. NCORN) THEN
|
|
I3 = I2 + 2
|
|
IF (ROT360 .AND. I3 .GE. NRNP(INP2)) I3 = 0
|
|
LTNES3(N+4) = JNP2 + I3
|
|
ELSE
|
|
I3 = I1 + 1
|
|
IF (ROT360 .AND. I3 .GE. NRNP(INP1)) I3 = 0
|
|
LTNES3(N+4) = JNP1 + I3
|
|
END IF
|
|
I4 = I2 + 1
|
|
IF (ROT360 .AND. I4 .GE. NRNP(INP2)) I4 = 0
|
|
LTNES3(N+3) = JNP2 + I4
|
|
IF (SWAPIT) THEN
|
|
I = LTNES3(N+1)
|
|
LTNES3(N+1) = LTNES3(N+2)
|
|
LTNES3(N+2) = I
|
|
I = LTNES3(N+3)
|
|
LTNES3(N+3) = LTNES3(N+4)
|
|
LTNES3(N+4) = I
|
|
END IF
|
|
FACES3(N+1) = FACESS(IP0+1)
|
|
FACES3(N+2) = FACESS(IP0+2)
|
|
FACES3(N+3) = FACESS(IP0+2)
|
|
FACES3(N+4) = FACESS(IP0+1)
|
|
IF (NR .EQ. NCORN) THEN
|
|
NCORN = NCORN + NE4
|
|
I1 = I1
|
|
I2 = I2 + 2
|
|
ELSE
|
|
I1 = I1 + 1
|
|
I2 = I2 + 1
|
|
END IF
|
|
N = N + 4
|
|
110 CONTINUE
|
|
END IF
|
|
END IF
|
|
|
|
IP0 = IP0 + NES
|
|
120 CONTINUE
|
|
|
|
C --Number of elements in each set
|
|
NEES3(IESS) = NE - IXEES3(IESS) + 1
|
|
C --Number of nodes in each set
|
|
NNES3(IESS) = N - IXNES3(IESS) + 1
|
|
130 CONTINUE
|
|
|
|
C --Number of elements in all sets
|
|
LESSEO = NE
|
|
C --Number of nodes in all sets
|
|
LESSNO = N
|
|
|
|
C --Set up elements and nodes for front and back side sets
|
|
|
|
NFRO = IDFRO(0)
|
|
NBCK = IDBCK(0)
|
|
|
|
NESUR = 0
|
|
NSSUR = 0
|
|
IF ((NFRO .GT. 0) .OR. (NBCK .GT. 0)) THEN
|
|
N = 0
|
|
DO 150 IEL = 1, NUMEL
|
|
C ... Check if BAR or QUAD. All are stored with 4-node connectivity
|
|
C BAR will have last two connectivity entries equal to -1
|
|
C The connectivity is initialized to -1 in rdelb.
|
|
|
|
IF (LINK(3,IEL) .NE. -1 .AND. LINK(4,IEL) .NE. -1) then
|
|
NESUR = NESUR + 1
|
|
JEL = IXEL(IEL)
|
|
IF (NFRO .GT. 0) ISSFRO(IEL) = JEL
|
|
IF (NBCK .GT. 0) THEN
|
|
ISSBCK(IEL) = JEL + nrel(iel)*INCEL(IEL)-1
|
|
C ... The center element on the back side needs special treatment when
|
|
C the sideset faces are written out (in wress). Flag it with
|
|
C a negative element number (and remember to change back in wress)
|
|
if (iscent .and. nrel(iel) .eq. 2)
|
|
* issbck(iel) = -issbck(iel)
|
|
end if
|
|
NLINK = 4
|
|
NEND = N + NLINK + 1
|
|
DO I = 1, NLINK
|
|
INP = LINK(I,IEL)
|
|
JNP = IXNP(INP)
|
|
N = N + 1
|
|
IF (NFRO .GT. 0) NSSFRO(N) = JNP
|
|
IF (NBCK .GT. 0) NSSBCK(NEND-I) = JNP + NRNP(INP)-1
|
|
end do
|
|
ELSE IF (LINK(3,IEL) .NE. -1 .AND. LINK(4,IEL) .EQ. -1) then
|
|
C ... Triangle to Wedge
|
|
NESUR = NESUR + 1
|
|
JEL = IXEL(IEL)
|
|
C ... Need to tell wress that this is a wedge and not a hex.
|
|
C Use the same negative element kluge since the faces
|
|
C work out the same... Flag it with
|
|
C a negative element number (and remember to change back in wress)
|
|
IF (NFRO .GT. 0) ISSFRO(IEL) = -JEL
|
|
IF (NBCK .GT. 0) then
|
|
ISSBCK(IEL) = -(JEL + nrel(iel)*INCEL(IEL)-1)
|
|
end if
|
|
NLINK = 3
|
|
NEND = N + NLINK + 1
|
|
DO I = 1, NLINK
|
|
INP = LINK(I,IEL)
|
|
JNP = IXNP(INP)
|
|
N = N + 1
|
|
IF (NFRO .GT. 0) NSSFRO(N) = JNP
|
|
IF (NBCK .GT. 0) NSSBCK(NEND-I) = JNP + NRNP(INP)-1
|
|
end do
|
|
end if
|
|
|
|
150 CONTINUE
|
|
NSSUR = N
|
|
END IF
|
|
|
|
RETURN
|
|
END
|
|
|