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.
184 lines
6.1 KiB
184 lines
6.1 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 RDNAME (A, C, NDB, KVNAMI, KVNAMO,
|
||
|
|
& IXGV, IXNV, IXEV, IXNS, IXSS, KIEVOK, KNSVOK, KSSVOK)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** RDNAME *** (EXPLORE) Read database names
|
||
|
|
C --
|
||
|
|
C --RDNAME reads the names of the coordinates, the element block types,
|
||
|
|
C --and the database variables. The element block variable truth table
|
||
|
|
C --is also read. An error message is displayed if the end of file is read.
|
||
|
|
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 -- A - OUT - the dynamic memory base array
|
||
|
|
C -- NDB - IN - the database number
|
||
|
|
C -- NDIM - IN - the number of coordinates per node
|
||
|
|
C -- NELBLK - IN - the number of element blocks
|
||
|
|
C -- MAXELB - IN - the maximum number of element block type names to store
|
||
|
|
C -- MAXVAR - IN - the maximum number of variable names to store
|
||
|
|
C -- NAMECO - OUT - the names of the coordinates
|
||
|
|
C -- EBTYPE - OUT - the names of the element block types
|
||
|
|
C -- VNAMEI - OUT - the names of the global, nodal, and element variables
|
||
|
|
C -- exactly as input (including blanks and lowercase)
|
||
|
|
C -- VNAMEO - OUT - the names of the global, nodal, and element variables
|
||
|
|
C -- with blanks deleted and converted to uppercase
|
||
|
|
C -- NVARGL - OUT - the number of global variables
|
||
|
|
C -- IXGV - OUT - the VNAME index of the global variable names
|
||
|
|
C -- NVARNP - OUT - the number of nodal variables
|
||
|
|
C -- IXNV - OUT - the VNAME index of the nodal variable names
|
||
|
|
C -- NVAREL - OUT - the number of element variables
|
||
|
|
C -- IXEV - OUT - the VNAME index of the element variable names
|
||
|
|
C -- KIEVOK - OUT - the dynamic memory index of the element block variable
|
||
|
|
C -- truth table;
|
||
|
|
C -- variable i of block j exists iff ISEVOK(i,j) is NOT 0
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
include 'exp_dbnums.blk'
|
||
|
|
|
||
|
|
DIMENSION A(*)
|
||
|
|
CHARACTER*1 C(*)
|
||
|
|
|
||
|
|
CHARACTER*80 ERRMSG
|
||
|
|
|
||
|
|
NVARGL = 0
|
||
|
|
NVARNP = 0
|
||
|
|
NVAREL = 0
|
||
|
|
NVARNS = 0
|
||
|
|
NVARSS = 0
|
||
|
|
|
||
|
|
IXGV = 1
|
||
|
|
IXNV = 1
|
||
|
|
IXEV = 1
|
||
|
|
IXNS = 1
|
||
|
|
IXSS = 1
|
||
|
|
|
||
|
|
KIEVOK = 1
|
||
|
|
KNSVOK = 1
|
||
|
|
KSSVOK = 1
|
||
|
|
|
||
|
|
C ... Read number of variables of each type
|
||
|
|
call exgvp (ndb, 'g', nvargl, ierr)
|
||
|
|
if (ierr .ne. 0) go to 210
|
||
|
|
call exgvp (ndb, 'n', nvarnp, ierr)
|
||
|
|
if (ierr .ne. 0) go to 211
|
||
|
|
call exgvp (ndb, 'e', nvarel, ierr)
|
||
|
|
if (ierr .ne. 0) go to 212
|
||
|
|
call exgvp (ndb, 'm', nvarns, ierr)
|
||
|
|
if (ierr .ne. 0) go to 212
|
||
|
|
call exgvp (ndb, 's', nvarss, ierr)
|
||
|
|
if (ierr .ne. 0) go to 212
|
||
|
|
|
||
|
|
C --Get the name indices
|
||
|
|
IXGV = 1
|
||
|
|
IXGVE = IXGV + NVARGL - 1
|
||
|
|
IXNV = IXGVE + 1
|
||
|
|
IXNVE = IXNV + NVARNP - 1
|
||
|
|
IXEV = IXNVE + 1
|
||
|
|
IXEVE = IXEV + NVAREL - 1
|
||
|
|
IXNS = IXEVE + 1
|
||
|
|
IXNSE = IXNS + NVARNS - 1
|
||
|
|
IXSS = IXNSE + 1
|
||
|
|
IXSSE = IXSS + NVARSS - 1
|
||
|
|
|
||
|
|
C ... Allocate space for variable names
|
||
|
|
nname = nvargl + nvarnp + nvarel + nvarns + nvarss
|
||
|
|
call mcrsrv('VNAMEI', kvnami, nname*namlen)
|
||
|
|
call mcrsrv('VNAMEO', kvnamo, nname*namlen)
|
||
|
|
call mcstat(nerr, nused)
|
||
|
|
if (nerr .gt. 0) go to 240
|
||
|
|
|
||
|
|
C ... Read variable names (wrapper used to get character length correct)
|
||
|
|
ioff = 0
|
||
|
|
call rdnam2(ndb, c(kvnami+ioff), nvargl, 'g', ierr, namlen)
|
||
|
|
if (ierr .ne. 0) go to 220
|
||
|
|
call fixnam(c(kvnami+ioff), c(kvnamo+ioff), nvargl, namlen)
|
||
|
|
|
||
|
|
ioff = ioff + (nvargl * namlen)
|
||
|
|
call rdnam2(ndb, c(kvnami+ioff), nvarnp, 'n', ierr, namlen)
|
||
|
|
if (ierr .ne. 0) go to 220
|
||
|
|
call fixnam(c(kvnami+ioff), c(kvnamo+ioff), nvarnp, namlen)
|
||
|
|
|
||
|
|
ioff = ioff + (nvarnp * namlen)
|
||
|
|
call rdnam2(ndb, c(kvnami+ioff), nvarel, 'e', ierr, namlen)
|
||
|
|
if (ierr .ne. 0) go to 220
|
||
|
|
call fixnam(c(kvnami+ioff), c(kvnamo+ioff), nvarel, namlen)
|
||
|
|
|
||
|
|
ioff = ioff + (nvarel * namlen)
|
||
|
|
call rdnam2(ndb, c(kvnami+ioff), nvarns, 'm', ierr, namlen)
|
||
|
|
if (ierr .ne. 0) go to 220
|
||
|
|
call fixnam(c(kvnami+ioff), c(kvnamo+ioff), nvarns, namlen)
|
||
|
|
|
||
|
|
ioff = ioff + (nvarns * namlen)
|
||
|
|
call rdnam2(ndb, c(kvnami+ioff), nvarss, 's', ierr, namlen)
|
||
|
|
if (ierr .ne. 0) go to 220
|
||
|
|
call fixnam(c(kvnami+ioff), c(kvnamo+ioff), nvarss, namlen)
|
||
|
|
|
||
|
|
C ... Read the element block variable truth table
|
||
|
|
CALL MDRSRV ('ISEVOK', KIEVOK, NELBLK * NVAREL)
|
||
|
|
CALL MDRSRV ('ISNSVOK', KNSVOK, NUMNPS * NVARNS)
|
||
|
|
CALL MDRSRV ('ISSSVOK', KSSVOK, NUMESS * NVARSS)
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) GOTO 240
|
||
|
|
|
||
|
|
CALL RDNAM1 (NDB, 'E', NELBLK, NVAREL, A(KIEVOK))
|
||
|
|
CALL RDNAM1 (NDB, 'M', NUMNPS, NVARNS, A(KNSVOK))
|
||
|
|
CALL RDNAM1 (NDB, 'S', NUMESS, NVARSS, A(KSSVOK))
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
210 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000) 'NUMBER OF GLOBAL VARIABLES'
|
||
|
|
GOTO 230
|
||
|
|
211 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000) 'NUMBER OF NODAL VARIABLES'
|
||
|
|
GOTO 230
|
||
|
|
212 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000) 'NUMBER OF ELEMENT VARIABLES'
|
||
|
|
GOTO 230
|
||
|
|
220 CONTINUE
|
||
|
|
WRITE (ERRMSG, 10000) 'GLOBAL VARIABLE NAMES'
|
||
|
|
GOTO 230
|
||
|
|
230 CONTINUE
|
||
|
|
CALL WDBERR (IERR, ERRMSG)
|
||
|
|
240 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (A)
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine rdnam2(ndb, varnam, nvar, vtype, ierr, namlen)
|
||
|
|
character*(namlen) varnam(*)
|
||
|
|
character*1 vtype
|
||
|
|
|
||
|
|
ierr = 0
|
||
|
|
C ... Initialize in case there is error
|
||
|
|
DO 100 I = 1, nvar
|
||
|
|
varnam(i) = '--------------------------------'
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
if (nvar .gt. 0) then
|
||
|
|
call exgvan (ndb, vtype, nvar, varnam, ierr)
|
||
|
|
end if
|
||
|
|
return
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine fixnam(namin, namout, nvar, namlen)
|
||
|
|
C ... Convert the variable names to uppercase and compress blanks
|
||
|
|
character*(namlen) namin(*), namout(*)
|
||
|
|
|
||
|
|
do 100 i = 1, nvar
|
||
|
|
namout(i) = namin(i)
|
||
|
|
call exupcs(namout(i))
|
||
|
|
100 continue
|
||
|
|
call pckstr(nvar, namout)
|
||
|
|
|
||
|
|
return
|
||
|
|
end
|