Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

111 lines
4.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 WNAM (NDBOUT, NDIM, NELBLK, NELBO, VISELB,
& NVARGO, NVARNO, NVAREO, NAMECO, BLKTYP,
& NAMEGV, NAMENV, NAMEEV, IEVVAR, ISEVOK,
& IDELB, NEWID, IEVOK)
C=======================================================================
C --*** WNAM *** Write the names of the coordinates, element block
C -- types, and the database result variables. Also,
C -- write the element block variable truth table
C -- Modified from RWNAM
C --*** RWNAM *** (ALGEBRA) Read and write database names
C -- Written by Amy Gilkey - revised 12/14/87
C --
C --Parameters:
C -- NDBOUT - IN - the output database file
C -- NDIM - IN - the number of coordinates per node
C -- NELBLK - IN - the number of input element blocks
C -- NELBO - IN - the number of output element blocks
C -- VISELB - IN - true iff element block i is to be written
C -- NVARGO - IN - the number of output global variables
C -- NVARNO - IN - the number of output nodal variables
C -- NVAREO - IN - the number of output element variables
C -- NAMECO - IN - the names of the coordinates
C -- BLKTYP - IN - the names of the element block types
C -- NAMEGV - IN - the names of the output global variables
C -- NAMENV - IN - the names of the output nodal variables
C -- NAMEEV - IN - the names of the output element variables
C -- IEVVAR - IN - the ISEVOK index of the output element variables
C -- ISEVOK - IN - the element block variable truth table;
C -- variable i of block j exists iff ISEVOK(j,i)
C -- IDELB - IN - element block IDs
C -- IEVOK - IN -
C -- NEWID - IN -
C -- IOERR - OUT - input/output error flag
C --
C --Common Variables:
C -- Uses ICOBEG, ICOEND of /DBXVAR/
C -- Uses NDBIN of /DBASE/
C -- Uses NDIM, NUMNP, NUMEL, NSTEPS of /DBNUMS/
include 'exodusII.inc'
include 'ag_namlen.blk'
LOGICAL VISELB(NELBLK)
CHARACTER*(namlen) NAMECO(*)
CHARACTER*(MXSTLN) BLKTYP(*)
CHARACTER*(*) NAMEGV(*)
CHARACTER*(*) NAMENV(*)
CHARACTER*(*) NAMEEV(*)
INTEGER IEVVAR(*)
LOGICAL ISEVOK(NELBLK,NVAREO)
INTEGER IDELB(*)
INTEGER IEVOK(NVAREO,NELBO)
INTEGER NEWID(*)
C Write the names of the coordinates to the output file
call expcon(ndbout, nameco, ierr)
C --Write the variable names
IF (NVARGO + NVARNO + NVAREO .GT. 0) THEN
if (nvargo .gt. 0) then
call expvp(ndbout, 'g', nvargo, ierr)
call expvan(ndbout, 'g', nvargo, namegv, ierr)
end if
if (nvarno .gt. 0) then
call expvp(ndbout, 'n', nvarno, ierr)
call expvan(ndbout, 'n', nvarno, namenv, ierr2)
end if
if (nvareo .gt. 0) then
call expvp(ndbout, 'e', nvareo, ierr)
call expvan(ndbout, 'e', nvareo, nameev, ierr)
end if
END IF
IF ((NVAREO .GT. 0) .AND. (NELBLK .GT. 0)) THEN
NO = 0
C Loop from 1 to number of element blocks
DO 110 IELB = 1, NELBLK
IF (VISELB(IELB)) THEN
C Increment counter for writing element block data
NO = NO + 1
C New block id index = element block ID
NEWID(NO) = IDELB(IELB)
C Loop from 1 to the number of variables to output
DO 100 I = 1, NVAREO
IEV = IEVVAR(I)
IF (ISEVOK(IELB,IEV)) THEN
IEVOK(I,NO) = 1
ELSE
IEVOK(I,NO) = 0
END IF
100 CONTINUE
end if
110 CONTINUE
C Write the element variable truth table to the output file
CALL EXPVTT (NDBOUT, NELBO, NVAREO, IEVOK, IERR)
END IF
RETURN
END