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.
572 lines
21 KiB
572 lines
21 KiB
C Copyright(C) 1999-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 ALGEBRA2
|
|
C=======================================================================
|
|
|
|
C --This version of ALGEBRA will read and write EXODUSIIV2 database
|
|
C --format files. Many changes have occurred since the first version
|
|
C --of ALGEBRA. The original database files, genesis and exodusI
|
|
C --were sequential access files. EXODUSIIV2 uses a random access
|
|
C --file format. Previous versions of ALGEBRA would have to read the
|
|
C --input database more than once in order to get the file pointer
|
|
C --to the desired data. With random access files we are able to
|
|
C --select what we want to read or write at anytime.
|
|
|
|
C *** ALGEBRA 2.02 ***
|
|
C --*** ALGEBRA *** (ALGEBRA) Algebraic Database Manipulation Program
|
|
C --
|
|
C --The ALGEBRA program allows the user to process data from a finite
|
|
C --element analysis before it is plotted. The finite element output
|
|
C --data is in the form of variable values (stress, strain, and
|
|
C --velocity components, etc.) in an EXODUS database. The ALGEBRA program
|
|
C --evaluates user-supplied functions of the data and writes the results
|
|
C --to an output EXODUS database which can be read by plot programs.
|
|
C --
|
|
include 'exodusII.inc'
|
|
include 'ag_namlen.blk'
|
|
|
|
C max_num_equation, max_parsed_entries
|
|
include 'ag_numeqn.blk'
|
|
C QAINFO array with program information
|
|
include 'ag_progqa.blk'
|
|
C input equation info
|
|
include 'ag_ent.blk'
|
|
C input variable info
|
|
include 'ag_var.blk'
|
|
C aliases
|
|
include 'ag_alias.blk'
|
|
C I/O file names
|
|
include 'ag_dbase.blk'
|
|
C I/O database titles
|
|
include 'ag_dbtitl.blk'
|
|
C num_of: nodes,elements,coordinated/node,element_blks
|
|
C num_of: history,global,nodal,element variables, num_of_time_steps
|
|
include 'ag_dbnums.blk'
|
|
C node set/side sets number,length,dist factor
|
|
include 'ag_dbnumg.blk'
|
|
C database type, num_of qa and info records
|
|
include 'ag_dbnumq.blk'
|
|
C num_of: nodes,elements,element blks,node_sets,side_sets in zoom mesh
|
|
C num_of: output history,global,nodal,element variables
|
|
include 'ag_dbout.blk'
|
|
C time_index, I_index/O_index for history,global,nodal and element vars
|
|
include 'ag_dbxvar.blk'
|
|
C time variables
|
|
include 'ag_times.blk'
|
|
C zoom info
|
|
include 'ag_zoom.blk'
|
|
C function variables
|
|
include 'ag_fnctbc.blk'
|
|
C equation line error messages
|
|
include 'ag_eqnlns.blk'
|
|
C floating point byte size
|
|
include 'ag_dbws.blk'
|
|
include 'argparse.inc'
|
|
|
|
C Input/Output File Arguments
|
|
C CPUWS - The word size in bytes of the floating point variables
|
|
C used in the application program
|
|
C IOWS - The word size in bytes of the floating point data as they
|
|
C are stored in the EXODUS II file
|
|
C IERR - error code
|
|
C VERS - version number of database
|
|
C NERR - error flag for dynamic memory errors
|
|
C MERR - memory error flag
|
|
C IOERR - Input/output error flag
|
|
C INTEGER CPUWS, IOWS, IERR, NERR, CERR, MERR
|
|
INTEGER IERR, NERR, CERR, MERR
|
|
REAL VERS
|
|
LOGICAL MEMBUG
|
|
CHARACTER*2048 FILNAM, SCRATCH
|
|
|
|
CHARACTER*8 STR8
|
|
|
|
C A - the dynamic memory base array
|
|
DIMENSION A(1)
|
|
CHARACTER*1 C(1)
|
|
|
|
C Logical variables that indicate whether an input/output
|
|
C file is open. These variable are use during exit of the
|
|
C program in hopes to cut down on the multitude of goto labels
|
|
C while exiting the program
|
|
LOGICAL INOPEN, OTOPEN
|
|
|
|
C Executable code in qainfo.blk
|
|
include 'ag_qainfo.blk'
|
|
|
|
INOPEN = .FALSE.
|
|
OTOPEN = .FALSE.
|
|
MEMBUG = .FALSE.
|
|
MERR = 0
|
|
IOERR = 0
|
|
|
|
CALL STRTUP (QAINFO)
|
|
CALL BANNR2 (80, QAINFO(1), 0)
|
|
CALL BANNER (0, QAINFO,
|
|
& 'AN ALGEBRAIC MANIPULATION PROGRAM',
|
|
& 'FOR POST-PROCESSING OF FINITE ELEMENT ANALYSES',
|
|
& 'EXODUS II VERSION')
|
|
CALL CPYRGT (0, '2008')
|
|
WRITE(*,*)
|
|
|
|
C Set compute and file float size to default values
|
|
C values located in dbws.blk
|
|
CPUWS=0
|
|
IOWS=0
|
|
|
|
IF (MEMBUG) THEN
|
|
CALL MLIST()
|
|
END IF
|
|
|
|
C Input and Output File ID's
|
|
C See Algebra script for more details
|
|
C dbase.blk: COMMON /DBASE/ NDBIN, NDBOUT
|
|
NDBIN = 11
|
|
NDBOUT = 12
|
|
|
|
C Open the log file - temporary file unless the user decides to save it
|
|
NLOG = 99
|
|
CALL OPNLOG (NLOG)
|
|
|
|
C .. Get filename from command line. If not specified, emit error message
|
|
NARG = argument_count()
|
|
if (narg .lt. 2) then
|
|
CALL PRTERR ('FATAL', 'Filenames not specified.')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax is: "algebra file_in file_out"')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Documentation: https://sandialabs.github.io' //
|
|
$ '/seacas-docs/sphinx/html/index.html#algebra')
|
|
GOTO 150
|
|
else if (narg .gt. 2) then
|
|
CALL PRTERR ('FATAL', 'Too many arguments specified.')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax is: "algebra file_in file_out"')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Documentation: https://sandialabs.github.io' //
|
|
$ '/seacas-docs/sphinx/html/index.html#algebra')
|
|
GOTO 150
|
|
end if
|
|
|
|
C Open the input database; Exit on error
|
|
CALL get_argument(1,FILNAM, LFIL)
|
|
ndbin = exopen(filnam(:lfil), EXREAD, cpuws, iows,
|
|
& vers, ierr)
|
|
IF (IERR .NE. 0) THEN
|
|
SCRATCH = 'Database "'//FILNAM(:LFIL)//'" does not exist.'
|
|
CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
|
|
GOTO 150
|
|
END IF
|
|
|
|
call exinq(ndbin, EXDBMXUSNM, namlen, rdum, cdum, ierr)
|
|
call exmxnm(ndbin, namlen, ierr)
|
|
|
|
INOPEN = .TRUE.
|
|
|
|
C Initialize the Memory Manager
|
|
CALL MDINIT (A)
|
|
c CALL MDFILL(0)
|
|
CALL MCINIT (C)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
C Report dynamic memory error
|
|
CALL MEMERR
|
|
C Goto WRAPUP call and exit program
|
|
GOTO 150
|
|
END IF
|
|
|
|
C Read the initial parameters from the database
|
|
C ndbin - file ID (input)
|
|
C title - title of input file dbtitl.blk
|
|
C ndim - number of coordinates per node dbnums.blk
|
|
C numnp - number of nodes dbnums.blk
|
|
C numel - number of elements dbnums.blk
|
|
C nelblk - number of element blocks dbnums.blk
|
|
C numnps - number of node sets dbnumg.blk
|
|
C numess - number of side sets dbnumg.blk
|
|
C ioerr - error code
|
|
C dbase.blk, dbtitl.blk, dbnums.blk, dbnumg.blk
|
|
CALL EXGINI(NDBIN, TITLE, NDIM, NUMNP, NUMEL, NELBLK,
|
|
& NUMNPS, NUMESS, IERR)
|
|
|
|
C if number of node sets > 0, gather node set information dbnumg.blk
|
|
if (numnps .gt. 0) then
|
|
C EXNSNL - request the length of the node set node list.
|
|
CALL EXINQ (NDBIN, EXNSNL, LNPSNL, RDUM, CDUM, IERR)
|
|
C EXNSDF - request the length of the node sets distribution factors list
|
|
CALL EXINQ (NDBIN, EXNSDF, LNPSDF, RDUM, CDUM, IERR)
|
|
else
|
|
lnpsnl = 0
|
|
lnpsdf = 0
|
|
end if
|
|
|
|
C if number of side sets > 0, gather side set information dbnumg.blk
|
|
if (numess .gt. 0) then
|
|
C EXSSNL request length of the side set node list
|
|
CALL EXINQ (NDBIN, EXSSNL, LESSNL, RDUM, CDUM, IERR)
|
|
C EXSSEL request the length of the side sets element list.
|
|
CALL EXINQ (NDBIN, EXSSEL, LESSEL, RDUM, CDUM, IERR)
|
|
C EXSSDF request the length of the side set distribution factors list
|
|
CALL EXINQ (NDBIN, EXSSDF, LESSDF, RDUM, CDUM, IERR)
|
|
else
|
|
lessnl = 0
|
|
lessel = 0
|
|
lessdf = 0
|
|
end if
|
|
|
|
C Title of output db = title of input db dbtitl.blk
|
|
TITLEO = TITLE
|
|
|
|
C Print the database filename, title, and db initial variables
|
|
C Cannot print global, element, or nodal info. Data has not
|
|
C been read from the input database yet.
|
|
CALL DBPINI ('TIS', NDBIN, TITLE, NDIM, NUMNP, NUMEL, NELBLK,
|
|
& NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL,
|
|
& LESSDF, IDUM, IDUM, IDUM, ' ')
|
|
|
|
cccc DBLIST uses MDFIND to locate NUMELB, NUMLNK, NUMATR
|
|
cccc Scan the connectivity to get the element block IDs
|
|
cccc Read element block connectivity
|
|
|
|
C call MxRSRV(array_name, ret_array_index, array_size)
|
|
C IDELB: Element block ID's for each block
|
|
CALL MDRSRV ('IDELB', KIDELB, NELBLK)
|
|
C NUMELB: Number of elements in each block
|
|
CALL MDRSRV ('NUMELB', KNELB, NELBLK)
|
|
C NUMLNK: Number of nodes per element in each block
|
|
CALL MDRSRV ('NUMLNK', KNLNK, NELBLK)
|
|
C NUMATR: Number of attributes in each block
|
|
CALL MDRSRV ('NUMATR', KNATR, NELBLK)
|
|
C VISELB(i) = True iff element block i is to be written
|
|
CALL MDRSRV ('VISELB', KVISEB, NELBLK)
|
|
C BLKTYP: Element type
|
|
CALL MCRSRV ('BLKTYP', KNMLB, NELBLK * MXSTLN)
|
|
C Reserving space for the element block connectivity arrays
|
|
CALL MDRSRV ('LINK', KLINK, 0)
|
|
C Reserving space for the element block attributes
|
|
CALL MDRSRV ('ATRIB', KATRIB, 0)
|
|
C Check for dynamic memory errors
|
|
CALL MDSTAT (NERR, MEM)
|
|
CALL MCSTAT (CERR, MEM)
|
|
IF ((NERR .GT. 0) .OR. (CERR .GT. 0)) THEN
|
|
CALL MEMERR
|
|
GOTO 130
|
|
END IF
|
|
|
|
C DBIELB reads and returns the following:
|
|
C 1. Element block ID's
|
|
C 2. Element type in each element block
|
|
C 3. Number of elements in each element block
|
|
C 4. Number of nodes per element in each element block
|
|
C 5. Number of attributes per element in each element block
|
|
C 6. If Option = A or * -> element block attributes
|
|
C 7. If Option = C or * -> element block connectivity
|
|
C 8. If Option = H or * -> read all header information
|
|
C 9. If Option = I or * -> read the element block ID's
|
|
C Note: Element block ID's must be read for all options
|
|
C DBIELB reads the element block information from the database.
|
|
C An error message is displayed if the end of file is read.
|
|
CALL DBIELB (NDBIN, '*', 1, NELBLK, A(KIDELB), A(KNELB),
|
|
& A(KNLNK), A(KNATR), C(KNMLB), A, IELNK, IEATR, MERR)
|
|
C Exit program on memory error
|
|
IF (MERR .EQ. 1) GO TO 130
|
|
|
|
C QA and Information record number stored in dbnumq.blk
|
|
C Request the number of QA records. Return the value
|
|
C as an integer in nqarec
|
|
CALL EXINQ (NDBIN, EXQA, NQAREC, RDUM, CDUM, IERR)
|
|
C Request the number of information records. Return the
|
|
C value as an integer in ninfo
|
|
CALL EXINQ (NDBIN, EXINFO, NINFO, RDUM, CDUM, IERR)
|
|
|
|
C Reserve contiguous block space for arrays QA and information records
|
|
C Reserve nqarec for input file + 1 for the current run
|
|
CALL MCGET(((nqarec+1)*4*MXSTLN) + (ninfo*MXLNLN))
|
|
C Reserve space to read the QA and information records
|
|
call MCRSRV('QAREC', kqarec, (nqarec+1) * 4 * MXSTLN)
|
|
call MCRSRV('INFREC', kinfo, ninfo * MXLNLN)
|
|
CALL MCSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
GOTO 130
|
|
END IF
|
|
|
|
C Read the QA and Information Records
|
|
CALL DBIQA(NDBIN, '*', NQAREC, C(KQAREC), NINFO, C(KINFO))
|
|
|
|
C Read the number of global, node, and element variables
|
|
C Read number of global variables = nvargl
|
|
call exgvp(ndbin, 'G', nvargl, ierr)
|
|
|
|
C Read number of nodal variables = nvarnp
|
|
call exgvp(ndbin, 'N', nvarnp, ierr)
|
|
|
|
C Read number of element variables = nvarel
|
|
call exgvp(ndbin, 'E', nvarel, ierr)
|
|
|
|
C Reserve memory for coordinate array names
|
|
CALL MCRSRV ('NAMECO', KNACOR, namlen*NDIM)
|
|
C Reserve memory for global, node, and element variable
|
|
CALL MCRSRV ('NAMES', KNAMES, namlen*(NVARGL+NVARNP+NVAREL))
|
|
C Reserve memory for element variable truth table
|
|
CALL MDRSRV ('ISEVOK', KIEVOK, NELBLK * NVAREL)
|
|
C Temporary storage
|
|
CALL MDRSRV ('ITMP', KITMP, NELBLK * NVAREL)
|
|
CALL MCSTAT (CERR, MEM)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF ((NERR .GT. 0) .OR. (CERR .GT. 0)) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
GOTO 130
|
|
END IF
|
|
|
|
C Read the coordinate names
|
|
CALL DBICON (NDBIN, NDIM, C(KNACOR))
|
|
IF (IOERR .EQ. 1) GO TO 130
|
|
|
|
C Read the names of the global, node, and element variables
|
|
CALL DBINAM (NDBIN, C, C(KNAMES), NVARGL, NVARNP, NVAREL,
|
|
& KNAMGV, KNAMNV, KNAMEV, MAXVAR)
|
|
|
|
C Print database variable names
|
|
C call dbpnam (option, num_glb_var, num_nod_var, num_elem_var,
|
|
C glb_var_names, nod_var_names, elem_var_names)
|
|
CALL DBPNAM ('*', NVARGL, NVARNP, NVAREL,
|
|
& C(KNAMES+NAMLEN*(KNAMGV-1)),
|
|
& C(KNAMES+NAMLEN*(KNAMNV-1)),
|
|
& C(KNAMES+NAMLEN*(KNAMEV-1)))
|
|
|
|
C Read the element variable truth table
|
|
CALL DBIVTT (NDBIN, A(KIEVOK), A(KITMP), NELBLK, NVAREL)
|
|
|
|
C Delete temporary dynamic memory
|
|
CALL MDDEL('ITMP')
|
|
CALL MDSTAT (NERR, MEM)
|
|
if (NERR .GT. 0) then
|
|
CALL MEMERR
|
|
merr = 1
|
|
GO TO 130
|
|
end if
|
|
|
|
C Request the number of time steps from the database
|
|
CALL EXINQ (NDBIN, EXTIMS, NSTEPS, RDUM, CDUM, IERR)
|
|
C Reserve memory to hold the time step values
|
|
C Reserve memory for step times
|
|
CALL MDRSRV ('TIMES', KTIMES, max(1,NSTEPS))
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
GO TO 130
|
|
END IF
|
|
if (nsteps .gt. 0) then
|
|
CALL EXGATM(NDBIN, A(KTIMES), IERR)
|
|
else
|
|
C Add a dummy step at time 0 in case user is trying to add a new step
|
|
A(KTIMES) = 0.0
|
|
END IF
|
|
|
|
C Displays the number of time steps and the minimum and
|
|
C maximum time on the database
|
|
C 'NM' Print the number of time steps and the minimum and
|
|
C maximum time step times
|
|
C NSTEPS The number of time steps
|
|
C A(KTIMES) The database time steps
|
|
CALL DBPTIM ('NM', NSTEPS, A(KTIMES))
|
|
|
|
C Selected time steps
|
|
CALL MDRSRV ('IPTIMS', KPTIMS, MAX(1,NSTEPS))
|
|
C selected element blocks
|
|
CALL MDRSRV ('SELELB', KSELEB, NELBLK)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
MERR = 1
|
|
GOTO 130
|
|
END IF
|
|
|
|
C ... See if the input database has any nodeset or sideset variables.
|
|
C If there are any, then output a warning message telling the user
|
|
C that these are not supported in algebra and will be stripped from
|
|
C output file.
|
|
call exgvp(ndbin, 'M', nvarns, ierr)
|
|
call exgvp(ndbin, 'S', nvarss, ierr)
|
|
if (nvarns .gt. 0) then
|
|
CALL PRTERR('WARNING',
|
|
$ 'The Input Database contains NODESET VARIABLES')
|
|
CALL PRTERR('CMDSPEC',
|
|
$ ' NODESET VARIABLES are not supported by algebra')
|
|
CALL PRTERR('CMDSPEC',
|
|
$ ' These will NOT be saved to the output database')
|
|
end if
|
|
if (nvarss .gt. 0) then
|
|
CALL PRTERR('WARNING',
|
|
$ 'The Input Database contains SIDESET VARIABLES')
|
|
CALL PRTERR('CMDSPEC',
|
|
$ ' SIDESET VARIABLES are not supported by algebra')
|
|
CALL PRTERR('CMDSPEC',
|
|
$ ' These will NOT be saved to the output database')
|
|
end if
|
|
|
|
C Read in the equations
|
|
C call rdeqns(DMarray, DCarray, coord_names, elem_names, db_var_names,
|
|
C qa_rec, info_rec, db_time_step, select_time_step,
|
|
C elem_blk_ids, TRUE_IFF_elem(i)_written, DMindex_ISEVOK,
|
|
C max_stack_size, return_if_quit)
|
|
|
|
CALL RDEQNS (A, C, C(KNACOR), C(KNMLB), C(KNAMES), C(KQAREC),
|
|
& C(KINFO), A(KTIMES), A(KPTIMS), A(KSELEB),
|
|
& A(KIDELB), A(KVISEB), KIEVOK, MAXSTK, NLOG, MERR)
|
|
IF (MERR .EQ. 1) GO TO 130
|
|
|
|
C RDEQNS processes the input equations as follows:
|
|
C o Reads the line and parses it into fields.
|
|
C o Checks the equation for syntax.
|
|
C o Stores the variable names from the equations.
|
|
C o Puts the equation in postfix form.
|
|
C o Adds the equation variables to a global list.
|
|
C If any errors are found, that equation is ignored.
|
|
C After all the equations have been read in, all the variables are
|
|
C gathered into the /VAR../ arrays. The assigned variables are
|
|
C after the expression variables.
|
|
|
|
C Sort the input variables (by ID)
|
|
C SORTID gathers the variables of the specified type into
|
|
C one area of an array and orders these variable
|
|
ITIME = 1
|
|
CALL SORTID ('T', NUMINP, ITIME, I)
|
|
ICOBEG = ITIME + 1
|
|
CALL SORTID ('C', NUMINP, ICOBEG, ICOEND)
|
|
IGVBEG = ICOEND + 1
|
|
CALL SORTID ('G', NUMINP, IGVBEG, IGVEND)
|
|
INVBEG = IGVEND + 1
|
|
CALL SORTID ('N', NUMINP, INVBEG, INVEND)
|
|
IEVBEG = INVEND + 1
|
|
CALL SORTID ('E', NUMINP, IEVBEG, IEVEND)
|
|
|
|
C Set the ID to the order in which the LHS variables were defined
|
|
NLHS = 1
|
|
DO 100 I = MAXVAR, IXLHS, -1
|
|
IDVAR(I) = NLHS
|
|
NLHS = NLHS + 1
|
|
100 CONTINUE
|
|
|
|
C Sort deleted variables to end of entries
|
|
C SORDEL sorts the deleted variables so that they appear at the start
|
|
C of all non-deleted entries.
|
|
CALL SORDEL (MAXVAR, IXLHS, I)
|
|
JTIME = I + 1
|
|
|
|
C Sort the LHS variables in the order defined
|
|
CALL SORTID ('T', MAXVAR, JTIME, I)
|
|
JGVBEG = I + 1
|
|
CALL SORTID ('G', MAXVAR, JGVBEG, JGVEND)
|
|
JNVBEG = JGVEND + 1
|
|
CALL SORTID ('N', MAXVAR, JNVBEG, JNVEND)
|
|
JEVBEG = JNVEND + 1
|
|
CALL SORTID ('E', MAXVAR, JEVBEG, JEVEND)
|
|
NVARGO = JGVEND - JGVBEG + 1
|
|
NVARNO = JNVEND - JNVBEG + 1
|
|
NVAREO = JEVEND - JEVBEG + 1
|
|
|
|
C Link the variables with storage
|
|
C Assign storage for variables
|
|
C LNKSTO sets up the storage locations for all the variables.
|
|
C Input and output variables of the same name share storage (unless
|
|
C one is a history/global and the other is not). Time and history/global
|
|
C variables are all in the first storage location: time is in slot 1,
|
|
C followed by the input history variables (if any), the input global
|
|
C variables (if any), then the output only history/global variables.
|
|
CALL LNKSTO (C(KNAMES+NAMLEN*(KNAMGV-1)), NUMSTO, LTMENT, IOERR)
|
|
IF (IOERR .EQ. 1) GO TO 130
|
|
|
|
C LNKFNC sets up the storage locations for the time functions that
|
|
C need storage for results that must be saved over time steps.
|
|
CALL LNKFNC (NUMSTO, *130)
|
|
|
|
C Relink the equation variables with the sorted name array
|
|
CALL LNKVAR (*130)
|
|
|
|
C Check displacement variables
|
|
IF ((NVARNP .GT. 0) .OR. (NVARNO .GT. 0)) THEN
|
|
C CHKDIS finds the displacement variables. The first two/three nodal
|
|
C variables are displacement variables if and only if they begin with
|
|
C 'D' and end with the last character of the corresponding coordinate
|
|
C name.
|
|
CALL CHKDIS (NDIM, C(KNACOR), NVARNO, NAMVAR(JNVBEG),
|
|
* namlen, maxnam)
|
|
END IF
|
|
|
|
C *************************************************************
|
|
C Open the Output Database
|
|
C *************************************************************
|
|
CALL get_argument(2,FILNAM, LFIL)
|
|
ndbout = excre(filnam(:lfil), EXCLOB, CPUWS, IOWS, IERR)
|
|
IF (IERR .NE. 0) THEN
|
|
SCRATCH = 'Problems creating database "'//FILNAM(:LFIL)//'".'
|
|
CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
|
|
goto 130
|
|
END IF
|
|
OTOPEN = .TRUE.
|
|
call exmxnm(ndbout, namlen, ierr)
|
|
|
|
C RWEVAL reads the unread information from the input database,
|
|
C processes the data for zoom mesh, and write the output database.
|
|
|
|
CALL RWEVAL (NDBIN, NDBOUT, A, A, C, NPTIMS,
|
|
& NUMSTO, LTMENT, MAXSTK, NWRIT, IOERR, MERR)
|
|
IF ((IOERR .EQ. 1) .OR. (MERR .EQ. 1)) GO TO 130
|
|
|
|
if (numsto .gt. 1 .and. nsteps .eq. 0) then
|
|
nsteps = 1
|
|
nwrit = 1
|
|
end if
|
|
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
END IF
|
|
|
|
C Converts a set of integer numbers into a consistent
|
|
C set of strings of the same length (right justified)
|
|
CALL INTSTR (1, 0, NWRIT, STR8, LSTR)
|
|
WRITE (*, 10000) STR8(:LSTR)
|
|
10000 FORMAT (/, 4X, A,
|
|
& ' time steps have been written to the database')
|
|
|
|
130 CONTINUE
|
|
|
|
call mddel ('IDELB')
|
|
CALL MDDEL ('NUMELB')
|
|
CALL MDDEL ('VISELB')
|
|
CALL MCDEL ('BLKTYP')
|
|
CALL MDDEL ('SELELB')
|
|
CALL MDDEL ('TIMES')
|
|
CALL MDDEL ('IPTIMS')
|
|
CALL MCDEL ('NAMECO')
|
|
CALL MCDEL ('NAMES')
|
|
CALL MDDEL ('ISEVOK')
|
|
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) THEN
|
|
CALL MEMERR
|
|
END IF
|
|
|
|
150 continue
|
|
C Exiting programs - close input/output files if they are open
|
|
C or even if they opened and may have an error
|
|
IF (INOPEN) CALL exclos(NDBIN, IERR)
|
|
|
|
IF (OTOPEN) CALL exclos(NDBOUT, IERR)
|
|
|
|
C Performs finishing details common to all programs.
|
|
C Specifically, it gets and displays the CPU time used.
|
|
|
|
call addlog (QAINFO(1)(:lenstr(QAINFO(1))))
|
|
CALL WRAPUP (QAINFO(1))
|
|
|
|
END
|
|
|