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.
245 lines
8.4 KiB
245 lines
8.4 KiB
2 years ago
|
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, NVARNS,
|
||
|
|
& NVARSS, NAMECO,
|
||
|
|
& IXHV, IXGV, IXNV, IXEV, IXNS, IXSS,
|
||
|
|
& A, IA, KIEVOK, C, KNAMES, EXODUS, IDELB,
|
||
|
|
& ISHEX, KHEXID, NAMLEN, *)
|
||
|
|
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 DBVINI and uses DBVIX_BL 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 -- IXHV - OUT - the VNAMES index of the history var names (if OPTION)
|
||
|
|
C -- IXGV - OUT - the VNAMES index of the global var names (if OPTION)
|
||
|
|
C -- IXNV - OUT - the VNAMES index of the nodal var names (if OPTION)
|
||
|
|
C -- IXEV - OUT - the VNAMES index of the element var names (if OPTION)
|
||
|
|
C -- IXNS - OUT - the VNAMES index of the nodeset var names (if OPTION)
|
||
|
|
C -- IXSS - OUT - the VNAMES index of the sideset var 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 -- C - OUT - the dynamic memory base array (character)
|
||
|
|
C -- KNAMES - OUT - the dynamic memory index of the variable names.
|
||
|
|
C -- EXODUS - OUT - false if GENESIS file, true if EXODUS file so far
|
||
|
|
C -- * - OUT - return statement if error encountered
|
||
|
|
C -- NOT used if valid GENESIS file; message is printed
|
||
|
|
C --
|
||
|
|
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
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
PARAMETER (MAXDIM=6)
|
||
|
|
|
||
|
|
INTEGER NDB
|
||
|
|
CHARACTER*(*) OPTION
|
||
|
|
INTEGER NDIM, NELBLK
|
||
|
|
INTEGER NNDIM, NNELB
|
||
|
|
CHARACTER*(MXSTLN) NAMECO(*)
|
||
|
|
INTEGER NVARHI, NVARGL, NVARNP, NVAREL
|
||
|
|
INTEGER IXHV, IXGV, IXNV, IXEV, IXNS, IXSS
|
||
|
|
DIMENSION A(*), IA(*)
|
||
|
|
INTEGER KIEVOK
|
||
|
|
CHARACTER*1 C(*)
|
||
|
|
INTEGER KNAMES
|
||
|
|
LOGICAL EXODUS
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
|
||
|
|
CHARACTER*80 ERRMSG
|
||
|
|
EXODUS = .FALSE.
|
||
|
|
NNDIM = -999
|
||
|
|
NNELB = -999
|
||
|
|
NVARHI = -999
|
||
|
|
NVARGL = -999
|
||
|
|
NVARNP = -999
|
||
|
|
NVAREL = -999
|
||
|
|
NVARNS = -999
|
||
|
|
NVARSS = -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')
|
||
|
|
|
||
|
|
C ... Easier to just hardwire the coordinate names...
|
||
|
|
nameco(1) = 'X'
|
||
|
|
nameco(2) = 'Y'
|
||
|
|
if (ndim .eq. 3) nameco(3) = 'Z'
|
||
|
|
|
||
|
|
DO 100 I = 1, MIN(NDIM,MAXDIM)
|
||
|
|
CALL EXUPCS (NAMECO(I))
|
||
|
|
100 CONTINUE
|
||
|
|
CALL PCKSTR (MIN(NDIM,MAXDIM), NAMECO)
|
||
|
|
END IF
|
||
|
|
NNDIM = NDIM
|
||
|
|
|
||
|
|
C --Read the number of variables
|
||
|
|
|
||
|
|
nvarhi = 0
|
||
|
|
call exgvp(ndb, 'G', nvargl, ierr)
|
||
|
|
call exgvp(ndb, 'N', nvarnp, ierr)
|
||
|
|
call exgvp(ndb, 'E', nvarel, ierr)
|
||
|
|
call exgvp(ndb, 'M', nvarns, ierr)
|
||
|
|
call exgvp(ndb, 'S', nvarss, ierr)
|
||
|
|
|
||
|
|
C --Initialize for DBVTYP_BL and DBVIX_BL
|
||
|
|
|
||
|
|
CALL DBVINI_BL (NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)
|
||
|
|
|
||
|
|
if ((nvarhi + nvargl + nvarnp + nvarel + nvarns + nvarss) .eq. 0)
|
||
|
|
* go to 160
|
||
|
|
|
||
|
|
EXODUS = .TRUE.
|
||
|
|
IF ((OPTION .EQ. '*') .OR. (INDEX (OPTION, 'V') .GT. 0)) THEN
|
||
|
|
|
||
|
|
C --Get the name indices
|
||
|
|
|
||
|
|
CALL MCRSRV('NAMES', KNAMES,
|
||
|
|
* NAMLEN*(NVARHI+NVARGL+NVARNP+NVAREL+NVARNS+NVARSS))
|
||
|
|
CALL MCSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 180
|
||
|
|
CALL DBVIX_BL ('H', 1, IXHV)
|
||
|
|
CALL DBVIX_BL ('H', NVARHI, IXHVE)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('G', 1, IXGV)
|
||
|
|
CALL DBVIX_BL ('G', NVARGL, IXGVE)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('N', 1, IXNV)
|
||
|
|
CALL DBVIX_BL ('N', NVARNP, IXNVE)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('E', 1, IXEV)
|
||
|
|
CALL DBVIX_BL ('E', NVAREL, IXEVE)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('M', 1, IXNS)
|
||
|
|
CALL DBVIX_BL ('M', NVARNS, IXNSE)
|
||
|
|
|
||
|
|
CALL DBVIX_BL ('S', 1, IXSS)
|
||
|
|
CALL DBVIX_BL ('S', NVARSS, IXSSE)
|
||
|
|
|
||
|
|
C --Read and pack variable names
|
||
|
|
|
||
|
|
call dbinm2 (ndb, nvargl, nvarnp, nvarel, nvarns, nvarss,
|
||
|
|
& C(KNAMES+NAMLEN*(IXGV-1)),
|
||
|
|
& C(KNAMES+NAMLEN*(IXNV-1)),
|
||
|
|
& C(KNAMES+NAMLEN*(IXEV-1)),
|
||
|
|
& C(KNAMES+NAMLEN*(IXNS-1)),
|
||
|
|
& C(KNAMES+NAMLEN*(IXSS-1)), namlen)
|
||
|
|
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 MDRSRV ('ITMP', KITMP, NELBLK * NVAREL)
|
||
|
|
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 160
|
||
|
|
|
||
|
|
CALL DBINM1 (NDB, OPTION, NELBLK, NVAREL, IA(KIEVOK),
|
||
|
|
& IA(KIEVOK), IA(KITMP), IERR, MAX(NELBLK,1),
|
||
|
|
& IDELB, ISHEX, IA(KHEXID), A, IA, *210)
|
||
|
|
call mddel('ITMP')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
160 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
180 CONTINUE
|
||
|
|
ERRMSG = 'ELEMENT BLOCK NAMES'
|
||
|
|
GOTO 220
|
||
|
|
210 CONTINUE
|
||
|
|
ERRMSG = 'ELEMENT BLOCK VARIABLE TRUTH TABLE'
|
||
|
|
GOTO 220
|
||
|
|
220 CONTINUE
|
||
|
|
CALL DBERR (IERR, ERRMSG)
|
||
|
|
RETURN 1
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine dbinm2 (ndb, nvargl, nvarnp, nvarel, nvarns, nvarss,
|
||
|
|
& namgv, namnv, namev, namns, namss, namlen)
|
||
|
|
|
||
|
|
include 'params.blk'
|
||
|
|
character*(namlen) namgv(*), namnv(*), namev(*), namns(*),
|
||
|
|
* namss(*)
|
||
|
|
|
||
|
|
if (nvargl .gt. 0) then
|
||
|
|
call exgvan(ndb, 'G', nvargl, namgv, ierr)
|
||
|
|
end if
|
||
|
|
if (nvarnp .gt. 0) then
|
||
|
|
call exgvan(ndb, 'N', nvarnp, namnv, ierr)
|
||
|
|
end if
|
||
|
|
if (nvarel .gt. 0) then
|
||
|
|
call exgvan(ndb, 'E', nvarel, namev, ierr)
|
||
|
|
end if
|
||
|
|
if (nvarns .gt. 0) then
|
||
|
|
call exgvan(ndb, 'M', nvarns, namns, ierr)
|
||
|
|
end if
|
||
|
|
if (nvarss .gt. 0) then
|
||
|
|
call exgvan(ndb, 'S', nvarss, namss, ierr)
|
||
|
|
end if
|
||
|
|
|
||
|
|
DO 130 I = 1, nvargl
|
||
|
|
CALL EXUPCS (namgv(i))
|
||
|
|
130 CONTINUE
|
||
|
|
CALL PCKSTR (NVARGL, namgv)
|
||
|
|
|
||
|
|
DO 140 I = 1, nvarnp
|
||
|
|
CALL EXUPCS (namnv(i))
|
||
|
|
140 CONTINUE
|
||
|
|
CALL PCKSTR (NVARNP, namnv)
|
||
|
|
|
||
|
|
DO 150 I = 1, nvarel
|
||
|
|
CALL EXUPCS (namev(i))
|
||
|
|
150 CONTINUE
|
||
|
|
CALL PCKSTR (NVAREL, namev)
|
||
|
|
|
||
|
|
DO I = 1, nvarns
|
||
|
|
CALL EXUPCS (namns(i))
|
||
|
|
END DO
|
||
|
|
CALL PCKSTR (NVARNS, namns)
|
||
|
|
|
||
|
|
DO I = 1, nvarss
|
||
|
|
CALL EXUPCS (namss(i))
|
||
|
|
END DO
|
||
|
|
CALL PCKSTR (NVARSS, namss)
|
||
|
|
|
||
|
|
return
|
||
|
|
end
|