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.
239 lines
8.0 KiB
239 lines
8.0 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 DBINAM (NDB, OPTION, NDIM, NELBLK,
|
|
& NNDIM, NNELB, NVARHI, NVARGL, NVARNP, NVAREL,
|
|
& NAMECO, NAMELB, VNAMES, IXHV, IXGV, IXNV, IXEV,
|
|
& IA, KIEVOK, EXODUS, *)
|
|
C=======================================================================
|
|
|
|
C --*** DBINAM *** (EXOLIB) Read database names
|
|
C -- Written by Amy Gilkey - revised 02/08/88
|
|
C --
|
|
C --DBINAM reads the names of the coordinates, the element block types,
|
|
C --and the database variables from the database. All names are converted
|
|
C --to uppercase and all embedded blanks within a name are removed.
|
|
C --The element block variable truth table is also read.
|
|
C --
|
|
C --Note that the numbers of variables are read in this routine.
|
|
C --
|
|
C --This routine calls DBIV1 if the truth table is read.
|
|
C --
|
|
C --This routine calls DBVINI and uses DBVIX to get the variable name
|
|
C --indices.
|
|
C --
|
|
C --Dynamic memory is reserved in this routine. If there is a problem,
|
|
C --the routine returns normally without printing an error message.
|
|
C --
|
|
C --Parameters:
|
|
C -- NDB - IN - the database number
|
|
C -- OPTION - IN - ' ' to not store, '*' to store all, else store options:
|
|
C -- 'C' to store coordinate names
|
|
C -- 'B' to store element block names
|
|
C -- 'V' to store variables names
|
|
C -- 'T' to store element block variable truth table
|
|
C -- NDIM - IN - the number of coordinates per node
|
|
C -- NELBLK - IN - the number of element blocks
|
|
C -- NNDIM - OUT - the number of coordinates per node; <0 if end-of-file
|
|
C -- NNELB - OUT - the number of element blocks; <0 if end-of-file
|
|
C -- NVARHI - OUT - the number of history variables; <0 if end-of-file
|
|
C -- NVARGL - OUT - the number of global variables; <0 if end-of-file
|
|
C -- NVARNP - OUT - the number of nodal variables; <0 if end-of-file
|
|
C -- NVAREL - OUT - the number of element variables; <0 if end-of-file
|
|
C -- NAMECO - OUT - the names of the coordinates; max size = 6 (if OPTION)
|
|
C -- NAMELB - OUT - the names of the element block types; max size = 256
|
|
C -- (if OPTION)
|
|
C -- VNAMES - OUT - the names of the global, nodal, and element variables;
|
|
C -- max size = 256 (if OPTION)
|
|
C -- IXHV - OUT - the VNAMES index of the history variable names (if OPTION)
|
|
C -- IXGV - OUT - the VNAMES index of the global variable names (if OPTION)
|
|
C -- IXNV - OUT - the VNAMES index of the nodal variable names (if OPTION)
|
|
C -- IXEV - OUT - the VNAMES index of the element variable names (if OPTION)
|
|
C -- A - OUT - the dynamic memory base array
|
|
C -- KIEVOK - OUT - the dynamic memory index of the element block variable
|
|
C -- truth table; (if OPTION)
|
|
C -- variable i of block j exists iff ISEVOK(j,i)
|
|
C -- EXODUS - OUT - false if GENESIS file, true if EXODUS file so far
|
|
C -- * - return statement if error encountered, including end-of-file;
|
|
C -- NOT used if valid GENESIS file; message is printed
|
|
C --
|
|
C --Database must be positioned in front of coordinate names upon entry;
|
|
C --upon exit positioned after names.
|
|
|
|
C --Routines Called:
|
|
C -- EXUPCS - (SUPES) Convert to uppercase and blank non-standard
|
|
C -- MDRSRV - (SUPES) Reserve dynamic memory
|
|
C -- PCKSTR - (STRLIB) Remove embedded blanks
|
|
|
|
PARAMETER (MAXDIM=6, MAXELB=512, MAXVAR=512)
|
|
|
|
INTEGER NDB
|
|
CHARACTER*(*) OPTION
|
|
INTEGER NDIM, NELBLK
|
|
INTEGER NNDIM, NNELB
|
|
CHARACTER*8 NAMECO(*)
|
|
CHARACTER*8 NAMELB(*)
|
|
CHARACTER*8 VNAMES(*)
|
|
INTEGER NVARHI, NVARGL, NVARNP, NVAREL
|
|
INTEGER IXHV, IXGV, IXNV, IXEV
|
|
INTEGER IA(*)
|
|
INTEGER KIEVOK
|
|
LOGICAL EXODUS
|
|
|
|
CHARACTER*80 ERRMSG
|
|
INTEGER LDUM
|
|
|
|
EXODUS = .FALSE.
|
|
NNDIM = -999
|
|
NNELB = -999
|
|
NVARHI = -999
|
|
NVARGL = -999
|
|
NVARNP = -999
|
|
NVAREL = -999
|
|
|
|
C --Read and pack coordinate names
|
|
|
|
IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'C') .GT. 0)) THEN
|
|
IF (NDIM .GT. MAXDIM) CALL PRTERR ('WARNING',
|
|
& 'Too many coordinate names in the database')
|
|
|
|
READ (NDB, END=160, ERR=170, IOSTAT=IERR)
|
|
& (NAMECO(I), I=1,MIN(NDIM,MAXDIM))
|
|
|
|
DO 100 I = 1, MIN(NDIM,MAXDIM)
|
|
CALL EXUPCS (NAMECO(I))
|
|
100 CONTINUE
|
|
CALL PCKSTR (MIN(NDIM,MAXDIM), NAMECO)
|
|
ELSE
|
|
READ (NDB, END=160, ERR=160, IOSTAT=IERR)
|
|
END IF
|
|
NNDIM = NDIM
|
|
|
|
C --Read and pack element block type names
|
|
|
|
IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'B') .GT. 0)) THEN
|
|
IF (NELBLK .GT. MAXELB) CALL PRTERR ('WARNING',
|
|
& 'Too many element block names in the database')
|
|
|
|
READ (NDB, END=160, ERR=180, IOSTAT=IERR)
|
|
& (NAMELB(I), I=1,MIN(NELBLK,MAXELB))
|
|
|
|
DO 110 I = 1, MIN(NELBLK,MAXELB)
|
|
CALL EXUPCS (NAMELB(I))
|
|
110 CONTINUE
|
|
CALL PCKSTR (MIN(NELBLK,MAXELB), NAMELB)
|
|
ELSE
|
|
READ (NDB, END=160, ERR=180, IOSTAT=IERR)
|
|
END IF
|
|
NNELB = NELBLK
|
|
|
|
C --Read the number of variables
|
|
|
|
READ (NDB, END=160, ERR=190, IOSTAT=IERR)
|
|
& NVARHI, NVARGL, NVARNP, NVAREL
|
|
if ((nvarhi + nvargl + nvarnp + nvarel) .eq. 0) go to 160
|
|
|
|
EXODUS = .TRUE.
|
|
|
|
C --Initialize for DBVTYP and DBVIX
|
|
|
|
CALL DBVINI (NVARHI, NVARGL, NVARNP, NVAREL)
|
|
|
|
IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'V') .GT. 0)) THEN
|
|
IF (NVARHI + NVARGL + NVARNP + NVAREL .GT. MAXVAR)
|
|
& CALL PRTERR ('WARNING',
|
|
& 'Too many variable names in the database')
|
|
|
|
C --Get the name indices
|
|
|
|
CALL DBVIX ('H', 1, IXHV)
|
|
CALL DBVIX ('H', NVARHI, IXHVE)
|
|
IXHVE = MIN(IXHVE,MAXVAR)
|
|
CALL DBVIX ('G', 1, IXGV)
|
|
CALL DBVIX ('G', NVARGL, IXGVE)
|
|
IXGVE = MIN(IXGVE,MAXVAR)
|
|
CALL DBVIX ('N', 1, IXNV)
|
|
CALL DBVIX ('N', NVARNP, IXNVE)
|
|
IXNVE = MIN(IXNVE,MAXVAR)
|
|
CALL DBVIX ('E', 1, IXEV)
|
|
CALL DBVIX ('E', NVAREL, IXEVE)
|
|
IXEVE = MIN(IXEVE,MAXVAR)
|
|
|
|
C --Read and pack variable names
|
|
|
|
READ (NDB, END=200, ERR=200, IOSTAT=IERR)
|
|
& (VNAMES(I), I=IXHV,IXHVE),
|
|
& (VNAMES(I), I=IXGV,IXGVE),
|
|
& (VNAMES(I), I=IXNV,IXNVE),
|
|
& (VNAMES(I), I=IXEV,IXEVE)
|
|
|
|
DO 120 I = IXHV, IXHVE
|
|
CALL EXUPCS (VNAMES(I))
|
|
120 CONTINUE
|
|
CALL PCKSTR (NVARHI, VNAMES(IXHV))
|
|
|
|
DO 130 I = IXGV, IXGVE
|
|
CALL EXUPCS (VNAMES(I))
|
|
130 CONTINUE
|
|
CALL PCKSTR (NVARGL, VNAMES(IXGV))
|
|
|
|
DO 140 I = IXNV, IXNVE
|
|
CALL EXUPCS (VNAMES(I))
|
|
140 CONTINUE
|
|
CALL PCKSTR (NVARNP, VNAMES(IXNV))
|
|
|
|
DO 150 I = IXEV, IXEVE
|
|
CALL EXUPCS (VNAMES(I))
|
|
150 CONTINUE
|
|
CALL PCKSTR (NVAREL, VNAMES(IXEV))
|
|
|
|
ELSE
|
|
READ (NDB, END=200, ERR=200, IOSTAT=IERR)
|
|
END IF
|
|
|
|
C --Read the element block variable truth table
|
|
|
|
IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'T') .GT. 0)) THEN
|
|
CALL MDRSRV ('ISEVOK', KIEVOK, NELBLK * NVAREL)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 160
|
|
|
|
CALL DBINM1 (NDB, OPTION, NELBLK, NVAREL, IA(KIEVOK),
|
|
* IA(KIEVOK), IERR, MAX(NELBLK,1), *210)
|
|
|
|
C --Call DBIV1
|
|
|
|
CALL DBIV1 (NELBLK,
|
|
& NVARHI, NVARGL, NVARNP, NVAREL, IA(KIEVOK))
|
|
|
|
ELSE
|
|
CALL DBINM1 (NDB, OPTION, NELBLK, NVAREL, LDUM, IDUM,
|
|
& IERR, MAX(NELBLK,1), *210)
|
|
END IF
|
|
|
|
160 CONTINUE
|
|
RETURN
|
|
|
|
170 CONTINUE
|
|
ERRMSG = 'COORDINATE NAMES'
|
|
GOTO 220
|
|
180 CONTINUE
|
|
ERRMSG = 'ELEMENT BLOCK NAMES'
|
|
GOTO 220
|
|
190 CONTINUE
|
|
ERRMSG = 'NUMBER OF VARIABLES'
|
|
GOTO 220
|
|
200 CONTINUE
|
|
ERRMSG = 'VARIABLE NAMES'
|
|
GOTO 220
|
|
210 CONTINUE
|
|
ERRMSG = 'ELEMENT BLOCK VARIABLE TRUTH TABLE'
|
|
GOTO 220
|
|
220 CONTINUE
|
|
CALL DBERR (IERR, ERRMSG)
|
|
RETURN 1
|
|
END
|
|
|