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.
609 lines
22 KiB
609 lines
22 KiB
2 years ago
|
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 EXOTXT
|
||
|
C=======================================================================
|
||
|
|
||
|
C --*** EXOTXT *** (EXOTXT) EXODUS to TEXT translator
|
||
|
C -- Modified for ExodusIIv2 database format
|
||
|
C --
|
||
|
C --EXOTXT reads either from an EXODUS database or from the user
|
||
|
C --and writes a text file of the database contents.
|
||
|
C --
|
||
|
C --Expects the input database on unit 9, the output text file on unit 20.
|
||
|
|
||
|
include 'exodusII.inc'
|
||
|
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 NERR - error flag for dynamic memory errors - numeric
|
||
|
C CERR - error flag for dynamic memory errors - character
|
||
|
C IOERR - Input/output error flag
|
||
|
INTEGER CPUWS, IOWS, IERR, NERR, CERR, IOERR
|
||
|
C VERS - version number of database
|
||
|
REAL VERS
|
||
|
C QA program information
|
||
|
CHARACTER*(MXSTLN) QAINFO(6)
|
||
|
C Title of database/experiment
|
||
|
CHARACTER*(MXLNLN) TITLE
|
||
|
C Output string for number of time steps processed
|
||
|
CHARACTER*8 STR8
|
||
|
C Input filename
|
||
|
CHARACTER*2048 FILNAM, SCRATCH
|
||
|
|
||
|
C A(1) dynamic memory base array for numeric data
|
||
|
C C(1) dynamic memory base array for character data
|
||
|
DIMENSION A(1)
|
||
|
CHARACTER*1 C(1)
|
||
|
|
||
|
C Program Information
|
||
|
C.
|
||
|
QAINFO(1) = 'exotxt '
|
||
|
QAINFO(2) = '2021/01/28 '
|
||
|
QAINFO(3) = ' 2.01 '
|
||
|
QAINFO(4) = ' '
|
||
|
QAINFO(5) = ' '
|
||
|
QAINFO(6) = ' '
|
||
|
|
||
|
CALL STRTUP (QAINFO)
|
||
|
|
||
|
CALL BANNER (0, QAINFO,
|
||
|
& 'EXODUSII DATABASE TO TEXT FILE TRANSLATOR',
|
||
|
& ' ', ' ')
|
||
|
|
||
|
CALL PRTERR ('CMDSPEC',
|
||
|
$ 'Please use ncdump/ncgen instead of exotxt/txtexo.')
|
||
|
CALL MDINIT (A)
|
||
|
CALL MCINIT (C)
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
CALL MCSTAT (CERR, MEM)
|
||
|
IF ((NERR .GT. 0) .OR. (CERR .GT. 0)) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C --Open the input and output files
|
||
|
|
||
|
NDB = 11
|
||
|
NTXT = 20
|
||
|
|
||
|
C .. Get filename from command line. If not specified, emit error message
|
||
|
NARG = argument_count()
|
||
|
if (narg .lt. 2) then
|
||
|
CALL PRTERR ('FATAL', 'Filename not specified.')
|
||
|
CALL PRTERR ('CMDSPEC', 'Syntax is: "exotxt db_file text_file"')
|
||
|
CALL PRTERR ('CMDSPEC',
|
||
|
* 'Documentation: https://sandialabs.github.io' //
|
||
|
$ '/seacas-docs/sphinx/html/index.html#exotxt')
|
||
|
GOTO 140
|
||
|
else if (narg .gt. 2) then
|
||
|
CALL PRTERR ('FATAL', 'Too many arguments specified.')
|
||
|
CALL PRTERR ('CMDSPEC', 'Syntax is: "exotxt db_file text_file"')
|
||
|
CALL PRTERR ('CMDSPEC',
|
||
|
* 'Documentation: https://sandialabs.github.io' //
|
||
|
$ '/seacas-docs/sphinx/html/index.html#exotxt')
|
||
|
GOTO 140
|
||
|
end if
|
||
|
|
||
|
C Open the input database; Exit on error
|
||
|
CALL get_argument(1,FILNAM, LFIL)
|
||
|
CPUWS = 0
|
||
|
IOWS = 0
|
||
|
NDB = 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 140
|
||
|
END IF
|
||
|
|
||
|
CALL get_argument(2,FILNAM, LFIL)
|
||
|
open(unit=ntxt, file=filnam(:lfil), iostat=ierr)
|
||
|
IF (IERR .NE. 0) THEN
|
||
|
SCRATCH = 'Could not create "'//FILNAM(:LFIL)//'"'
|
||
|
CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C --Read the initial variables
|
||
|
CALL EXGINI (NDB, TITLE, NNDIM, NUMNP, NUMEL, NELBLK,
|
||
|
& NUMNPS, NUMESS, IERR)
|
||
|
|
||
|
call exinq(ndb, EXDBMXUSNM, namlen, rdum, cdum, ierr)
|
||
|
call exmxnm(ndb, namlen, ierr)
|
||
|
|
||
|
C Request length of the concatenated node set node list
|
||
|
CALL EXINQ (NDB, EXNSNL, LNPSNL, RNUM, CNUM, IERR)
|
||
|
C Request length of the node set distribution factors list
|
||
|
CALL EXINQ (NDB, EXNSDF, LNPSDF, RDUM, CDUM, IERR)
|
||
|
C Request length of the concatenated side sets element list
|
||
|
CALL EXINQ (NDB, EXSSEL, LESSEL, RNUM, CNUM, IERR)
|
||
|
C Request length of the concatenated side sets node list
|
||
|
CALL EXINQ (NDB, EXSSNL, LESSNL, RNUM, CNUM, IERR)
|
||
|
C Request length of the side set distribution factors list
|
||
|
CALL EXINQ (NDB, EXSSDF, LESSDF, RNUM, CNUM, IERR)
|
||
|
|
||
|
CALL WRINIT (NTXT, VERS, TITLE, NNDIM, NUMNP, NUMEL, NELBLK,
|
||
|
& NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL,
|
||
|
& LESSDF,QAINFO, NAMLEN)
|
||
|
CALL DBPINI ('TIS', NDB, TITLE, NNDIM, NUMNP, NUMEL, NELBLK,
|
||
|
& NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSDF,
|
||
|
& IDUM, IDUM, IDUM, ' ')
|
||
|
|
||
|
C --Read the coordinates
|
||
|
|
||
|
CALL MDRSRV ('XN', KXN, NUMNP)
|
||
|
IF (NNDIM .GE. 2) CALL MDRSRV ('YN', KYN, NUMNP)
|
||
|
IF (NNDIM .GE. 3) CALL MDRSRV ('ZN', KZN, NUMNP)
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C Reserve memory for coordinate array names
|
||
|
CALL MCRSRV ('NAMECO', KNACOR, NAMLEN*NNDIM)
|
||
|
|
||
|
call getxyz(ndb, c(knacor), a(kXN), A(KYN), A(KZN), IERR, namlen)
|
||
|
CALL WRXYZ (NTXT, NNDIM, NUMNP, A(KXN), A(KYN), A(KZN),
|
||
|
* C(knacor), namlen)
|
||
|
|
||
|
CALL MDDEL ('XN')
|
||
|
IF (NNDIM .GE. 2) CALL MDDEL ('YN')
|
||
|
IF (NNDIM .GE. 3) CALL MDDEL ('ZN')
|
||
|
CALL MCDEL ('NAMECO')
|
||
|
|
||
|
C --ExodusIIv2 Read node number map, element number map,
|
||
|
C --and element order map
|
||
|
CALL MDRSRV ('NPMAP', KNPMAP, NUMNP)
|
||
|
CALL MDRSRV ('ELMAP', KELMAP, NUMEL)
|
||
|
CALL MDRSRV ('MAPEL', KMAPEL, NUMEL)
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C Read node number map
|
||
|
CALL EXGNNM (NDB, A(KNPMAP), IERR)
|
||
|
C Read element number map
|
||
|
CALL EXGENM (NDB, A(KELMAP), IERR)
|
||
|
C Read element order map
|
||
|
CALL EXGMAP (NDB, A(KMAPEL), IERR)
|
||
|
|
||
|
CALL WRMAP (NTXT, '*', NUMNP, NUMEL,
|
||
|
& A(KNPMAP), A(KELMAP), A(KMAPEL))
|
||
|
|
||
|
CALL MDDEL ('NPMAP')
|
||
|
CALL MDDEL ('ELMAP')
|
||
|
CALL MDDEL ('MAPEL')
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C --Read/write the element blocks
|
||
|
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 NAMELB: Element type
|
||
|
CALL MCRSRV ('NAMELB', 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 140
|
||
|
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 (NDB, '*', 1, NELBLK, A(KIDELB), A(KNELB),
|
||
|
& A(KNLNK), A(KNATR), C(KNMLB), A, IELNK, IEATR, IOERR)
|
||
|
C Exit program on error reading element block information
|
||
|
IF (IOERR .EQ. 1) GO TO 140
|
||
|
CALL MDFIND ('LINK', KLINK, IELNK)
|
||
|
CALL MDFIND ('ATRIB', KATRIB, IEATR)
|
||
|
CALL WRELB (NTXT, NELBLK, A(KIDELB), A(KNELB), A(KNLNK),
|
||
|
& A(KNATR), C(KNMLB), A(KLINK), A(KATRIB))
|
||
|
|
||
|
CALL MDDEL ('NUMLNK')
|
||
|
CALL MDDEL ('NUMATR')
|
||
|
CALL MDDEL ('LINK')
|
||
|
CALL MDDEL ('VISELB')
|
||
|
CALL MDDEL ('ATRIB')
|
||
|
CALL MCDEL ('NAMELB')
|
||
|
CALL MDSTAT (NERR,MEM)
|
||
|
CALL MCSTAT (CERR, MEM)
|
||
|
IF ((NERR .GT. 0) .OR. (CERR .GT. 0)) THEN
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
END IF
|
||
|
|
||
|
C --Read/write the node sets
|
||
|
|
||
|
C if number of node set > 0
|
||
|
IF (NUMNPS .GT. 0) THEN
|
||
|
C IDNPS - array containing the node set ID's for each node set
|
||
|
C NNNPS - array containing the number of nodes for each node set
|
||
|
C NDNPS - array containing number of dist. fact for each node set
|
||
|
C IXNNPS - array containing indices into the LTNNPS array which
|
||
|
C are the location of the 1st nodes for each set
|
||
|
C IXDNPS - array containing indices into the FACNPS array which
|
||
|
C are the location of the 1st dist factor for each set
|
||
|
C LTNNPS - Returned array containing the nodes for all node sets
|
||
|
C Internal node IDs
|
||
|
C FACNPS - Returned array containing the distribution factors
|
||
|
C for all node sets
|
||
|
CALL MDRSRV ('IDNPS', KIDNS, NUMNPS)
|
||
|
CALL MDRSRV ('NNNPS', KNNNS, NUMNPS)
|
||
|
CALL MDRSRV ('NDNPS', KNDNPS, NUMNPS)
|
||
|
CALL MDRSRV ('IXNNPS', KIXNNS, NUMNPS)
|
||
|
CALL MDRSRV ('IXDNPS', KDISNS, NUMNPS)
|
||
|
CALL MDRSRV ('LTNNPS', KLTNNS, LNPSNL)
|
||
|
CALL MDRSRV ('FACNPS', KFACNS, LNPSNL)
|
||
|
CALL MDSTAT (NERR,MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
END IF
|
||
|
C Read the concatenated node sets
|
||
|
CALL EXGCNS (ndb, a(kidns), a(knnns), a(kndnps),
|
||
|
& a(kixnns), a(kdisns), a(kltnns),
|
||
|
& a(kfacns), IERR)
|
||
|
CALL WRNPS (NTXT, NUMNPS, LNPSNL, LNPSDF, A(KIDNS),
|
||
|
& A(KNNNS), A(KNDNPS), A(KIXNNS), A(KDISNS),
|
||
|
& A(KLTNNS), A(KFACNS))
|
||
|
|
||
|
CALL MDDEL ('IDNPS')
|
||
|
CALL MDDEL ('NNNPS')
|
||
|
CALL MDDEL ('NDNPS')
|
||
|
CALL MDDEL ('IXNNPS')
|
||
|
CALL MDDEL ('IXDNPS')
|
||
|
CALL MDDEL ('LTNNPS')
|
||
|
CALL MDDEL ('FACNPS')
|
||
|
CALL MDSTAT (NERR,MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
C --Read/write the element side sets
|
||
|
|
||
|
IF (NUMESS .GT. 0) THEN
|
||
|
C IDESS - array containing side set IDS
|
||
|
C NEESS - array containing the number of sides for each sets
|
||
|
C KNDSS - Returned array containing the number of dist
|
||
|
C factors for each set
|
||
|
C IXEESS - returned array containing the indices into the
|
||
|
C LTEESS array which are the locations of the 1st
|
||
|
C element of each set
|
||
|
C IXNESS - Returned array containing the indices into the
|
||
|
C FACESS array which are the locations of the 1st
|
||
|
C distribution factor for each set.
|
||
|
C LTEESS - Returned array containing the elements for all side
|
||
|
C sets. Internal element IDS are used in this list
|
||
|
C LTSESS - Returned array containing the sides for all side sets
|
||
|
C FACESS - Returned array containing dist factors for all side sets
|
||
|
C NNESS - the number of nodes for each side set
|
||
|
C IXNESS - index into LTNESS - the 1st node for each side set
|
||
|
C LTNESS - array of nodes for all side sets
|
||
|
C LTNNN - array of number of nodes for each side in a side set
|
||
|
CALL MDRSRV ('IDESS' , KIDSS , NUMESS)
|
||
|
CALL MDRSRV ('NEESS' , KNESS , NUMESS)
|
||
|
CALL MDRSRV ('NDESS' , KNDSS , NUMESS)
|
||
|
CALL MDRSRV ('IXEESS', KIXESS, NUMESS)
|
||
|
CALL MDRSRV ('IXDESS', KIDESS, NUMESS)
|
||
|
CALL MDRSRV ('LTEESS', KLTESS, LESSEL)
|
||
|
CALL MDRSRV ('LTSESS', KLTSSS, LESSEL)
|
||
|
CALL MDRSRV ('FACESS', KFACSS, LESSNL)
|
||
|
CALL MDRSRV ('NNESS' , KNNSS, NUMESS)
|
||
|
CALL MDRSRV ('IXNESS', KIXNSS, NUMESS)
|
||
|
CALL MDRSRV ('LTNESS', KLTNSS, LESSNL)
|
||
|
CALL MDRSRV ('LTNNN' , KLTNNN, LESSEL)
|
||
|
CALL MDSTAT(NERR, MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
END IF
|
||
|
|
||
|
C Read concatenated side sets
|
||
|
CALL EXGCSS (NDB, A(KIDSS), A(KNESS), A(KNDSS),
|
||
|
& A(KIXESS), A(KIDESS), A(KLTESS),
|
||
|
& A(KLTSSS), A(KFACSS), IOERR)
|
||
|
|
||
|
C Convert sides to nodes
|
||
|
CALL DBIGN (NDB, NUMESS, A(KIDSS), A(KNNSS),
|
||
|
& A(KIXNSS), A(KLTNSS), A(KLTNNN), IOERR)
|
||
|
IF (IOERR .EQ. 1) GO TO 140
|
||
|
|
||
|
CALL WRESS (NTXT, NUMESS, LESSEL, LESSNL, LESSDF,
|
||
|
& A(KIDSS), A(KNESS), A(KNDSS), A(KIXESS), A(KIDESS),
|
||
|
& A(KLTESS), A(KLTSSS), A(KFACSS), A(KNNSS), A(KIXNSS),
|
||
|
& A(KLTNSS), A(KLTNNN))
|
||
|
|
||
|
CALL MDDEL ('IDESS')
|
||
|
CALL MDDEL ('NEESS')
|
||
|
CALL MDDEL ('NDESS')
|
||
|
CALL MDDEL ('IXEESS')
|
||
|
CALL MDDEL ('IXDESS')
|
||
|
CALL MDDEL ('LTEESS')
|
||
|
CALL MDDEL ('LTSESS')
|
||
|
CALL MDDEL ('FACESS')
|
||
|
CALL MDDEL ('NNESS')
|
||
|
CALL MDDEL ('IXNESS')
|
||
|
CALL MDDEL ('LTNESS')
|
||
|
CALL MDDEL ('LTNNN')
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
IF (NERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
END IF
|
||
|
|
||
|
write (ntxt, '(A)') '! Properties'
|
||
|
C Element Block, Node Set, and Side Set Properties
|
||
|
C number of element block properties
|
||
|
call exinq(ndb, EXNEBP, numebp, rdum, cdum, ierr)
|
||
|
C number of node set properties
|
||
|
call exinq(ndb, EXNNSP, numnsp, rdum, cdum, ierr)
|
||
|
C number of side set properties
|
||
|
call exinq(ndb, EXNSSP, numssp, rdum, cdum, ierr)
|
||
|
C************************************************************************
|
||
|
C Read element block properties
|
||
|
C************************************************************************
|
||
|
C Reserve memory for element block properties names and values
|
||
|
call mcrsrv ('EBPNAM', iebpn, numebp * namlen)
|
||
|
call mdrsrv ('EBPVAL', iebpv, numebp * nelblk)
|
||
|
call mcstat (cerr, mem)
|
||
|
call mdstat (nerr, mem)
|
||
|
if ((nerr .ne. 0) .or. (cerr .ne. 0)) then
|
||
|
call memerr()
|
||
|
ioerr = 1
|
||
|
end if
|
||
|
write (NTXT, '(I10,12x,A)') numebp,
|
||
|
& '! Number of ELEMENT BLOCK Properties'
|
||
|
call wrprop (ndb, NTXT, EXEBLK, numebp, nelblk,
|
||
|
& c(iebpn), a(iebpv), namlen)
|
||
|
|
||
|
call mcdel ('EBPNAM')
|
||
|
call mddel ('EBPVAL')
|
||
|
|
||
|
C************************************************************************
|
||
|
C read/write node set properties
|
||
|
C************************************************************************
|
||
|
call mcrsrv ('NSPNAM', inspn, numnsp * namlen)
|
||
|
call mdrsrv ('NSPVAL', inspv, numnsp * numnps)
|
||
|
call mcstat (cerr, mem)
|
||
|
call mdstat (nerr, mem)
|
||
|
if ((nerr .ne. 0) .or. (cerr .ne. 0)) then
|
||
|
call memerr()
|
||
|
ioerr = 1
|
||
|
end if
|
||
|
|
||
|
write (NTXT, '(I10,12x,A)') numnsp,
|
||
|
& '! Number of NODE SET Properties'
|
||
|
call wrprop (ndb, NTXT, EXNSET, numnsp, numnps,
|
||
|
& c(inspn), a(inspv), namlen)
|
||
|
|
||
|
call mcdel ('NSPNAM')
|
||
|
call mddel ('NSPVAL')
|
||
|
|
||
|
C************************************************************************
|
||
|
C read/write side set properties
|
||
|
C************************************************************************
|
||
|
|
||
|
call mcrsrv ('SSPNAM', isspn, numssp * namlen)
|
||
|
call mdrsrv ('SSPVAL', isspv, numssp * numess)
|
||
|
call mcstat (cerr, mem)
|
||
|
call mdstat (nerr, mem)
|
||
|
if ((nerr .ne. 0) .or. (cerr .ne. 0)) then
|
||
|
call memerr()
|
||
|
ioerr = 1
|
||
|
end if
|
||
|
|
||
|
write (NTXT, '(I10,12x,A)') numssp,
|
||
|
& '! Number of SIDE SET Properties'
|
||
|
call wrprop (ndb, NTXT, EXSSET, numssp, numess,
|
||
|
& c(isspn), a(isspv), namlen)
|
||
|
|
||
|
call mcdel ('SSPNAM')
|
||
|
call mddel ('SSPVAL')
|
||
|
call mdstat (nerr, mem)
|
||
|
if (nerr .ne. 0) then
|
||
|
call memerr()
|
||
|
ioerr = 1
|
||
|
end if
|
||
|
|
||
|
C --Read the QA records
|
||
|
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(ndb, EXQA, nqarec, rdum, cdum, ierr)
|
||
|
C Request the number of information records. Return the
|
||
|
C value as an integer in ninfo
|
||
|
call exinq(ndb, EXINFO, ninfo, rdum, cdum, ierr)
|
||
|
|
||
|
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 (CERR, MEM)
|
||
|
IF (CERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
CALL DBIQA (NDB, '*', NQAREC, C(KQAREC), NINFO, C(KINFO))
|
||
|
CALL WRQA (NTXT, NQAREC, C(KQAREC), NINFO, C(KINFO), QAINFO)
|
||
|
|
||
|
CALL MCDEL ('QAREC')
|
||
|
CALL MCDEL ('INFREC')
|
||
|
CALL MCSTAT (CERR, MEM)
|
||
|
IF (CERR .GT. 0) THEN
|
||
|
CALL MEMERR
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C --Read the database names
|
||
|
|
||
|
C Read the number of global, node, and element variables
|
||
|
C EXGVP reads the number of global, nodal, or element
|
||
|
C variables stored in the database
|
||
|
C Read number of global variables = nvargl
|
||
|
call exgvp(ndb, 'G', nvargl, ierr)
|
||
|
C Read number of nodal variables = nvarnp
|
||
|
call exgvp(ndb, 'N', nvarnp, ierr)
|
||
|
C Read number of element variables = nvarel
|
||
|
call exgvp(ndb, 'E', nvarel, ierr)
|
||
|
|
||
|
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)
|
||
|
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
|
||
|
GOTO 140
|
||
|
END IF
|
||
|
|
||
|
C Read the names of the global, node, and element variables
|
||
|
CALL DBINAM (NDB, C, C(KNAMES), NVARGL, NVARNP, NVAREL,
|
||
|
& KNAMGV, KNAMNV, KNAMEV, IOERR, NAMLEN)
|
||
|
IF (IOERR .EQ. 1) GO TO 140
|
||
|
|
||
|
CALL DBPINI ('V', NDB, TITLE, NNDIM, NUMNP, NUMEL, NELBLK,
|
||
|
& NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSDF,
|
||
|
& NVARGL, NVARNP, NVAREL, ' ')
|
||
|
|
||
|
C Read the element variable truth table
|
||
|
CALL DBIVTT (NDB, A(KIEVOK), A(KITMP), NELBLK, NVAREL)
|
||
|
|
||
|
CALL WRNAME (NTXT, NNDIM, NELBLK, NVARGL, NVARNP, NVAREL,
|
||
|
& C(KNAMES+NAMLEN*(KNAMGV-1)), C(KNAMES+NAMLEN*(KNAMNV-1)),
|
||
|
& C(KNAMES+NAMLEN*(KNAMEV-1)), A(KIEVOK), NAMLEN)
|
||
|
|
||
|
C Delete temporary dynamic memory
|
||
|
CALL MCDEL('NAMES')
|
||
|
CALL MDDEL('ITMP')
|
||
|
CALL MCSTAT (CERR, MEM)
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
if ((NERR .GT. 0) .OR. (CERR .GT. 0)) then
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
end if
|
||
|
|
||
|
C --Read the number of database time steps
|
||
|
call exinq(ndb, EXTIMS, nsteps, rdum, cdum, ierr)
|
||
|
|
||
|
CALL MDRSRV ('VARGL', KVARGL, NVARGL)
|
||
|
CALL MDRSRV ('VARNP', KVARNP, NVARNP * NUMNP)
|
||
|
CALL MDRSRV ('VAREL', KVAREL, NVAREL * NUMEL)
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
if (NERR .GT. 0) then
|
||
|
CALL MEMERR
|
||
|
GO TO 140
|
||
|
end if
|
||
|
|
||
|
C ... Zero out memory to account for variables not read from DB
|
||
|
C due to truth table...
|
||
|
CALL INIREA(NVAREL*NUMEL, 0.0, A(KVAREL))
|
||
|
CALL INIREA(NVARNP*NUMNP, 0.0, A(KVARNP))
|
||
|
|
||
|
WRITE (*, *)
|
||
|
WRITE (*, *)
|
||
|
|
||
|
WRITE (*, 10020) NSTEPS
|
||
|
10020 FORMAT (' ', I8, ' time steps on the input database')
|
||
|
DO 110 ISTEP = 1, NSTEPS
|
||
|
CALL DBISTE (NDB, '*', ISTEP, NELBLK, TIME,
|
||
|
& NVARGL, NVARNP, NVAREL, NUMNP,
|
||
|
& A(KIDELB), A(KNELB), A(KIEVOK),
|
||
|
& A(KVARGL), A(KVARNP), A(KVAREL), IOERR)
|
||
|
IF (IOERR .EQ. 1) GO TO 140
|
||
|
|
||
|
CALL WRSTEP (NTXT, ISTEP, NELBLK, TIME,
|
||
|
& NVARGL, NVARNP, NVAREL, NUMNP,
|
||
|
& A(KIDELB), A(KNELB), A(KIEVOK),
|
||
|
& A(KVARGL), A(KVARNP), A(KVAREL),
|
||
|
& MAX(1, NVARGL), MAX(1, NVARNP),
|
||
|
& MAX(1, NVAREL), IOERR)
|
||
|
IF (IOERR .EQ. 1) GO TO 140
|
||
|
|
||
|
WRITE (*, 10000) ISTEP
|
||
|
10000 FORMAT (I8, ' time steps processed')
|
||
|
110 CONTINUE
|
||
|
|
||
|
WRITE (STR8, '(I8)', IOSTAT=K) NSTEPS
|
||
|
CALL SQZSTR (STR8, LSTR)
|
||
|
WRITE (*, 10010) STR8(:LSTR)
|
||
|
10010 FORMAT (/, 4X, A,
|
||
|
& ' time steps have been written to the text file')
|
||
|
|
||
|
C Delete dynamic memory
|
||
|
CALL MDDEL ('IDELB')
|
||
|
CALL MDDEL ('NUMELB')
|
||
|
CALL MDDEL ('ISEVOK')
|
||
|
CALL MDDEL ('VARGL')
|
||
|
CALL MDDEL ('VARNP')
|
||
|
CALL MDDEL ('VAREL')
|
||
|
CALL MDSTAT (NERR, MEM)
|
||
|
if (NERR .GT. 0) CALL MEMERR
|
||
|
|
||
|
140 CONTINUE
|
||
|
|
||
|
CLOSE (NTXT, IOSTAT=K)
|
||
|
if (ndb .ne. 11 .and. ndb .gt. 0) call exclos(ndb, ierr)
|
||
|
call addlog (QAINFO(1)(:lenstr(QAINFO(1))))
|
||
|
CALL PRTERR ('CMDSPEC',
|
||
|
$ 'Please use ncdump/ncgen instead of exotxt/txtexo.')
|
||
|
CALL WRAPUP (QAINFO(1))
|
||
|
|
||
|
END
|
||
|
|
||
|
C ... Written as wrapper to get string lengths correct on coordinate
|
||
|
C name array which is dynamically allocated
|
||
|
SUBROUTINE GETXYZ(NDB, NAMECO, X, Y, Z, ierr, namlen)
|
||
|
character*(NAMLEN) NAMECO(*)
|
||
|
real x(*), y(*), z(*)
|
||
|
CALL EXGCOR(NDB, X, Y, Z, ierr)
|
||
|
call exgcon(ndb, nameco, ierr)
|
||
|
return
|
||
|
end
|