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.
 
 
 
 
 
 

99 lines
3.2 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 PRTNPS (ISTAT, NNPS1, NNPS2, IDNPS, NNNPS, ISCR)
C=======================================================================
C --*** PRTNPS *** (GJOIN) Print summary for nodal point sets
C -- Written by Amy Gilkey - revised 02/04/88
C --
C --PRTNPS prints a summary for the nodal point sets, including their
C --status.
C --
C --Parameters:
C -- ISTAT - IN - the status of each nodal point set:
C -- 0 = same
C -- - = delete
C -- n = combine with block n
C -- NNPS1 - IN - the number of nodal point sets in the first database
C -- NNPS2 - IN - the number of nodal point sets in the second database
C -- IDNPS - IN - the nodal point set ID for each set
C -- NNNPS - IN - the number of nodes for each set
C -- ISCR - SCRATCH - size = NNPS1+NNPS2
INTEGER ISTAT(*)
INTEGER IDNPS(*)
INTEGER NNNPS(*)
INTEGER ISCR(*)
CHARACTER*2 STR2
CHARACTER*20 STRA, STRB
CHARACTER CH
NUMNPS = NNPS1 + NNPS2
IF (NUMNPS .LE. 0) RETURN
WRITE (*, *)
WRITE (*, *) 'Nodal point sets:'
WRITE (STRA, 10000) NUMNPS
10000 FORMAT ('(#', I5, ')')
CALL PCKSTR (1, STRA)
LSTRA = LENSTR (STRA)
DO 110 INPS = 1, NUMNPS
IF (ISTAT(INPS) .EQ. 0) THEN
WRITE (STRA, 10000) INPS
CALL PCKSTR (1, STRA)
CH = ' '
IF (INPS .GT. NNPS1) CH = '*'
WRITE (*, 10010) CH, IDNPS(INPS), STRA(:LSTRA),
& NNNPS(INPS)
ELSE IF (ISTAT(INPS) .GT. 0) THEN
IF (ISTAT(INPS) .EQ. INPS) THEN
CALL GETALL (INPS, NUMNPS, ISTAT, NINSET, ISCR)
WRITE (STRB, '(I5)') IDNPS(INPS)
CALL SQZSTR (STRB, LSTRB)
DO 100 ISET = 1, NINSET
IF (ISET .EQ. 1) THEN
#if NeedsDoubleEscape
STR2 = '\\ '
#else
STR2 = '\ '
#endif
ELSE IF (ISET .EQ. NINSET) THEN
STR2 = '/ '
ELSE
STR2 = ' |'
END IF
I = ISCR(ISET)
WRITE (STRA, 10000) I
CALL PCKSTR (1, STRA)
CH = ' '
IF (I .GT. NNPS1) CH = '*'
WRITE (*, 10010) CH, IDNPS(I), STRA(:LSTRA),
& NNNPS(I),
& STR2, 'combined into ID ', STRB(:LSTRB)
100 CONTINUE
ELSE
CONTINUE
END IF
ELSE IF (ISTAT(INPS) .LT. 0) THEN
WRITE (STRA, 10000) INPS
CALL PCKSTR (1, STRA)
CH = ' '
IF (INPS .GT. NNPS1) CH = '*'
WRITE (*, 10010) CH, IDNPS(INPS), STRA(:LSTRA),
& NNNPS(INPS), '<deleted>'
END IF
110 CONTINUE
RETURN
10010 FORMAT (2X, A1, 1X, 'Set', I6, 1X, A, ':',
& I9, ' nodes', :, 3X, A, :, 3X, 5A)
END