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.
92 lines
3.1 KiB
92 lines
3.1 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
|
|
|
|
SUBROUTINE PNAMES(NAMECO, NAMEBL, NAMEHV, NAMEGV, NAMENV, NAMEEV,
|
|
& NDIM, NELBLK, NVARHI, NVARGL, NVARNP,NVAREL,COPY)
|
|
CHARACTER*8 NLIST(6), BLANK, NAMECO(*), NAMEBL(*), NAMEHV(*),
|
|
& NAMEGV(*), NAMENV(*), NAMEEV(*)
|
|
include 'nu_io.blk'
|
|
LOGICAL COPY
|
|
|
|
DATA BLANK/' '/
|
|
|
|
C************************************************************************
|
|
|
|
C G. D. Sjaardema, 1521, 01/30/88
|
|
|
|
C DESCRIPTION: Read and transfer the names found on the data base and
|
|
C print a formatted echo to SYS$OUTPUT
|
|
|
|
C DUMMY VARIABLES:
|
|
C NAMECO CHARACTER Names of coordinates
|
|
C NAMEBL CHARACTER Names of element blocks
|
|
C NAMEHV CHARACTER Names of history variables
|
|
C NAMEGV CHARACTER Names of global variables
|
|
C NAMENV CHARACTER Names of nodal variables
|
|
C NAMEEV CHARACTER Names of element variables
|
|
C NDIM INTEGER Number of spatial dimensions
|
|
C NELBLK INTEGER Number of element blocks
|
|
C NVARHI INTEGER Number of history variables
|
|
C NVARGL INTEGER Number of global variables
|
|
C NVARNP INTEGER Number of nodal variables
|
|
C NVAREL INTEGER Number of element variables
|
|
C COPY LOGICAL TRUE if echo to output data base
|
|
|
|
C COMMON VARIABLES: --NONE--
|
|
|
|
C FILES:
|
|
C UNIT NDB - INPUT, SEQUENTIAL, UNFORMATTED, READONLY
|
|
C UNIT 11 - OUTPUT, SEQUENTIAL, UNFORMATTED
|
|
C - Output database, written iff COPY = .TRUE.
|
|
|
|
C INTRINSICS CALLED:
|
|
C MAX -- Get maximum value of items in list
|
|
|
|
C ROUTINES CALLED: --NONE--
|
|
|
|
C************************************************************************
|
|
|
|
READ (NDB,END=2000,ERR=2100) (NAMEHV(I),I=1,NVARHI),
|
|
$ (NAMEGV(I),I=1,NVARGL),
|
|
$ (NAMENV(I),I=1,NVARNP),
|
|
$ (NAMEEV(I),I=1,NVAREL)
|
|
|
|
NROW = MAX(NDIM, NELBLK, NVARHI, NVARGL, NVARNP, NVAREL)
|
|
|
|
IF (.FALSE.) THEN
|
|
DO 10 I=1, NROW+1
|
|
DO 5 J=1,6
|
|
NLIST(J) = BLANK
|
|
5 CONTINUE
|
|
C -COORDINATE NAMES
|
|
IF (I .LE. NDIM) NLIST(1) = NAMECO(I)
|
|
C -HISTORY NAMES
|
|
IF (I .LE. NVARHI) NLIST(2) = NAMEHV(I)
|
|
C -GLOBAL NAMES
|
|
IF (I .LE. NVARGL) NLIST(3) = NAMEGV(I)
|
|
C -NODAL VARIABLE NAMES
|
|
IF (I .LE. NVARNP) NLIST(4) = NAMENV(I)
|
|
C -ELEMENT NAMES
|
|
IF (I .LE. NVAREL) NLIST(5) = NAMEEV(I)
|
|
C -ELEMENT BLOCK NAMES
|
|
IF (I .LE. NELBLK) NLIST(6) = NAMEBL(I)
|
|
|
|
PRINT 1500, (NLIST(J),J=1,6)
|
|
1500 FORMAT (T6,A8,T18,A8,T30,A8,T42,A8,T54,A8,T66,A8)
|
|
10 CONTINUE
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
C END OF FILE OR READ/WRITE ERROR DURING TRANSFER
|
|
|
|
2000 CONTINUE
|
|
PRINT *, 'End of file during names transfer'
|
|
STOP 'PNAMES'
|
|
2100 CONTINUE
|
|
PRINT *, 'Read error during names transfer'
|
|
STOP 'PNAMES'
|
|
END
|
|
|