C    Copyright(C) 2008-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
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
C=======================================================================
      PROGRAM EXPLORE
C=======================================================================

C                         *** EXPLORE 2.00 ***

C   --*** EXPLORE *** (EXPLORE) GENESIS/EXODUS database examination program
C   --
C   --EXPLORE is a post-processing program to examine the output of a
C   --finite element analysis, which is in the GENESIS or EXODUS database
C   --format.  EXPLORE allows the user to examine any values in the database.
C   --The display can be directed to the CRT or to a print file.
C   --
C   --Expected input:
C   --   o The commands on the standard input device.
C   --   o The GENESIS/EXODUS database on unit 11.
C   --
C   --Output:
C   --   o A listing of the input database information and any errors
C   --     found on the standard output device.
C   --   o A print file of requested information on unit 20.

C   --Developed at Sandia National Laboratories.
C   --
C   --Source is in FORTRAN 77
C   --
C   --External software used:
C   --   SUPES package (dynamic memory, free-field reader, FORTRAN extensions)
C   --
C   --Documentation:
C   --   "User's Manual for EXPLORE"

      include 'exodusII.inc'
      include 'exp_progqa.blk'
      include 'exp_outfil.blk'
      include 'exp_dbase.blk'
      include 'exp_dbtitl.blk'
      include 'exp_dbnums.blk'
      include 'argparse.inc'

C      --A - the dynamic numeric memory base array
      DIMENSION A(1)
      INTEGER IA(1)
      EQUIVALENCE (A(1), IA(1))
      CHARACTER*1 C(1)

      CHARACTER*2048 DBNAME
      CHARACTER*2048 SCRATCH
C      --DBNAME - the database name, needed because the database may be closed
      character*256  option, value

      LOGICAL EXODUS
C      --EXODUS - true iff EXODUS file versus GENESIS file
      LOGICAL MAPND, MAPEL

      LOGICAL ISEOF
      LOGICAL CHECK
      CHARACTER*1 cdum

      include 'exp_qainfo.blk'
      CALL STRTUP (QAINFO)

C   --Set up the print file

      NCRT = -1
      NOUT = NCRT
      NPRT = 20
      ANYPRT = .FALSE.

C   --Print banner to CRT and print file

      CALL BANNER (0, QAINFO,
     &   'A GENESIS/EXODUS DATABASE EXPLORATION PROGRAM',
     &   ' ', ' ')

      call cpyrgt (0, "2008")

C   --Open the database

      NDB = 11

      CMPSIZ = 0
      IOWS   = 0
      DBNAME  = ' '

C .. Get filename from command line.  If not specified, emit error message
      NARG = argument_count()
      if (narg .eq. 0) then
        CALL PRTERR ('FATAL', 'Filename not specified.')
        CALL PRTERR ('FATAL',
     *    'Syntax is: "explore [-[no]map node|element|all] filename"')
        GOTO 120
      end if

      CALL get_argument(narg,DBNAME, LNAM)
      NDB = exopen(dbname(:lnam), EXREAD, CMPSIZ, IOWS, vers, IERR)
      IF (IERR .NE. 0) THEN
        SCRATCH = 'Database "'//DBNAME(:LNAM)//'" does not exist.'
         CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
         GOTO 120
      END IF

      CALL EXOPTS(EXVRBS,IERR)

C ... By default, ultimately map both nodes and elements
C     HOWEVER, in the transition time do not map either unless requested...
      mapel = .false.
      mapnd = .false.
      check = .false.

      if (narg .gt. 1) then
        do i=1, narg-1, 2
          CALL get_argument(i+0,option, lo)
          CALL get_argument(i+1,value,  lv)
          if (option(:lo) .eq. '-nomap' .or.
     *      option(:lo) .eq. '--nomap') then
            if (value(1:1) .eq. 'n' .or. value(1:1) .eq. 'N')
     *        mapnd = .false.
            if (value(1:1) .eq. 'e' .or. value(1:1) .eq. 'E')
     *        mapel = .false.
            if (value(1:1) .eq. 'a' .or. value(1:1) .eq. 'A') then
              mapnd = .false.
              mapel = .false.
            end if
          else if (option(:lo) .eq. '-map' .or.
     *      option(:lo) .eq. '--map') then
            if (value(1:1) .eq. 'n' .or. value(1:1) .eq. 'N')
     *        mapnd = .true.
            if (value(1:1) .eq. 'e' .or. value(1:1) .eq. 'E')
     *        mapel = .true.
            if (value(1:1) .eq. 'a' .or. value(1:1) .eq. 'A') then
              mapnd = .true.
              mapel = .true.
            end if
          else if (option(:lo) .eq. '-check' .or.
     *      option(:lo) .eq. '--check') then
            check = .TRUE.
          end if
        end do
      end if

        write (*,9999)
 9999   FORMAT(/,
     *    1x,'NOTE: This version has the option to use global',
     *    ' ids for both node and element ids.',/,
     *    1x,'      To see the mapping from local to global, use',
     *    ' the commands:',/,
     *    1x,'          "LIST MAP" (element map), or ',
     *    '"LIST NODEMAP" (node map)',/,
     *    1x,'      To disable the maps and use local ids, restart',
     *    ' explore with "-nomap node|element|all"',//,
     *    1x,'      To enable the maps and use global ids, restart',
     *    ' explore with "-map node|element|all"',//,
     *    1x,'      Notify gdsjaar@sandia.gov if bugs found')

        if (mapel .and. mapnd) then
          WRITE (*, 10010) 'Nodes and Elements using Global Ids'
        else if (mapel) then
          WRITE (*, 10010) 'Elements use Global Ids, Node Ids are Local'
        else if (mapnd) then
          WRITE (*, 10010) 'Element use Local Ids, Node Ids are Global'
        else
          WRITE (*, 10010) 'Nodes and Elements using Local Ids'
        end if
10010   FORMAT (/, 1X, 5A)

C   --Initialize dynamic memory
      CALL MDINIT (A)
      CALL MCINIT (C)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100

C   --Read the initial variables
      call exgini(ndb, title, ndim, numnp, numel, nelblk,
     *     numnps, numess, ierr)
      IF (IERR .NE. 0) GOTO 110
      if (numnps .gt. 0) then
         call exinq(ndb, EXNSNL, lnpsnl, rdum, cdum, ierr)
         IF (IERR .NE. 0) GOTO 110
         call exinq(ndb, EXNSDF, lnpsdf, rdum, cdum, ierr)
         IF (IERR .NE. 0) GOTO 110
      else
         lnpsnl = 0
         lnpsdf = 0
      end if
      if (numess .gt. 0) then
         call exinq(ndb, EXSSNL, lessnl, rdum, cdum, ierr)
         IF (IERR .NE. 0) GOTO 110
         call exinq(ndb, EXSSEL, lessel, rdum, cdum, ierr)
         IF (IERR .NE. 0) GOTO 110
         call exinq(ndb, EXSSDF, lessdf, rdum, cdum, ierr)
         IF (IERR .NE. 0) GOTO 110
      else
         lessnl = 0
         lessel = 0
         lessdf = 0
      end if

      call exinq(ndb, EXDBMXUSNM, namlen, rdum, cdum, ierr)
      IF (IERR .NE. 0) GOTO 110
      call exmxnm(ndb, namlen, ierr)
      IF (IERR .NE. 0) GOTO 110

      CALL PRINIT ('NTISC', NOUT, DBNAME, TITLE,
     &     NDIM, NUMNP, NUMEL, NELBLK,
     &     NUMNPS, LNPSNL, lnpsdf, NUMESS, LESSEL, LESSNL, LESSDF,
     &     NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)

C ... See if there are any timesteps on the database (is EXODUS)
      call exinq (ndb, EXTIMS, NSTEPS, rdum, cdum, ierr)
      IF (IERR .NE. 0) GOTO 110
      EXODUS = (NSTEPS .gt. 0)

      if (EXODUS) THEN
        CALL EXGVP (NDB,"G",NVARGL,IERR)
        IF (IERR .NE. 0) GOTO 110
        CALL EXGVP (NDB,"E",NVAREL,IERR)
        IF (IERR .NE. 0) GOTO 110
        CALL EXGVP (NDB,"N",NVARNP,IERR)
        IF (IERR .NE. 0) GOTO 110
        CALL EXGVP (NDB,"M",NVARNS,IERR)
        IF (IERR .NE. 0) GOTO 110
        CALL EXGVP (NDB,"S",NVARSS,IERR)
        IF (IERR .NE. 0) GOTO 110

        CALL PRINIT ('V', NOUT, DBNAME, TITLE,
     &       NDIM, NUMNP, NUMEL, NELBLK,
     &       NUMNPS, LNPSNL, lnpsdf, NUMESS, LESSEL, LESSNL, LESSDF,
     &       NVARGL, NVARNP, NVAREL, NVARNS, NVARSS)
      END IF
      CALL SETPRC(4,0)

C ... Read coordinate data
      CALL MDRSRV ('CORD', KCORD, NUMNP * NDIM)
      CALL MCRSRV ('NAMECO', KNMCO, NAMLEN*NDIM)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100
      CALL RDCORD (NDB, NDIM, NUMNP, A(KCORD), C(KNMCO), ISEOF, NAMLEN)

C ... Read element map
      CALL MDRSRV ('MAPEL', KMAPEL, NUMEL)
      if (mapel) then
        kdbmapel = kmapel
      else
        call mdrsrv ('DBMAPEL', kdbmapel, numel)
      endif
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100
      if (mapel) then
        CALL RDMAP (NDB, NUMEL, IA(KMAPEL), ISEOF)
      else
        CALL RDMAP (NDB, NUMEL, IA(KdbMAPEL), ISEOF)
        call iniseq(numel, ia(kmapel))
      end if

C ... Read node map
      CALL MDRSRV ('MAPNO', KMAPNO, NUMNP)
      if (mapnd) then
        kdbmapno = kmapno
      else
        call mdrsrv ('DBMAPNO', kdbmapno, numnp)
      endif
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100
      if (mapnd) then
        CALL RDNMAP (NDB, NUMNP, IA(KMAPNO), ISEOF)
      else
        CALL RDNMAP (NDB, NUMNP, IA(KDBMAPNO), ISEOF)
        call iniseq(numnp, ia(kmapno))
      end if

C ... Read element blocks
      CALL MDRSRV ('IDELB', KIDELB, NELBLK)
      CALL MDRSRV ('NUMELB', KNELB, NELBLK)
      CALL MDRSRV ('NUMLNK', KNLNK, NELBLK)
      CALL MDRSRV ('NUMATR', KNATR, NELBLK)
      CALL MDRSRV ('LENE', KLENE, 1+NELBLK)
      CALL MCRSRV ('EBTYPE', KNMLB, MXSTLN*NELBLK)
      CALL MCRSRV ('EBNAME', KNMEB, NAMLEN*NELBLK)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100
      CALL RDELB (NDB, NELBLK,
     &   A(KIDELB), A(KNELB), A(KNLNK), A(KNATR),
     &   A, C, KLINK, KATRIB, KATRNM, ISEOF, C(KNMLB), C(KNMEB),
     &   NAMLEN)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100

C ... If NELBLK .gt. 0 and NUMEL .eq. 0, then
C     possible reading an experimental exodus file
C     containing only results data...
C     Calculate NUMEL based on NUMELB entries.
      if (NELBLK .gt. 0 .and. NUMEL .eq. 0) then
        do i=1, NELBLK
          numel = numel + IA(KNELB+I-1)
        end do
      end if

C ... Read nodesets
      CALL MDRSRV ('IDNPS',  KIDNS,  NUMNPS)
      CALL MDRSRV ('NNNPS',  KNNNS,  NUMNPS)
      CALL MDRSRV ('NDNPS',  KNDNPS, NUMNPS)
      CALL MDRSRV ('IXNNPS', KIXNNS, NUMNPS)
      CALL MDRSRV ('IXDNPS', KIXDNS, NUMNPS)
      CALL MDRSRV ('LTNNPS', KLTNNS, LNPSNL)
      CALL MDRSRV ('FACNPS', KFACNS, LNPSNL)
      CALL MCRSRV ('NSNAME', KNMNS,  NAMLEN*NUMNPS)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100
      CALL RDNPS (NDB, NUMNPS, LNPSNL,
     &     A(KIDNS), A(KNNNS), A(KNDNPS), A(KIXNNS), A(KIXDNS),
     &     A(KLTNNS), A(KFACNS), C(KNMNS), ISEOF, NAMLEN)

C ... Read sidesets
      CALL MDRSRV ('IDESS',  KIDSS,  NUMESS)
      CALL MDRSRV ('NEESS',  KNESS,  NUMESS)
      CALL MDRSRV ('NDESS',  KNDSS,  NUMESS)
      CALL MDRSRV ('IXEESS', KIXESS, NUMESS)
      CALL MDRSRV ('IXDESS', KIXNSS, NUMESS)
      CALL MDRSRV ('LTEESS', KLTESS, LESSEL)
      CALL MDRSRV ('LTSESS', KLTSSS, LESSEL)
      CALL MDRSRV ('FACESS', KFACSS, LESSDF)
      CALL MCRSRV ('SSNAME', KNMSS,  NAMLEN*NUMESS)
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100

      CALL RDESS (NDB, NUMESS, LESSEL, LESSDF,
     &   A(KIDSS), A(KNESS), A(KNDSS), A(KIXESS), A(KIXNSS),
     &   A(KLTESS), A(KLTSSS), A(KFACSS), C(KNMSS), ISEOF,
     &   NAMLEN)

C ... Read QA Information
      CALL RDQA (NDB, NQAREC, NINFO, KQAREC, KINFO, C)

      if (exodus) then
C ...    Read variable names and truth table
         CALL RDNAME (A, C, NDB, KVNAMI, KVNAMO,
     &        IXGV, IXNV, IXEV, IXNS, IXSS,
     &        KIEVOK, KNSVOK, KSSVOK)

C ... Read in the times for all the time steps from the database
         call mdrsrv('TIMES', KTIMES, NSTEPS)
         CALL RDTIMS (NDB, A(KTIMES))

         WRITE (*, *)
         IF (NSTEPS .GT. 0) THEN
            WRITE (*, 10000, IOSTAT=IDUM) NSTEPS
10000       FORMAT (1X, 'Number of time steps on the database =', I10)
         END IF

C ... Get the memory for the variables
         CALL MDRSRV ('VARGL', KVARGL, NVARGL)
         CALL MDRSRV ('VARNP', KVARNP, NVARNP * NUMNP)
         CALL MDRSRV ('VAREL', KVAREL, NVAREL * NUMEL)
         CALL MDRSRV ('VARNS', KVARNS, NVARNS * LNPSNL)
         CALL MDRSRV ('VARSS', KVARSS, NVARSS * LESSEL)

      ELSE
         NSTEPS = 0
         KVARGL = 1
         KVARNP = 1
         KVAREL = 1
         KVARNS = 1
         KVARSS = 1
      END IF

C   --Get the memory for the logical arrays

      CALL MDRSRV ('LISNP', KLISNP, 1+NUMNP)
      CALL MDRSRV ('NLISEL', KNLISE, 1+NELBLK)
      CALL MDRSRV ('LISEL', KLISEL, 1+NUMEL)
      CALL MDRSRV ('LISBEL', KLISBE, 1+NUMEL)
      CALL MDRSRV ('LISNPS', KLISNS, 1+NUMNPS)
      CALL MDRSRV ('LISESS', KLISSS, 1+NUMESS)
      IF (EXODUS) THEN
         CALL MDRSRV ('LISGV', KLISGV, 1+NVARGL)
         CALL MDRSRV ('LISNV', KLISNV, 1+NVARNP)
         CALL MDRSRV ('LISEV', KLISEV, 1+NVAREL)
         CALL MDRSRV ('LISMV', KLISMV, 1+NVARNS)
         CALL MDRSRV ('LISSV', KLISSV, 1+NVARSS)
      ELSE
         KLISGV = 1
         KLISNV = 1
         KLISEV = 1
         KLISMV = 1
         KLISSV = 1
      END IF

      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100

C   --Process commands

      CALL COMAND (A, IA, EXODUS, DBNAME, C(KQAREC), C(KINFO),
     &     C(KNMCO), C(KNMLB), C(KNMEB),C(KATRNM),
     &     C(KVNAMI+NAMLEN*(IXGV-1)), C(KVNAMI+NAMLEN*(IXNV-1)),
     &     C(KVNAMI+NAMLEN*(IXEV-1)), C(KVNAMI+NAMLEN*(IXNS-1)),
     $     C(KVNAMI+NAMLEN*(IXSS-1)),
     &     C(KVNAMO+NAMLEN*(IXGV-1)), C(KVNAMO+NAMLEN*(IXNV-1)),
     &     C(KVNAMO+NAMLEN*(IXEV-1)), C(KVNAMO+NAMLEN*(IXNS-1)),
     $     C(KVNAMO+NAMLEN*(IXSS-1)), A(KCORD),
     *     IA(KMAPEL), IA(KDBMAPEL), IA(KMAPNO), IA(KDBMAPNO),
     *     mapnd, mapel, check,
     &     A(KIDELB), A(KNELB), A(KLENE), A(KNLNK), A(KNATR),
     &     A(KLINK), A(KATRIB),
     &     A(KIDNS), A(KNNNS), A(KNDNPS), A(KIXNNS), A(KIXDNS),
     $     A(KLTNNS), A(KFACNS), C(KNMNS),
     &     A(KIDSS), A(KNESS), A(KNDSS), A(KIXESS), A(KIXNSS),
     &     A(KLTESS), A(KLTSSS), A(KFACSS), C(KNMSS),
     &     A(KIEVOK), A(KNSVOK), A(KSSVOK), A(KTIMES),
     &     A(KVARGL), A(KVARNP), A(KVAREL), A(KVARNS), A(KVARSS),
     &     A(KLISNP), A(KNLISE), A(KLISEL), A(KLISNS), A(KLISSS),
     &     A(KLISGV), A(KLISNV), A(KLISEV), A(KLISMV), A(KLISSV))
      CALL MDSTAT (NERR, MEM)
      IF (NERR .GT. 0) GOTO 100

      GOTO 110

 100  CONTINUE
      CALL MEMERR
      GOTO 110

 110  CONTINUE

      call exclos(ndb, ierr)

 120  CONTINUE
      IF (ANYPRT) CLOSE (NPRT, IOSTAT=IDUM)

      call addlog (QAINFO(1)(:lenstr(QAINFO(1))))
      CALL WRAPUP (QAINFO(1))

      END

      subroutine iniseq(icnt, map)
      integer map(*)
      do i=1, icnt
        map(i) = i
      end do
      return
      end
