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.
198 lines
5.7 KiB
198 lines
5.7 KiB
2 years ago
|
C Copyright(C) 1999-2020 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
|
||
|
|
|
||
|
|
program testrd
|
||
|
|
|
||
|
|
c This is a test program for the Fortran binding of the EXODUS II
|
||
|
|
c database read routines
|
||
|
|
|
||
|
|
c 09/07/93 V.R. Yarberry - Modified for API 2.00
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
|
||
|
|
integer iin, iout, ierr, ioff
|
||
|
|
integer exoid, num_dim, num_nodes, num_elem, num_elem_blk
|
||
|
|
integer num_node_sets
|
||
|
|
integer num_side_sets
|
||
|
|
integer i, j, k, elem_map(100), connect(100), nnpe(10)
|
||
|
|
integer ids(10)
|
||
|
|
integer num_elem_in_block(10), num_nodes_per_elem(10)
|
||
|
|
integer num_attr(10)
|
||
|
|
integer cpu_ws,io_ws, mod_sz
|
||
|
|
|
||
|
|
real x(100), y(100), z(100)
|
||
|
|
real vers
|
||
|
|
|
||
|
|
character*(MXSTLN) coord_names(3)
|
||
|
|
character*(MXLNLN) titl
|
||
|
|
character*(MXSTLN) eltype(10)
|
||
|
|
|
||
|
|
data iin /5/, iout /6/
|
||
|
|
|
||
|
|
c open EXODUS II files
|
||
|
|
|
||
|
|
cpu_ws = 0
|
||
|
|
io_ws = 0
|
||
|
|
|
||
|
|
exoid = exopen ("test-nsided.exo", EXREAD, cpu_ws, io_ws,
|
||
|
|
* vers, ierr)
|
||
|
|
write (iout, '(/"after exopen, error = ",i3)')
|
||
|
|
1 ierr
|
||
|
|
|
||
|
|
write (iout, '("test-nsided.exo is an EXODUSII file; version ",
|
||
|
|
1 f4.2)') vers
|
||
|
|
write (iout, '(" I/O word size",i2)') io_ws
|
||
|
|
|
||
|
|
mod_sz = exlgmd(exoid)
|
||
|
|
write (iout, '(" Model Size",i2)') mod_sz
|
||
|
|
|
||
|
|
c read database parameters
|
||
|
|
|
||
|
|
call exgini (exoid, titl, num_dim, num_nodes, num_elem,
|
||
|
|
1 num_elem_blk, num_node_sets, num_side_sets, ierr)
|
||
|
|
write (iout, '(/"after exgini, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
write (iout, '("database parameters:"/
|
||
|
|
1 "title = ", a81 /
|
||
|
|
2 "num_dim = ", i3 /
|
||
|
|
3 "num_nodes = ", i3 /
|
||
|
|
4 "num_elem = ", i3 /
|
||
|
|
5 "num_elem_blk = ", i3 /
|
||
|
|
6 "num_node_sets = ", i3 /
|
||
|
|
7 "num_side_sets = ", i3)')
|
||
|
|
8 titl,num_dim, num_nodes, num_elem,
|
||
|
|
9 num_elem_blk,num_node_sets, num_side_sets
|
||
|
|
|
||
|
|
c read nodal coordinates values and names from database
|
||
|
|
|
||
|
|
call exgcor (exoid, x, y, z, ierr)
|
||
|
|
write (iout, '(/"after exgcor, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
write (iout, '("x coords = ")')
|
||
|
|
do 10 i = 1, num_nodes
|
||
|
|
write (iout, '(f5.1)') x(i)
|
||
|
|
10 continue
|
||
|
|
|
||
|
|
write (iout, '("y coords = ")')
|
||
|
|
do 20 i = 1, num_nodes
|
||
|
|
write (iout, '(f5.1)') y(i)
|
||
|
|
20 continue
|
||
|
|
|
||
|
|
if (num_dim .gt. 2) then
|
||
|
|
write (iout, '("z coords = ")')
|
||
|
|
do 22 i = 1, num_nodes
|
||
|
|
write (iout, '(f5.1)') z(i)
|
||
|
|
22 continue
|
||
|
|
endif
|
||
|
|
|
||
|
|
call exgcon (exoid, coord_names, ierr)
|
||
|
|
write (iout, '(/"after exgcon, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
write (iout, '("x coord name = ", a9)') coord_names(1)
|
||
|
|
write (iout, '("y coord name = ", a9)') coord_names(2)
|
||
|
|
|
||
|
|
c read element order map
|
||
|
|
|
||
|
|
call exgmap (exoid, elem_map, ierr)
|
||
|
|
write (iout, '(/"after exgmap, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
do 30 i = 1, num_elem
|
||
|
|
write (iout, '("elem_map(",i1,") = ", i1)') i, elem_map(i)
|
||
|
|
30 continue
|
||
|
|
|
||
|
|
c read element block parameters
|
||
|
|
|
||
|
|
call exgebi (exoid, ids, ierr)
|
||
|
|
write (iout, '(/"after exgebi, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
do 40 i = 1, num_elem_blk
|
||
|
|
|
||
|
|
call exgelb (exoid, ids(i), eltype(i), num_elem_in_block(i),
|
||
|
|
1 num_nodes_per_elem(i), num_attr(i), ierr)
|
||
|
|
write (iout, '(/"after exgelb, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
write (iout, '("element block id = ", i2,/
|
||
|
|
1 "element type = ", a9,/
|
||
|
|
2 "num_elem_in_block = ", i2,/
|
||
|
|
3 "num_nodes_per_elem = ", i2,/
|
||
|
|
4 "num_attr = ", i2)')
|
||
|
|
5 ids(i), eltype(i), num_elem_in_block(i),
|
||
|
|
6 num_nodes_per_elem(i), num_attr(i)
|
||
|
|
|
||
|
|
40 continue
|
||
|
|
|
||
|
|
c read element connectivity
|
||
|
|
|
||
|
|
do 60 i = 1, num_elem_blk
|
||
|
|
|
||
|
|
call exgelc (exoid, ids(i), connect, ierr)
|
||
|
|
write (iout, '(/"after exgelc, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
if (eltype(i) .eq. 'nsided' .or. eltype(i) .eq. 'NSIDED') then
|
||
|
|
call exgecpp(exoid, EXEBLK, ids(i), nnpe, ierr)
|
||
|
|
write (iout, '(/"after exgecpp, error = ", i3)' ) ierr
|
||
|
|
|
||
|
|
write (iout, '("connect array for elem block ", i2)') ids(i)
|
||
|
|
|
||
|
|
ioff = 0
|
||
|
|
do j = 1, num_elem_in_block(i)
|
||
|
|
write (iout, 100) j, nnpe(j), (connect(ioff+k),k=1,nnpe(j))
|
||
|
|
ioff = ioff + nnpe(j)
|
||
|
|
end do
|
||
|
|
|
||
|
|
end if
|
||
|
|
60 continue
|
||
|
|
|
||
|
|
C ... Test coordinate frames
|
||
|
|
call getfrm(exoid)
|
||
|
|
|
||
|
|
call exclos (exoid, ierr)
|
||
|
|
write (iout, '(/"after exclos, error = ", i3)' ) ierr
|
||
|
|
100 format(' Element ',I3,', Nodes/Element = ',I3,' -- ',20I3)
|
||
|
|
stop
|
||
|
|
end
|
||
|
|
|
||
|
|
subroutine getfrm(exoid)
|
||
|
|
implicit none
|
||
|
|
include 'exodusII.inc'
|
||
|
|
|
||
|
|
integer iout
|
||
|
|
|
||
|
|
integer exoid, ierr, i, j
|
||
|
|
integer numfrm; ! Assumed to be 3 for remaining dimensions
|
||
|
|
integer cfids(3), tags(3)
|
||
|
|
character*32 ctag
|
||
|
|
real coord(27)
|
||
|
|
|
||
|
|
data iout /6/
|
||
|
|
|
||
|
|
numfrm = exinqi(exoid, EXNCF)
|
||
|
|
write (iout,
|
||
|
|
1 '(/"There are ",i2," coordinate frames")')
|
||
|
|
2 numfrm
|
||
|
|
|
||
|
|
numfrm = 3
|
||
|
|
call exgfrm(exoid, numfrm, cfids, coord, tags, ierr);
|
||
|
|
write (6,'("after exgfrm, error = ", i4)') ierr
|
||
|
|
|
||
|
|
! NOTE: These values may not be sensical; just used for testing.
|
||
|
|
do i=0,2
|
||
|
|
if (tags(i+1) .eq. EXCFREC) then
|
||
|
|
ctag = 'RECTANGULAR'
|
||
|
|
else if (tags(i+1) .eq. EXCFCYL) then
|
||
|
|
ctag = 'CYLINDRICAL'
|
||
|
|
else if (tags(i+1) .eq. EXCFSPH) then
|
||
|
|
ctag = 'SPHERICAL'
|
||
|
|
end if
|
||
|
|
|
||
|
|
write (iout, 100) cfids(i+1), ctag, (COORD(9*i+j),j=1,9)
|
||
|
|
end do
|
||
|
|
|
||
|
|
100 format(i5, 3x, A, 9F10.2)
|
||
|
|
return
|
||
|
|
end
|