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.
131 lines
4.5 KiB
131 lines
4.5 KiB
2 years ago
|
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 MIRSS (NUMESS, LESSEL, LESSDL, IDESS, NEESS, NEDSS,
|
||
|
|
* IXEESS, IXEDSS, LTEESS, LTSSS, LTSNC, FAC, USESDF, NONQUAD,
|
||
|
|
* COMTOP)
|
||
|
|
C=======================================================================
|
||
|
|
C --*** MIRSS *** (GJOIN) Mirror element side sets
|
||
|
|
C --
|
||
|
|
C --MIRSS mirrors a side set and (if USESDF true) the distribution factors
|
||
|
|
C --applied to the nodes.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C --
|
||
|
|
C -- NUMESS - IN/OUT - the number of element side sets
|
||
|
|
C -- LESSEL - IN/OUT - the length of the element side sets element list
|
||
|
|
C -- IDESS - IN/OUT - the element side set ID for each set
|
||
|
|
C -- NEESS - IN/OUT - the number of elements for each set
|
||
|
|
C -- NEDSS - IN/OUT - the number of dist-fac for each set
|
||
|
|
C -- IXEESS - IN/OUT - the index of the first element for each set
|
||
|
|
C -- IXEDSS - IN/OUT - the index of the first dist-fac for each set
|
||
|
|
C -- LTEESS - IN/OUT - the elements for all sets
|
||
|
|
C -- LTSSS - IN/OUT - the sides for all sets
|
||
|
|
C -- LTSNC - IN/OUT - the face count for each element/side in the list
|
||
|
|
C -- FACESS - IN/OUT - the distribution factors for all sets????????????
|
||
|
|
C -- USESDF - IN - true if df are non-unity, false if all unity
|
||
|
|
C -- NONQUAD - IN - true if model contains non-hex/non-quad elements
|
||
|
|
|
||
|
|
INTEGER IDESS(*) ! NUMESS
|
||
|
|
INTEGER NEESS(*) ! NUMESS
|
||
|
|
INTEGER NEDSS(*) ! NUMESS
|
||
|
|
INTEGER IXEESS(*) ! NUMESS
|
||
|
|
INTEGER IXEDSS(*) ! NUMESS
|
||
|
|
INTEGER LTEESS(*) ! LESSEL
|
||
|
|
INTEGER LTSSS(*) ! LESSEL
|
||
|
|
INTEGER LTSNC(*) ! LESSEL
|
||
|
|
REAL FAC(*) ! LESSDL
|
||
|
|
LOGICAL USESDF, NONQUAD, shells
|
||
|
|
CHARACTER*(*) COMTOP
|
||
|
|
|
||
|
|
C ... This routine was originally written to only handle quads, tris, and hexes.
|
||
|
|
C There was no checking of this, it blindly went through the list
|
||
|
|
C swapping nodes 1 and 2 (line) or nodes 4 and 2 (quad face).
|
||
|
|
|
||
|
|
C The routine now provides more checking and will return with a warning
|
||
|
|
C if applied to elements on other faces...
|
||
|
|
|
||
|
|
IF (NONQUAD .AND. COMTOP(:3) .NE. 'TET' .and.
|
||
|
|
* COMTOP(:5) .ne. 'SHELL') THEN
|
||
|
|
CALL PRTERR ('PROGRAM',
|
||
|
|
* 'Mirroring of sidesets on non-quad/line sides not supported')
|
||
|
|
RETURN
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (USESDF) THEN
|
||
|
|
CALL PRTERR ('WARNING',
|
||
|
|
* 'Mirroring of sideset distribution factors not supported')
|
||
|
|
RETURN
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C ... We have a quad/line face; do the mirroring.
|
||
|
|
if (comtop(:5) .eq. 'SHELL') then
|
||
|
|
shells = .true.
|
||
|
|
else
|
||
|
|
shells = .false.
|
||
|
|
end if
|
||
|
|
|
||
|
|
DO 10 NL = 1, NUMESS
|
||
|
|
call mirs1(IDESS(NL), NEESS(NL), NEDSS(NL), LTEESS(IXEESS(NL)),
|
||
|
|
* LTSSS(IXEESS(NL)), LTSNC(IXEESS(NL)), FAC(IXEDSS(NL)),
|
||
|
|
* USESDF, shells)
|
||
|
|
10 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine mirs1(id, numsid, numdis, elem, side, dfcnt, facedf,
|
||
|
|
* usesdf, shells)
|
||
|
|
|
||
|
|
integer id, numsid, numdis
|
||
|
|
integer elem(*), side(*), dfcnt(*)
|
||
|
|
real facedf(*)
|
||
|
|
logical usesdf
|
||
|
|
logical shells
|
||
|
|
CHARACTER*132 STRING
|
||
|
|
|
||
|
|
idf = 0
|
||
|
|
do 10 i = 1, numsid
|
||
|
|
icnt = dfcnt(i)
|
||
|
|
|
||
|
|
C ... Bar topology side -- Base element is quad (or we wouldn't be here)
|
||
|
|
if (icnt .eq. 2) then
|
||
|
|
side(i) = 5 - side(i)
|
||
|
|
|
||
|
|
C ... Quad topology side -- Base element is hex (or we wouldn't be here)
|
||
|
|
else if (icnt .eq. 4) then
|
||
|
|
if (shells) then
|
||
|
|
side(i) = side(i)
|
||
|
|
else
|
||
|
|
if (side(i) .le. 4) then
|
||
|
|
side(i) = 5 - side(i)
|
||
|
|
else
|
||
|
|
side(i) = side(i)
|
||
|
|
end if
|
||
|
|
end if
|
||
|
|
else if (icnt .eq. 3) then
|
||
|
|
C ... NOTE: This is a NONQUD, but COMTOP has been checked in calling code
|
||
|
|
C so we know that these are all tets or shells...
|
||
|
|
if (shells) then
|
||
|
|
side(i) = side(i)
|
||
|
|
else
|
||
|
|
if (side(i) .eq. 3) then
|
||
|
|
side(i) = 1
|
||
|
|
else if (side(i) .eq. 1) then
|
||
|
|
side(i) = 3
|
||
|
|
end if
|
||
|
|
end if
|
||
|
|
else
|
||
|
|
WRITE (STRING, 100) ID, ICNT
|
||
|
|
100 FORMAT('Sideset ',I5,' contains ',I2,'-node ',
|
||
|
|
* ' sides which are not supported for mirroring by gjoin2')
|
||
|
|
CALL SQZSTR (STRING, LSTR)
|
||
|
|
CALL PRTERR ('PROGRAM', STRING(:LSTR))
|
||
|
|
RETURN
|
||
|
|
end if
|
||
|
|
10 continue
|
||
|
|
return
|
||
|
|
end
|