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.
 
 
 
 
 
 

113 lines
3.9 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 MUNESS (NUMESS, ISTAT, LESSEL, LESSDL,
& IDESS, NEESS, NEDSS, IXEESS, IXEDSS,
& LTEESS, LTSSS, FACSS,
& LTEX, LTSX, TDX, IXESS, IXDSS, NEX, NDX, ISCR, USESDF)
C=======================================================================
C --*** MUNESS *** (GJOIN) Compress and rearrange element side sets
C -- Written by Amy Gilkey - revised 02/25/88
C --
C --MUNESS processes the element side sets according to the set status.
C --Sets may be combined or deleted.
C --
C --Parameters:
C -- NUMESS - IN/OUT - the number of element side sets
C -- ISTAT - IN - the status of each set:
C -- 0 = same
C -- - = delete
C -- n = combine with set n
C -- LESSEL - IN/OUT - the length of the element side sets element list
C -- LESSDL - IN/OUT - the length of the element side sets dist-fact 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-fact 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-fact for each set
C -- LTEESS - IN/OUT - the elements for all sets
C -- LTSSS - IN/OUT - the sides for all sets
C -- FACSS - IN/OUT - the dist-fact for all sets
C -- LTEX - SCRATCH - sized to hold the set elements
C -- LTSX - SCRATCH - sized to hold the set sides
C -- TDX - SCRATCH - sized to hold the set dist-fact
C -- IXESS - SCRATCH - size = NUMESS
C -- IXDSS - SCRATCH - size = NUMESS -- dist-fact
C -- NEX - SCRATCH - size = NUMESS
C -- NDX - SCRATCH - size = NUMESS -- dist-face
C -- ISCR - SCRATCH - size = NUMESS
INTEGER ISTAT(*)
INTEGER IDESS(*)
INTEGER NEESS(*), NEDSS(*)
INTEGER IXEESS(*)
INTEGER LTEESS(*), LTEX(*)
INTEGER LTSSS(*), LTSX(*)
INTEGER IXESS(*), IXEDSS(*)
INTEGER NEX(*), NDX(*)
INTEGER ISCR(*)
REAL FACSS(*), TDX(*)
LOGICAL USESDF
IF (NUMESS .LE. 0) RETURN
JESS = 0
JNE = 1
JND = 1
DO 110 IESS = 1, NUMESS
IF (ISTAT(IESS) .EQ. 0) THEN
NINSET = 1
ISCR(NINSET) = IESS
ELSE IF (ISTAT(IESS) .EQ. IESS) THEN
CALL GETALL (IESS, NUMESS, ISTAT, NINSET, ISCR)
ELSE
NINSET = 0
END IF
IF (NINSET .GT. 0) THEN
JESS = JESS + 1
IXESS(JESS) = IESS
NEX(JESS) = 0
NDX(JESS) = 0
END IF
DO 100 ISET = 1, NINSET
N = ISCR(ISET)
CALL MOVINT (NEESS(N), LTEESS(IXEESS(N)), LTEX(JNE))
CALL MOVINT (NEESS(N), LTSSS(IXEESS(N)), LTSX(JNE))
IF (USESDF) THEN
CALL MOVREA (NEDSS(N), FACSS(IXEDSS(N)), TDX(JND))
ENDIF
JNE = JNE + NEESS(N)
JND = JND + NEDSS(N)
NEX(JESS) = NEX(JESS) + NEESS(N)
NDX(JESS) = NDX(JESS) + NEDSS(N)
100 CONTINUE
110 CONTINUE
CALL ORDIX (JESS, IXESS, NUMESS, IDESS, ISCR, IDESS)
CALL MOVINT (JESS, NEX, NEESS)
CALL MOVINT (JESS, NDX, NEDSS)
NUMESS = JESS
JNE = 1
JND = 1
DO 120 IESS = 1, NUMESS
IXEESS(IESS) = JNE
IXEDSS(IESS) = JND
JNE = JNE + NEESS(IESS)
JND = JND + NEDSS(IESS)
120 CONTINUE
LESSEL = JNE - 1
LESSDL = JND - 1
CALL MOVINT (LESSEL, LTEX, LTEESS)
CALL MOVINT (LESSEL, LTSX, LTSSS)
if (usesdf) then
CALL MOVREA (LESSDL, TDX, FACSS)
end if
RETURN
END