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.
453 lines
14 KiB
453 lines
14 KiB
2 years ago
|
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
|