C Copyright(C) 2009-2017 National Technology & Engineering Solutions of
C 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 Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C 
C     * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C 
C     * Redistributions in binary form must reproduce the above
C       copyright notice, this list of conditions and the following
C       disclaimer in the documentation and/or other materials provided
C       with the distribution.
C     * Neither the name of NTESS nor the names of its
C       contributors may be used to endorse or promote products derived
C       from this software without specific prior written permission.
C 
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

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
