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.
382 lines
12 KiB
382 lines
12 KiB
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 See packages/seacas/LICENSE for details
|
|
|
|
PROGRAM NUMBER
|
|
|
|
C ... Program to calculate the centroid location and the
|
|
C mass moment of inertia for a axisymmetric and plane 2-D mesh
|
|
C and a 3-D mesh defined in the genesis format.
|
|
|
|
C LINK WITH SUPES LIBRARY
|
|
include 'exodusII.inc'
|
|
|
|
include 'nu_progqa.blk'
|
|
include 'nu_numg.blk'
|
|
include 'nu_varcnt.blk'
|
|
include 'nu_mass.blk'
|
|
include 'nu_cvty.blk'
|
|
include 'nu_logs.blk'
|
|
include 'nu_ptim.blk'
|
|
include 'nu_nset.blk'
|
|
include 'nu_io.blk'
|
|
include 'nu_ndisp.blk'
|
|
include 'argparse.inc'
|
|
|
|
CHARACTER*2048 DBNAME, SCRATCH
|
|
|
|
CHARACTER*(MXLNLN) TITLE
|
|
DIMENSION A(1), IA(1)
|
|
EQUIVALENCE (A(1),IA(1))
|
|
CHARACTER*1 C(1)
|
|
|
|
PARAMETER (MXNAM = 256)
|
|
CHARACTER*(MXSTLN) NAMECO(6), NAMES(MXNAM)
|
|
|
|
integer cmpsiz, iows
|
|
|
|
include 'nu_qainfo.blk'
|
|
|
|
C UNIT 6 = STANDARD OUTPUT
|
|
C 7 = ASCII OUTPUT
|
|
C 9 = BINARY MESH INPUT (GENESIS)
|
|
|
|
ITERM = 6
|
|
IHARD = 7
|
|
NDB = 0
|
|
|
|
CALL STRTUP (QAINFO)
|
|
CALL BANNER (ITERM, QAINFO,
|
|
& 'A GENESIS/EXODUS DATABASE INFORMATION PROGRAM',
|
|
& ' ', ' ')
|
|
CALL BANNER (IHARD, QAINFO,
|
|
& 'A GENESIS/EXODUS DATABASE INFORMATION PROGRAM',
|
|
& ' ', ' ')
|
|
call cpyrgt (ITERM, '1988')
|
|
call cpyrgt (IHARD, '1988')
|
|
|
|
C ... GET FILENAMES:
|
|
|
|
C .. Get filename from command line. If not specified, emit error message
|
|
NARG = argument_count()
|
|
|
|
if (narg .lt. 1) then
|
|
CALL PRTERR ('FATAL', 'Filename(s) not specified.')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax is: "numbers filename [output]"')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Documentation: https://sandialabs.github.io' //
|
|
$ '/seacas-docs/sphinx/html/index.html#numbers')
|
|
GOTO 60
|
|
else if (narg .gt. 2) then
|
|
CALL PRTERR ('FATAL', 'Too many arguments specified.')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Syntax is: "numbers filename [output]"')
|
|
CALL PRTERR ('CMDSPEC',
|
|
* 'Documentation: https://sandialabs.github.io' //
|
|
$ '/seacas-docs/sphinx/html/index.html#numbers')
|
|
GOTO 60
|
|
end if
|
|
|
|
if (narg .eq. 2) then
|
|
CALL get_argument(2,dbname, lfil)
|
|
else
|
|
dbname = "numbers.o"
|
|
lfil=lenstr(dbname)
|
|
end if
|
|
|
|
open(unit=ihard, file=dbname(:lfil), iostat=ierr)
|
|
IF (IERR .NE. 0) THEN
|
|
SCRATCH = 'Could not create "'//dbname(:LFIL)//'"'
|
|
CALL PRTERR ('FATAL', SCRATCH(:LENSTR(SCRATCH)))
|
|
GOTO 60
|
|
END IF
|
|
|
|
CMPSIZ = 0
|
|
IOWS = 0
|
|
DBNAME = ' '
|
|
CALL get_argument(1,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 60
|
|
END IF
|
|
|
|
CALL MDINIT (A)
|
|
CALL MCINIT (C)
|
|
|
|
call exgini(ndb, title, ndim, numnp, numel, nelblk,
|
|
* numnps, numess, ierr)
|
|
if (numnps .gt. 0) then
|
|
call exinq(ndb, EXNSNL, lnpsnl, rdum, cdum, ierr)
|
|
call exinq(ndb, EXNSDF, lnpsdf, rdum, cdum, ierr)
|
|
else
|
|
lnpsnl = 0
|
|
lnpsdf = 0
|
|
end if
|
|
if (numess .gt. 0) then
|
|
call exinq(ndb, EXSSNL, lessnl, rdum, cdum, ierr)
|
|
call exinq(ndb, EXSSEL, lessel, rdum, cdum, ierr)
|
|
call exinq(ndb, EXSSDF, lessdf, rdum, cdum, ierr)
|
|
else
|
|
lessnl = 0
|
|
lessel = 0
|
|
lessdf = 0
|
|
end if
|
|
|
|
CALL DBPINI ('TIS', NDB, TITLE, NDIM, NUMNP, NUMEL, NELBLK,
|
|
* NUMNPS, LNPSNL, LNPSDF, NUMESS, LESSEL, LESSNL, LESSDF,
|
|
* 0, 0, 0, DBNAME(:LNAM))
|
|
|
|
AXI = .TRUE.
|
|
EXODUS = .FALSE.
|
|
NNODES = 2**NDIM
|
|
|
|
CALL MDRSRV ('CRD', IR, NUMNP*NDIM)
|
|
IRX = IR
|
|
IRY = IR + NUMNP
|
|
IRZ = IR + 2 * NUMNP
|
|
|
|
CALL MDRSRV ('MAT', IM, 6*NELBLK)
|
|
CALL MDRSRV ('LINK', IX, 0)
|
|
|
|
CALL MDRSRV ('DENS',ID, NELBLK)
|
|
CALL MDRSRV ('WAVE',IW, NELBLK)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) GO TO 55
|
|
|
|
CALL INIREA ( NELBLK, 0.0, A(ID))
|
|
CALL INIREA ( NELBLK, 0.0, A(IW))
|
|
|
|
call exgcor (ndb, a(irx), a(iry), a(irz), ierr)
|
|
if (ierr .ne. 0) go to 60
|
|
call exgcon (ndb, nameco, ierr)
|
|
if (ierr .ne. 0) go to 60
|
|
do 10 i=1, ndim
|
|
call exupcs(nameco(i))
|
|
10 continue
|
|
|
|
C ... Scratch space for block info
|
|
|
|
CALL MDRSRV ('IDELB', IDELB, NELBLK)
|
|
CALL MDRSRV ('NUMELB', NUMELB, NELBLK)
|
|
CALL MDRSRV ('NUMLNK', NUMLNK, NELBLK)
|
|
CALL MDRSRV ('NUMATR', NUMATR, NELBLK)
|
|
CALL MCRSRV ('NAMELB', KNAMEL, MXSTLN*NELBLK)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) GO TO 55
|
|
|
|
CALL DBIELB (NDB, 'HIC', 1, NELBLK, IA(IDELB), IA(NUMELB),
|
|
* IA(NUMLNK), IA(NUMATR), A, IA, IX, IDUM, C(KNAMEL), *60)
|
|
CALL TRBLK (IA(IDELB), IA(NUMELB), IA(NUMLNK), IA(IM),
|
|
& NELBLK, NNODES)
|
|
CALL SORBLK (IA(IDELB), IA(NUMLNK), IA(IM), NELBLK)
|
|
CALL MDDEL ('IDELB' )
|
|
CALL MDDEL ('NUMLNK')
|
|
CALL MDDEL ('NUMELB')
|
|
CALL MDDEL ('NUMATR')
|
|
|
|
C ... BOUNDARY CONDITION FLAGS
|
|
|
|
C -- Node Sets:
|
|
C INS1 = IDNPS (NUMNPS) NODAL POINT SET IDS
|
|
C INS2 = NNNPS (NUMNPS) NODAL POINT SET COUNTS
|
|
C INS3 = IPTNPS (NUMNPS) NODAL POINT SET POINTER
|
|
C INS4 = LSTNPS (LNPSNL) NODAL POINT SET NODE LIST
|
|
C INS5 = FACNPS (LNPSNL) NODAL POINT DISTRIBUTION FACTORS
|
|
|
|
C -- Element Side Sets:
|
|
C IBC1 = IDESS (NUMESS) ELEMENT SIDE SET IDS
|
|
C IBC2 = NEESS (NUMESS) ELEMENT SIDE SET ELEMENT COUNTS
|
|
C IBC3 = NNESS (NUMESS) ELEMENT SIDE SET NODE COUNTS
|
|
C IBC4 = IPEESS (NUMESS) ELEMENT SIDE SET ELEMENT POINTERS
|
|
C IBC5 = IPNESS (NUMESS) ELEMENT SIDE SET NODE POINTERS
|
|
C IBC6 = LTEESS (LESSEL) ELEMENT SIDE SET ELEMENT LIST
|
|
C IBC7 = LTNESS (LESSNL) ELEMENT SIDE SET NODE LIST
|
|
C IBC8 = FACESS (LESSNL) ELEMENT SIDE SET DISTRIBUTION FACTORS
|
|
|
|
CALL MDRSRV ('IDNPS', INS1, NUMNPS)
|
|
CALL MDRSRV ('NNNPS', INS2, NUMNPS)
|
|
CALL MDRSRV ('NDNPS', INS6, NUMNPS)
|
|
CALL MDRSRV ('IPTNPS', INS3, NUMNPS)
|
|
CALL MDRSRV ('IPTNDS', INS7, NUMNPS)
|
|
CALL MDRSRV ('LSTNPS', INS4, LNPSNL)
|
|
CALL MDRSRV ('FACNPS', INS5, LNPSNL)
|
|
|
|
CALL MDRSRV ('IDESS', IBC1, NUMESS)
|
|
CALL MDRSRV ('NEESS', IBC2, NUMESS)
|
|
CALL MDRSRV ('NNESS', IBC3, NUMESS)
|
|
CALL MDRSRV ('NDESS', IBC11,NUMESS)
|
|
CALL MDRSRV ('IPEESS', IBC4, NUMESS)
|
|
CALL MDRSRV ('IPNESS', IBC5, NUMESS)
|
|
CALL MDRSRV ('IXDESS', IBC9, NUMESS) !
|
|
CALL MDRSRV ('LTNNSS', KLTNNN, LESSEL)
|
|
CALL MDRSRV ('LTEESS', IBC6, LESSEL)
|
|
CALL MDRSRV ('LTNESS', IBC7, LESSNL)
|
|
CALL MDRSRV ('LTSESS', IBC10,LESSEL)
|
|
CALL MDRSRV ('FACESS', IBC8, LESSNL)
|
|
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) GO TO 55
|
|
|
|
if (numnps .gt. 0) then
|
|
call exgcns(ndb, a(ins1), a(ins2), a(ins6), a(ins3), a(ins7),
|
|
& a(ins4), a(ins5), ierr)
|
|
if (ierr .ne. 0) go to 60
|
|
end if
|
|
|
|
if (numess .gt. 0) then
|
|
call exgcss(ndb, a(ibc1), a(ibc2), a(ibc11), a(ibc4),
|
|
* a(ibc9), A(ibc6), a(ibc10), a(ibc8), ierr)
|
|
c ... Now convert sides to nodes....
|
|
C ... This code stolen from ex2ex1v2, Vic Yarberry
|
|
C offset into element list for current side set
|
|
isoff = 0
|
|
C node count for current side set
|
|
nodcnt = 0
|
|
do 104 i=0,numess-1
|
|
C update index array
|
|
ia(ibc5+i)=nodcnt+1
|
|
C get num of sides & df
|
|
call exgsp(ndb,ia(ibc1+i),nsess,ndess,nerr)
|
|
|
|
C get side set nodes
|
|
if (nsess .gt. 0) then
|
|
call exgssn(ndb,ia(ibc1+i),ia(kltnnn+isoff),
|
|
& ia(ibc7+nodcnt),nerr)
|
|
if (nerr .gt. 0) goto 60
|
|
end if
|
|
nness = 0
|
|
C sum node counts to calculate next index
|
|
do 102 ii=0,nsess-1
|
|
nness=nness+ia(kltnnn+isoff+ii)
|
|
102 continue
|
|
ia(ibc3+i)=nness
|
|
nodcnt=nodcnt+nness
|
|
isoff=isoff+nsess
|
|
104 continue
|
|
|
|
if (ierr .ne. 0) go to 60
|
|
end if
|
|
|
|
C ... TRY TO READ QA RECORDS. IF EOF THEN NOT EXODUS FORMAT
|
|
|
|
call exinq(ndb, EXQA, nqarec, rdum, cdum, ierr)
|
|
call exinq(ndb, EXINFO, ninfo, rdum, cdum, ierr)
|
|
call mcrsrv('QAREC', kqarec, nqarec * 4 * MXSTLN)
|
|
call mcrsrv('INFREC', kinfo, ninfo * MXLNLN)
|
|
CALL MCSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 60
|
|
if (nqarec .gt. 0) then
|
|
C ... Wrapper to get strings the right length
|
|
call exgqaw(ndb, c(kqarec), ierr)
|
|
end if
|
|
if (ninfo .gt. 0) then
|
|
C ... Wrapper to get info record the right length
|
|
call exginw(ndb, c(kinfo), ierr)
|
|
end if
|
|
|
|
CALL INISTR (MXNAM, ' ', NAMES)
|
|
|
|
call exgvp(ndb, 'G', nvargl, ierr)
|
|
call exgvp(ndb, 'N', nvarnp, ierr)
|
|
call exgvp(ndb, 'E', nvarel, ierr)
|
|
EXODUS = (nvargl + nvarnp + nvarel) .gt. 0
|
|
|
|
ixgv = 1
|
|
ixnv = ixgv + nvargl
|
|
ixev = ixnv + nvarnp
|
|
|
|
if (nvargl .gt. 0) then
|
|
call exgvan(ndb, 'G', nvargl, names(ixgv), ierr)
|
|
end if
|
|
if (nvarnp .gt. 0) then
|
|
call exgvan(ndb, 'N', nvarnp, names(ixnv), ierr)
|
|
end if
|
|
if (nvarel .gt. 0) then
|
|
call exgvan(ndb, 'E', nvarel, names(ixev), ierr)
|
|
end if
|
|
do 40 i=1, ixev+nvarel
|
|
call exupcs(names(i))
|
|
40 continue
|
|
|
|
IF (EXODUS) THEN
|
|
C ... Read truth table
|
|
call mdrsrv ('ISEVOK', IISEV, nvarel*nelblk)
|
|
CALL MDSTAT (NERRS, NUSED)
|
|
IF (NERRS .GT. 0) GO TO 55
|
|
call exgvtt (ndb, nelblk, nvarel, ia(iisev), ierr)
|
|
CALL DBPNAM ('*', NVARGL, NVARNP, NVAREL,
|
|
* NAMES(IXGV), NAMES(IXNV), NAMES(IXEV))
|
|
|
|
C --Read the database time steps
|
|
c determine how many time steps are stored
|
|
call exinq (ndb, EXTIMS, NSTEP, rdum, cdum, ierr)
|
|
call mdrsrv('TIMES', ITIME, max(NSTEP,1))
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 55
|
|
|
|
c read time values at all time steps
|
|
if (nstep .gt. 0) then
|
|
call exgatm (ndb, a(itime), ierr)
|
|
end if
|
|
|
|
CALL DBPTIM ('NM', NSTEP, A(ITIME))
|
|
CALL FNDDIS (NAMECO, NAMES(IXNV), ISDIS, NDIM, NVARNP,
|
|
* NDISP(1), NDISP(2), NDISP(3))
|
|
|
|
C ... DONE READING, START CALCULATING
|
|
|
|
CALL MDRSRV ('ITMSEL', ITSEL, max(1,NSTEP))
|
|
CALL MDRSRV ('DISPS', IDSP, NDIM * NUMNP)
|
|
ELSE
|
|
ITSEL = 1
|
|
IDSP = 1
|
|
END IF
|
|
|
|
C ... CALCULATE ELEMENT CENTROIDS FOR LATER USE
|
|
|
|
CALL MDRSRV ('ELCEN', IECEN, NDIM*NUMEL)
|
|
CALL MDSTAT (MNERRS, MNUSED)
|
|
IF (NERRS .GT. 0) GO TO 55
|
|
|
|
CALL ELCENT ( A(IECEN), A(IX), A(IR), NDIM, NUMEL, NNODES, NUMNP)
|
|
CALL HEADER (NDIM, TITLE, NUMEL, NUMNP, AXI, DBNAME(:LNAM))
|
|
|
|
CALL COMMAND (A, IA, TITLE, A(ITIME), A(ITSEL), A(IM),
|
|
* A(IDSP), A(IR), A(IX), A(ID), A(IW), A(IISEV),
|
|
* NAMES(IXGV), NAMES(IXNV), NAMES(IXEV),
|
|
* NQAREC, C(KQAREC), NINFO, C(KINFO), DBNAME(:LNAM),
|
|
* a(itimscr))
|
|
GO TO 60
|
|
|
|
55 CONTINUE
|
|
CALL MEMERR
|
|
GO TO 60
|
|
|
|
60 CONTINUE
|
|
call addlog (QAINFO(1)(:lenstr(QAINFO(1))))
|
|
CALL WRAPUP (QAINFO(1))
|
|
if (ndb .gt. 0) then
|
|
call exclos(ndb, ierr)
|
|
end if
|
|
call mdfree()
|
|
STOP
|
|
END
|
|
|
|
subroutine exgqaw(ndb, qarec, ierr)
|
|
include 'exodusII.inc'
|
|
character*(mxstln) qarec(4, *)
|
|
call exgqa(ndb, qarec, ierr)
|
|
return
|
|
end
|
|
|
|
subroutine exginw(ndb, info, ierr)
|
|
include 'exodusII.inc'
|
|
character*(mxlnln) info(*)
|
|
call exginf(ndb, info, ierr)
|
|
return
|
|
end
|
|
|