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.3 KiB
131 lines
4.3 KiB
C Copyright(C) 1999-2020, 2022 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 MUNNPS (NUMNPS, ISTAT, LNPSNL, LNPSDF,
|
|
& IDNPS, NNNPS, IXNNPS, LTNNPS, FACNPS,
|
|
& LTNX, FACX, IXNPS, NNX, ISCR, NAMSCR, NAME)
|
|
C=======================================================================
|
|
|
|
C --*** MUNNPS *** (GJOIN) Compress and rearrange nodal point sets
|
|
C -- Written by Amy Gilkey - revised 02/25/88
|
|
C --
|
|
C --MUNNPS processes the nodal point sets according to the set status.
|
|
C --Sets may be combined or deleted.
|
|
C --
|
|
C --Parameters:
|
|
C -- NUMNPS - IN/OUT - the number of nodal point sets
|
|
C -- ISTAT - IN - the status of each set:
|
|
C -- 0 = same
|
|
C -- - = delete
|
|
C -- n = combine with set n
|
|
C -- LNPSNL - IN/OUT - the length of the nodal point sets node list
|
|
C -- LNPSDF - IN/OUT - the length of the nodal point dist.fact. list
|
|
C -- IDNPS - IN/OUT - the nodal point set ID for each set
|
|
C -- NNNPS - IN/OUT - the number of nodes for each set
|
|
C -- IXNNPS - IN/OUT - the index of the first node for each set
|
|
C -- LTNNPS - IN/OUT - the nodes for all sets
|
|
C -- FACNPS - IN/OUT - the distribution factors for all sets
|
|
C -- LTNX - SCRATCH - sized to hold the set nodes
|
|
C -- FACX - SCRATCH - sized to hold the set factors
|
|
C -- IXNPS - SCRATCH - size = NUMNPS
|
|
C -- NNX - SCRATCH - size = NUMNPS
|
|
C -- ISCR - SCRATCH - size = NUMNPS
|
|
|
|
include 'gp_params.blk'
|
|
include 'gp_namlen.blk'
|
|
|
|
INTEGER ISTAT(*)
|
|
INTEGER IDNPS(*)
|
|
INTEGER NNNPS(*)
|
|
INTEGER IXNNPS(*)
|
|
INTEGER LTNNPS(*), LTNX(*)
|
|
REAL FACNPS(*), FACX(*)
|
|
INTEGER IXNPS(*)
|
|
INTEGER NNX(*)
|
|
INTEGER ISCR(*)
|
|
CHARACTER*(maxnam) NAMSCR(*)
|
|
CHARACTER*(maxnam) NAME(*)
|
|
|
|
IF (NUMNPS .LE. 0) RETURN
|
|
|
|
IF (LNPSDF .NE. LNPSNL .AND. LNPSDF .NE. 0) then
|
|
call prterr('ERROR',
|
|
* 'Length of nodeset dist. fact. list must be zero or '//
|
|
* 'equal to length of nodeset node list. It is neither.')
|
|
end if
|
|
|
|
JNPS = 0
|
|
JNN0 = 0
|
|
DO 120 INPS = 1, NUMNPS
|
|
|
|
IF (ISTAT(INPS) .EQ. 0) THEN
|
|
NINSET = 1
|
|
ISCR(NINSET) = INPS
|
|
ELSE IF (ISTAT(INPS) .EQ. INPS) THEN
|
|
CALL GETALL (INPS, NUMNPS, ISTAT, NINSET, ISCR)
|
|
ELSE
|
|
NINSET = 0
|
|
END IF
|
|
|
|
IF (NINSET .GT. 0) THEN
|
|
JNPS = JNPS + 1
|
|
IXNPS(JNPS) = INPS
|
|
NNX(JNPS) = 0
|
|
JOLD = JNN0+1
|
|
END IF
|
|
|
|
DO 110 ISET = 1, NINSET
|
|
N = ISCR(ISET)
|
|
JLEN = JNN0+1 - JOLD
|
|
INN0 = IXNNPS(N) - 1
|
|
C ... Find max node number in the LTNX(JOLD:JOLD+JLEN) array.
|
|
maxnod = 0
|
|
do 90 i=jold, jold+jlen-1
|
|
if (ltnx(i) .gt. maxnod) maxnod = ltnx(i)
|
|
90 continue
|
|
|
|
NNEW = 0
|
|
C ... Goal is to minimize the number of calls to locint.
|
|
C More memory intensive solution may be to index all nodes
|
|
C contained in ltnx(jold,jold+jlen) in
|
|
C a large array and see if ltnnps(inno+i) is indexed....
|
|
|
|
DO 100 I = 1, NNNPS(N)
|
|
IF (JLEN .EQ. 0 .OR. maxnod .lt. LTNNPS(INN0+I) .or.
|
|
* LOCINT (LTNNPS(INN0+I), JLEN, LTNX(JOLD)) .EQ. 0)
|
|
& THEN
|
|
NNEW = NNEW + 1
|
|
LTNX(JNN0+NNEW) = LTNNPS(INN0+I)
|
|
if (lnpsdf .ne. 0) then
|
|
FACX(JNN0+NNEW) = FACNPS(INN0+I)
|
|
end if
|
|
END IF
|
|
100 CONTINUE
|
|
NNX(JNPS) = NNX(JNPS) + NNEW
|
|
JNN0 = JNN0 + NNEW
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
|
|
CALL ORDIX (JNPS, IXNPS, NUMNPS, IDNPS, ISCR, IDNPS)
|
|
CALL ORDSTR(JNPS, IXNPS, NUMNPS, NAME, NAMSCR)
|
|
CALL MOVINT (JNPS, NNX, NNNPS)
|
|
NUMNPS = JNPS
|
|
JNN = 1
|
|
DO 130 INPS = 1, NUMNPS
|
|
IXNNPS(INPS) = JNN
|
|
JNN = JNN + NNNPS(INPS)
|
|
130 CONTINUE
|
|
LNPSNL = JNN - 1
|
|
|
|
CALL MOVINT (LNPSNL, LTNX, LTNNPS)
|
|
if (lnpsdf .ne. 0) then
|
|
CALL MOVREA (LNPSNL, FACX, FACNPS)
|
|
lnpsdf = lnpsnl
|
|
end if
|
|
|
|
RETURN
|
|
END
|
|
|