C Copyright(C) 1999-2020, 2022 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======================================================================= 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 ('CMDSPEC', * 'Syntax is: "explore [-[no]map node|element|all] filename"') CALL PRTERR ('CMDSPEC', * 'Documentation: https://sandialabs.github.io' // $ '/seacas-docs/sphinx/html/index.html#explore') 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 =', I12) 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 mdfree() 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