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.
226 lines
7.4 KiB
226 lines
7.4 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 PRNPS (OPTION, NOUT, NUMNPS, LISNPS, LNPSNL,
|
|
& IDNPS, NNNPS, NDNPS, IXNNPS, IXDNPS, LTNNPS, FACNPS, NAME,
|
|
$ nvar, namvar, isvok, lisvar,
|
|
$ MAPNO, DOMAPN)
|
|
C=======================================================================
|
|
|
|
C --*** PRNPS *** (EXPLORE) Display database nodal point set
|
|
C --
|
|
C --PRNPS displays the nodal point sets.
|
|
C --
|
|
C --Parameters:
|
|
C -- OPTION - IN - '*' to print all, else print options:
|
|
C -- ' ' - set summary (number of nodes, etc)
|
|
C -- 'N' - nodes in set
|
|
C -- 'F' - distribution factors for set
|
|
C -- NOUT - IN - the output file, <=0 for standard
|
|
C -- NUMNPS - IN - the number of nodal point sets
|
|
C -- LISNPS - IN - the indices of the selected nodal point sets
|
|
C -- LNPSNL - IN - the number of nodes for all sets
|
|
C -- IDNPS - IN - the nodal point set ID for each set
|
|
C -- NNNPS - IN - the number of nodes for each set
|
|
C -- NDNPS - IN - the number of distribution factors for each set
|
|
C -- IXNNPS - IN - the index of the first node for each set
|
|
C -- IXDNPS - IN - the index of the first dist factor for each set
|
|
C -- LTNNPS - IN - the nodes for all sets
|
|
C -- FACNPS - IN - the distribution factors for all sets
|
|
C -- NVAR - IN - the number of variables
|
|
C -- NAMVAR - IN - the names of the variables
|
|
C -- ISVOK - IN - the variable truth table;
|
|
C -- variable i of set j exists iff ISVOK(i,j) is NOT 0
|
|
C -- LISVAR - SCRATCH - size = NVAR (if 'V' in OPTION)
|
|
|
|
include 'exodusII.inc'
|
|
CHARACTER*(*) OPTION
|
|
INTEGER LISNPS(0:*)
|
|
INTEGER IDNPS(*)
|
|
INTEGER NNNPS(*)
|
|
INTEGER NDNPS(*)
|
|
INTEGER IXNNPS(*)
|
|
INTEGER IXDNPS(*)
|
|
INTEGER LTNNPS(*)
|
|
REAL FACNPS(*)
|
|
CHARACTER*(*) NAME(*)
|
|
CHARACTER*(*) NAMVAR(*)
|
|
INTEGER ISVOK(NVAR,*)
|
|
INTEGER LISVAR(*)
|
|
INTEGER MAPNO(*)
|
|
LOGICAL DOMAPN
|
|
|
|
LOGICAL ALLSAM
|
|
LOGICAL DONOD, DOFAC, DOVTBL
|
|
CHARACTER*20 STRA, STRB
|
|
|
|
DONOD = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'N') .GT. 0))
|
|
DOFAC = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'F') .GT. 0))
|
|
DOVTBL = ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'V') .GT. 0))
|
|
|
|
IF (NOUT .GT. 0) THEN
|
|
IF (DONOD .AND. DOFAC) THEN
|
|
WRITE (NOUT, 10020) 'NODE LIST AND DISTRIBUTION FACTORS'
|
|
ELSE IF (DONOD) THEN
|
|
WRITE (NOUT, 10020) 'NODE LIST'
|
|
ELSE IF (DOFAC) THEN
|
|
WRITE (NOUT, 10020) 'DISTRIBUTION FACTORS'
|
|
ELSE
|
|
WRITE (NOUT, 10020)
|
|
END IF
|
|
END IF
|
|
|
|
if (domapn) then
|
|
if (nout .gt. 0) then
|
|
write (nout, 10005)
|
|
else
|
|
write (*, 10005)
|
|
end if
|
|
end if
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, *)
|
|
ELSE
|
|
WRITE (*, *)
|
|
END IF
|
|
|
|
WRITE (STRA, 10000, IOSTAT=IDUM) NUMNPS
|
|
10000 FORMAT ('(#', I4, ')')
|
|
CALL PCKSTR (1, STRA)
|
|
LSTRA = LENSTR (STRA)
|
|
WRITE (STRB, 10010, IOSTAT=IDUM) LNPSNL
|
|
10010 FORMAT ('(index=', I12, ')')
|
|
CALL PCKSTR (1, STRB)
|
|
LSTRB = LENSTR (STRB)
|
|
|
|
DO 100 IX = 1, LISNPS(0)
|
|
INPS = LISNPS(IX)
|
|
WRITE (STRA, 10000, IOSTAT=IDUM) INPS
|
|
CALL PCKSTR (1, STRA)
|
|
WRITE (STRB, 10010, IOSTAT=IDUM) IXNNPS(INPS)
|
|
CALL PCKSTR (1, STRB)
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10030, IOSTAT=IDUM)
|
|
& IDNPS(INPS), STRA(:LSTRA),
|
|
& NNNPS(INPS), STRB(:LSTRB),
|
|
$ NAME(INPS)(:LENSTR(NAME(INPS)))
|
|
ELSE
|
|
WRITE (*, 10030, IOSTAT=IDUM)
|
|
& IDNPS(INPS), STRA(:LSTRA),
|
|
& NNNPS(INPS), STRB(:LSTRB),
|
|
$ NAME(INPS)(:LENSTR(NAME(INPS)))
|
|
END IF
|
|
|
|
IF (DONOD .AND. (NNNPS(INPS) .GT. 0)) THEN
|
|
IS = IXNNPS(INPS)
|
|
IE = IS + NNNPS(INPS) - 1
|
|
IF (NOUT .GT. 0) THEN
|
|
if (domapn) then
|
|
WRITE (NOUT, 10040, IOSTAT=IDUM)
|
|
& (MAPNO(LTNNPS(I)), I=IS,IE)
|
|
else
|
|
WRITE (NOUT, 10040, IOSTAT=IDUM)
|
|
& (LTNNPS(I), I=IS,IE)
|
|
end if
|
|
ELSE
|
|
if (domapn) then
|
|
WRITE (*, 10040, IOSTAT=IDUM)
|
|
& (MAPNO(LTNNPS(I)), I=IS,IE)
|
|
else
|
|
WRITE (*, 10040, IOSTAT=IDUM)
|
|
& (LTNNPS(I), I=IS,IE)
|
|
end if
|
|
END IF
|
|
END IF
|
|
|
|
IF (DOVTBL) THEN
|
|
NSEL = 0
|
|
mxnam = 0
|
|
DO 30 I = 1, NVAR
|
|
IF (ISVOK(I,INPS) .NE. 0) THEN
|
|
NSEL = NSEL + 1
|
|
LISVAR(NSEL) = I
|
|
LNAM = lenstr(namvar(i))
|
|
mxnam = max(lnam, mxnam)
|
|
END IF
|
|
30 CONTINUE
|
|
|
|
if (nsel .gt. 0) then
|
|
IF (NOUT .GT. 0) THEN
|
|
if (mxnam .gt. 24) then
|
|
WRITE (NOUT, 10090, IOSTAT=IDUM)
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
|
else
|
|
WRITE (NOUT, 10070, IOSTAT=IDUM)
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
|
endif
|
|
write (nout, 10080)
|
|
ELSE
|
|
if (mxnam .gt. 24) then
|
|
WRITE (*, 10090, IOSTAT=IDUM)
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
|
else
|
|
WRITE (*, 10070, IOSTAT=IDUM)
|
|
& (NAMVAR(LISVAR(I))(:mxnam), I=1,NSEL)
|
|
endif
|
|
write (*, 10080)
|
|
END IF
|
|
end if
|
|
END IF
|
|
|
|
IF (DOFAC) THEN
|
|
IF (NDNPS(INPS) .GT. 0) THEN
|
|
IS = IXDNPS(INPS)
|
|
IE = IS + NDNPS(INPS) - 1
|
|
C ... See if all values are the same
|
|
val = facnps(is)
|
|
allsam = .TRUE.
|
|
do 50 i=is+1, ie
|
|
if (facnps(i) .ne. val) then
|
|
allsam = .FALSE.
|
|
go to 90
|
|
end if
|
|
50 continue
|
|
90 continue
|
|
|
|
if (allsam) then
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10055, IOSTAT=IDUM) VAL
|
|
ELSE
|
|
WRITE (*, 10055, IOSTAT=IDUM) VAL
|
|
END IF
|
|
else
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10050, IOSTAT=IDUM)
|
|
& (FACNPS(I), I=IS,IE)
|
|
ELSE
|
|
WRITE (*, 10050, IOSTAT=IDUM)
|
|
& (FACNPS(I), I=IS,IE)
|
|
END IF
|
|
end if
|
|
ELSE
|
|
IF (NOUT .GT. 0) THEN
|
|
WRITE (NOUT, 10060, IOSTAT=IDUM)
|
|
ELSE
|
|
WRITE (*, 10060, IOSTAT=IDUM)
|
|
END IF
|
|
END IF
|
|
END IF
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
|
|
10005 FORMAT (1X, 'Nodal ids are Global')
|
|
10020 FORMAT (/, 1X, 'NODAL POINT SETS', :, ' - ', A)
|
|
10030 FORMAT (1X, 'Set', I12, 1X, A, ':',
|
|
& I12, ' nodes', 1X, A, ' name = "',A,'"')
|
|
10040 FORMAT ((1X, 8I12))
|
|
10050 FORMAT ((1X, 6 (1X, 1pE11.4)))
|
|
10055 FORMAT (10x, 'All distribution factors are equal to ', 1pe11.4)
|
|
10060 FORMAT (10x, 'Distribution factors not stored in file.')
|
|
10070 FORMAT ((2x,4(2X, A)))
|
|
10090 FORMAT ((2x,3(2X, A)))
|
|
10080 FORMAT (1X)
|
|
END
|
|
|