lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
4 Commits
1 Branch
0 Tags
19 MiB
Tag: Branch: Tree: 77bd7563eb
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '77bd7563eb'
${ noResults }
EXODUS/packages/seacas/libraries/exodus_for/test/testwt1.f

986 lines
26 KiB
Raw Normal View History Unescape

Initial commit
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 testwt1
c This is a test program for the Fortran binding of the EXODUS II
c database write routines.
c history -
c Original L.A. Schoof
c 02/25/93 V.R. Yarberry - Added error checks for file creation.
c 03/04/93 V.R. Yarberry - Fixed bug in expvtt test, ebids was not passed
c 08/31/93 VRY - updated to match API version 2.00
include 'exodusII.inc'
integer iin, iout
integer exoid, num_dim, num_nodes, num_elem, num_elem_blk
integer num_elem_in_block(10), num_nodes_per_elem(10),numattr(10)
integer num_node_sets, num_side_sets
integer i, j, k, m, elem_map(10), node_map(100), connect(10)
integer node_list(100), elem_list(100), side_list(100)
integer ebids(10),ids(10), num_nodes_per_set(10)
integer num_elem_per_set(10), num_df_per_set(10)
integer df_ind(10), node_ind(10), elem_ind(10)
integer num_qa_rec, num_info
integer num_glo_vars, num_nod_vars, num_ele_vars
integer truth_tab(3,7)
integer whole_time_step, num_time_steps
integer cpu_word_size, io_word_size
integer prop_array(2)
real glob_var_vals(100), nodal_var_vals(100)
real time_value, elem_var_vals(100)
real x(100), y(100), z(100)
real attrib(100), dist_fact(100)
character*(MXSTLN) coord_names(3)
character*(MXSTLN) cname
character*(MXSTLN) var_names(3)
character*(MXSTLN) qa_record(4,2)
character*(MXLNLN) inform(3)
character*(MXSTLN) prop_names(2)
character*(MXSTLN) attrib_names(3)
character*(MXSTLN) blk_names(7)
data iin /5/, iout /6/
cpu_word_size = 0
io_word_size = 0
c create EXODUS II files
exoid = excre ("test.exo",
1 EXCLOB, cpu_word_size, io_word_size, ierr)
write (iout,'("after excre for test.exo, id: ", i4)') exoid
write (iout,'(" cpu word size: ",i4," io word size: ",i4)')
1 cpu_word_size, io_word_size
write (iout,'("after excre, error = ", i4)') ierr
c initialize file with parameters
num_dim = 3
num_nodes = 28
num_elem = 8
num_elem_blk = 7
num_node_sets = 2
num_side_sets = 5
c Uncomment the following line to test NULL side sets
c num_side_sets = 6
call expini (exoid, "This is testwt1", num_dim, num_nodes,
1 num_elem, num_elem_blk, num_node_sets,
2 num_side_sets, ierr)
write (iout, '("after expini, error = ", i4)' ) ierr
c write nodal coordinates values and names to database
c Quad #1
x(1) = 0.0
x(2) = 1.0
x(3) = 1.0
x(4) = 0.0
y(1) = 0.0
y(2) = 0.0
y(3) = 1.0
y(4) = 1.0
z(1) = 0.0
z(2) = 0.0
z(3) = 0.0
z(4) = 0.0
c Quad #2
x(5) = 1.0
x(6) = 2.0
x(7) = 2.0
x(8) = 1.0
y(5) = 0.0
y(6) = 0.0
y(7) = 1.0
y(8) = 1.0
z(5) = 0.0
z(6) = 0.0
z(7) = 0.0
z(8) = 0.0
c Hex #1
x(9) = 0.0
x(10) = 10.0
x(11) = 10.0
x(12) = 1.0
x(13) = 1.0
x(14) = 10.0
x(15) = 10.0
x(16) = 1.0
y(9) = 0.0
y(10) = 0.0
y(11) = 0.0
y(12) = 0.0
y(13) = 10.0
y(14) = 10.0
y(15) = 10.0
y(16) = 10.0
z(9) = 0.0
z(10) = 0.0
z(11) =-10.0
z(12) =-10.0
z(13) = 0.0
z(14) = 0.0
z(15) =-10.0
z(16) =-10.0
c Tetra #1
x(17) = 0.0
x(18) = 1.0
x(19) = 10.0
x(20) = 7.0
y(17) = 0.0
y(18) = 0.0
y(19) = 0.0
y(20) = 5.0
z(17) = 0.0
z(18) = 5.0
z(19) = 2.0
z(20) = 3.0
c Circle #1
x(21) = 100.0
y(21) = 100.0
z(21) = 0.0
c Sphere #1
x(22) = 50.0
y(22) = 50.0
z(22) = 20.0
c Wedge #1
x(23) = 3.0
x(24) = 6.0
x(25) = 0.0
x(26) = 3.0
x(27) = 6.0
x(28) = 0.0
y(23) = 0.0
y(24) = 0.0
y(25) = 0.0
y(26) = 2.0
y(27) = 2.0
y(28) = 2.0
z(23) = 6.0
z(24) = 0.0
z(25) = 0.0
z(26) = 6.0
z(27) = 2.0
z(28) = 0.0
call expcor (exoid, x, y, z, ierr)
write (iout, '("after expcor, error = ", i4)' ) ierr
coord_names(1) = "xcoor"
coord_names(2) = "ycoor"
coord_names(3) = "zcoor"
call expcon (exoid, coord_names, ierr)
write (iout, '("after expcon, error = ", i4)' ) ierr
c write node and element map parameters
n_node_maps = 1
n_elem_maps = 2
call expmp (exoid, n_node_maps, n_elem_maps, ierr)
write (iout, '("after expmp, error = ", i4)' ) ierr
c write element map properties
prop_names(1) = "ORDER"
prop_names(2) = "NUMBER"
call exppn(exoid,EXEMAP,2,prop_names,ierr)
write (iout, '("after exppn, error = ", i4)' ) ierr
c write element order map
do 10 i = 1, num_elem
elem_map(i) = i
10 continue
id = 111
call expem (exoid, id, elem_map, ierr)
write (iout, '("after expem, error = ", i4)' ) ierr
call expp(exoid, EXEMAP, id, "ORDER", 1, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
c write element numbering map
id = 222
C write map an element at a time...
do 11 i = 1, num_elem
elem_map(i) = i*2
call exppem (exoid, id, i, 1, elem_map(i), ierr)
write (iout, '("after exppem, error = ", i4)' ) ierr
11 continue
call expp(exoid, EXEMAP, id, "NUMBER", 1, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
c write node map properties
prop_names(1) = "NUMBER"
call exppn(exoid,EXNMAP,1,prop_names,ierr)
write (iout, '("after exppn, error = ", i4)' ) ierr
c write node numbering map
do 13 i = 1, num_nodes
node_map(i) = i*3
13 continue
id = 333
call expnm (exoid, id, node_map, ierr)
write (iout, '("after expnm, error = ", i4)' ) ierr
call expp(exoid, EXNMAP, id, "NUMBER", 1, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
c write element block parameters
num_elem_in_block(1) = 1
num_elem_in_block(2) = 2
num_elem_in_block(3) = 1
num_elem_in_block(4) = 1
num_elem_in_block(5) = 1
num_elem_in_block(6) = 1
num_elem_in_block(7) = 1
num_nodes_per_elem(1) = 4
num_nodes_per_elem(2) = 4
num_nodes_per_elem(3) = 8
num_nodes_per_elem(4) = 4
num_nodes_per_elem(5) = 1
num_nodes_per_elem(6) = 1
num_nodes_per_elem(7) = 6
ebids(1) = 10
ebids(2) = 11
ebids(3) = 12
ebids(4) = 13
ebids(5) = 14
ebids(6) = 15
ebids(7) = 16
numattr(1) = 3
numattr(2) = 3
numattr(3) = 3
numattr(4) = 3
numattr(5) = 3
numattr(6) = 3
numattr(7) = 3
blk_names(1) = "e_block_i"
blk_names(2) = "e_block_ii"
blk_names(3) = "e_block_iii"
blk_names(4) = "e_block_iv"
blk_names(5) = "e_block_v"
blk_names(6) = "e_block_vi"
blk_names(7) = "e_block_vii"
cname = "quad"
call expelb (exoid,ebids(1),cname,num_elem_in_block(1),
1 num_nodes_per_elem(1),numattr(1),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(1),blk_names(1), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
call expelb (exoid,ebids(2),cname,num_elem_in_block(2),
1 num_nodes_per_elem(2),numattr(2),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(2),blk_names(2), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
cname = "hex"
call expelb (exoid,ebids(3),cname,num_elem_in_block(3),
1 num_nodes_per_elem(3),numattr(3),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(3),blk_names(3), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
cname = "tetra"
call expelb (exoid,ebids(4),cname,num_elem_in_block(4),
1 num_nodes_per_elem(4),numattr(4),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(4),blk_names(4), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
cname = "circle"
call expelb (exoid,ebids(5),cname,num_elem_in_block(5),
1 num_nodes_per_elem(5),numattr(5),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(5),blk_names(5), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
cname = "sphere"
call expelb (exoid,ebids(6),cname,num_elem_in_block(6),
1 num_nodes_per_elem(6),numattr(6),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(6),blk_names(6), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
cname = "wedge"
call expelb (exoid,ebids(7),cname,num_elem_in_block(7),
1 num_nodes_per_elem(7),numattr(7),ierr)
write (iout, '("after expelb, error = ", i4)' ) ierr
call expnam (exoid,EXEBLK,ebids(7),blk_names(7), ierr)
write (iout, '("after expnam, error = ", i4)' ) ierr
c write element block properties
prop_names(1) = "MATL"
prop_names(2) = "DENSITY"
call exppn(exoid,EXEBLK,2,prop_names,ierr)
write (iout, '("after exppn, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(1), "MATL", 10, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(2), "MATL", 20, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(3), "MATL", 30, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(4), "MATL", 40, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(5), "MATL", 50, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(6), "MATL", 60, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXEBLK, ebids(7), "MATL", 70, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
c write element connectivity
connect(1) = 1
connect(2) = 2
connect(3) = 3
connect(4) = 4
call expelc (exoid, ebids(1), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 1
connect(2) = 2
connect(3) = 3
connect(4) = 4
connect(5) = 5
connect(6) = 6
connect(7) = 7
connect(8) = 8
call expelc (exoid, ebids(2), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 9
connect(2) = 10
connect(3) = 11
connect(4) = 12
connect(5) = 13
connect(6) = 14
connect(7) = 15
connect(8) = 16
call expelc (exoid, ebids(3), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 17
connect(2) = 18
connect(3) = 19
connect(4) = 20
call expelc (exoid, ebids(4), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 21
call expelc (exoid, ebids(5), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 22
call expelc (exoid, ebids(6), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
connect(1) = 23
connect(2) = 24
connect(3) = 25
connect(4) = 26
connect(5) = 27
connect(6) = 28
call expelc (exoid, ebids(7), connect, ierr)
write (iout, '("after expelc, error = ", i4)' ) ierr
c write element block attributes
attrib(1) = 1.0 ! block 1
attrib(2) = 2.0
attrib(3) = 3.0
attrib(4) = 1.11 ! block 2, element 1
attrib(5) = 2.11
attrib(6) = 3.11
attrib(7) = 1.12 ! block 2, element 2
attrib(8) = 2.12
attrib(9) = 3.12
attrib(10) = 1.2 ! block 3
attrib(11) = 2.2
attrib(12) = 3.2
attrib(13) = 1.3 ! block 4
attrib(14) = 2.3
attrib(15) = 3.3
attrib(16) = 1.4 ! block 5
attrib(17) = 2.4
attrib(18) = 3.4
attrib(19) = 1.5 ! block 6
attrib(20) = 2.5
attrib(21) = 3.5
attrib(22) = 1.6 ! block 7
attrib(23) = 2.6
attrib(24) = 3.6
call expeat (exoid, ebids(1), attrib(1), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(2), attrib(4), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(3), attrib(10), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(4), attrib(13), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(5), attrib(16), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(6), attrib(19), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
call expeat (exoid, ebids(7), attrib(22), ierr)
write (iout, '("after expeat, error = ", i4)' ) ierr
attrib_names(1) = "attribute_1"
attrib_names(2) = "attribute_2"
attrib_names(3) = "attribute_3"
do i=1, num_elem_blk
call expean (exoid, ebids(i), numattr(i), attrib_names, ierr)
write (iout, '("after expean, error = ", i4)' ) ierr
end do
c write individual node sets
node_list(1) = 100
node_list(2) = 101
node_list(3) = 102
node_list(4) = 103
node_list(5) = 104
dist_fact(1) = 1.0
dist_fact(2) = 2.0
dist_fact(3) = 3.0
dist_fact(4) = 4.0
dist_fact(5) = 5.0
c call expnp (exoid, 20, 5, 5, ierr)
c write (iout, '("after expnp, error = ", i4)' ) ierr
c call expns (exoid, 20, node_list, ierr)
c write (iout, '("after expns, error = ", i4)' ) ierr
c call expnsd (exoid, 20, dist_fact, ierr)
c write (iout, '("after expnsd, error = ", i4)' ) ierr
node_list(1) = 200
node_list(2) = 201
node_list(3) = 202
dist_fact(1) = 1.1
dist_fact(2) = 2.1
dist_fact(3) = 3.1
c call expnp (exoid, 21, 3, 3, ierr)
c write (iout, '("after expnp, error = ", i4)' ) ierr
c call expns (exoid, 21, node_list, ierr)
c write (iout, '("after expns, error = ", i4)' ) ierr
c call expnsd (exoid, 21, dist_fact, ierr)
c write (iout, '("after expnsd, error = ", i4)' ) ierr
c write concatenated node sets; this produces the same information as
c the above code which writes individual node sets
ids(1) = 20
ids(2) = 21
num_nodes_per_set(1) = 5
num_nodes_per_set(2) = 3
num_df_per_set(1) = 5
num_df_per_set(2) = 3
node_ind(1) = 1
node_ind(2) = 6
df_ind(1) = 1
df_ind(2) = 6
node_list(1) = 100
node_list(2) = 101
node_list(3) = 102
node_list(4) = 103
node_list(5) = 104
node_list(6) = 200
node_list(7) = 201
node_list(8) = 202
dist_fact(1) = 1.0
dist_fact(2) = 2.0
dist_fact(3) = 3.0
dist_fact(4) = 4.0
dist_fact(5) = 5.0
dist_fact(6) = 1.1
dist_fact(7) = 2.1
dist_fact(8) = 3.1
call expcns (exoid, ids, num_nodes_per_set, num_df_per_set,
1 node_ind, df_ind, node_list, dist_fact, ierr)
write (iout, '("after expcns, error = ", i4)' ) ierr
c write node set properties
prop_names(1) = "FACE"
call expp(exoid, EXNSET, 20, prop_names(1), 4, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXNSET, 21, prop_names(1), 5, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
prop_array(1) = 1000
prop_array(2) = 2000
prop_names(1) = "VELOCITY"
call exppa(exoid, EXNSET, prop_names(1), prop_array, ierr)
write (iout, '("after exppa, error = ", i4)' ) ierr
c write individual side sets
elem_list(1) = 11
elem_list(2) = 12
side_list(1) = 1
side_list(2) = 2
dist_fact(1) = 30.0
dist_fact(2) = 30.1
dist_fact(3) = 30.2
dist_fact(4) = 30.3
c call expsp (exoid, 30, 2, 4, ierr)
c write (iout, '("after expsp, error = ", i4)' ) ierr
c call expss (exoid, 30, elem_list, side_list, ierr)
c write (iout, '("after expss, error = ", i4)' ) ierr
c call expssd (exoid, 30, dist_fact, ierr)
c write (iout, '("after expssd, error = ", i4)' ) ierr
elem_list(1) = 13
elem_list(2) = 14
side_list(1) = 3
side_list(2) = 4
dist_fact(1) = 31.0
dist_fact(2) = 31.1
dist_fact(3) = 31.2
dist_fact(4) = 31.3
c call expsp (exoid, 31, 2, 4, ierr)
c write (iout, '("after expsp, error = ", i4)' ) ierr
c call expss (exoid, 31, elem_list, side_list, ierr)
c write (iout, '("after expss, error = ", i4)' ) ierr
c call expssd (exoid, 31, dist_fact, ierr)
c write (iout, '("after expssd, error = ", i4)' ) ierr
c write concatenated side sets; this produces the same information as
c the above code which writes individual side sets
ids(1) = 30
ids(2) = 31
ids(3) = 32
ids(4) = 33
ids(5) = 34
ids(6) = 35
c side set #1 - quad
node_list(1) = 8
node_list(2) = 5
node_list(3) = 6
node_list(4) = 7
c side set #2 - quad/hex, spanning 2 element types
node_list(5) = 2
node_list(6) = 3
node_list(7) = 7
node_list(8) = 8
c side set #3 - hex
node_list(9) = 9
node_list(10) = 12
node_list(11) = 11
node_list(12) = 10
node_list(13) = 11
node_list(14) = 12
node_list(15) = 16
node_list(16) = 15
node_list(17) = 16
node_list(18) = 15
node_list(19) = 11
node_list(20) = 12
node_list(21) = 10
node_list(22) = 11
node_list(23) = 15
node_list(24) = 14
node_list(25) = 13
node_list(26) = 16
node_list(27) = 12
node_list(28) = 9
node_list(29) = 14
node_list(30) = 13
node_list(31) = 9
node_list(32) = 10
node_list(33) = 16
node_list(34) = 13
node_list(35) = 14
node_list(36) = 15
c side set #4 - Tetra
node_list(37) = 17
node_list(38) = 18
node_list(39) = 20
node_list(40) = 18
node_list(41) = 19
node_list(42) = 20
node_list(43) = 20
node_list(44) = 19
node_list(45) = 17
node_list(46) = 19
node_list(47) = 18
node_list(48) = 17
c side set #5 - Circle/Sphere
node_list(49) = 21
node_list(50) = 22
c side set #6 - Wedges
node_list(51) = 27
node_list(52) = 26
node_list(53) = 23
node_list(54) = 24
node_list(55) = 28
node_list(56) = 27
node_list(57) = 24
node_list(58) = 25
node_list(59) = 28
node_list(60) = 25
node_list(61) = 23
node_list(62) = 26
node_list(63) = 25
node_list(64) = 24
node_list(65) = 23
node_list(66) = 26
node_list(67) = 27
node_list(68) = 28
num_elem_per_set(1) = 2
num_elem_per_set(2) = 2
num_elem_per_set(3) = 7
num_elem_per_set(4) = 4
num_elem_per_set(5) = 2
num_elem_per_set(6) = 5
c Uncomment following line to test NULL side sets
c num_elem_per_set(6) = 0
num_nodes_per_set(1) = 4
num_nodes_per_set(2) = 4
num_nodes_per_set(3) = 28
num_nodes_per_set(4) = 12
num_nodes_per_set(5) = 2
num_nodes_per_set(6) = 18
elem_ind(1) = 1
elem_ind(2) = 3
elem_ind(3) = 5
elem_ind(4) = 12
elem_ind(5) = 16
elem_ind(6) = 18
node_ind(1) = 1
node_ind(2) = 5
node_ind(3) = 9
node_ind(4) = 37
node_ind(5) = 48
node_ind(6) = 50
elem_list(1) = 3
elem_list(2) = 3
elem_list(3) = 1
elem_list(4) = 3
elem_list(5) = 4
elem_list(6) = 4
elem_list(7) = 4
elem_list(8) = 4
elem_list(9) = 4
elem_list(10) = 4
elem_list(11) = 4
elem_list(12) = 5
elem_list(13) = 5
elem_list(14) = 5
elem_list(15) = 5
elem_list(16) = 6
elem_list(17) = 7
elem_list(18) = 8
elem_list(19) = 8
elem_list(20) = 8
elem_list(21) = 8
elem_list(22) = 8
c side_list(1) = 1
c side_list(2) = 2
c side_list(3) = 3
c side_list(4) = 4
call excn2s(exoid, num_elem_per_set, num_nodes_per_set, elem_ind,
1 node_ind, elem_list, node_list, side_list, ierr)
write (iout, '("after excn2s, error = ", i4)' ) ierr
num_df_per_set(1) = 4
num_df_per_set(2) = 4
num_df_per_set(3) = 0
num_df_per_set(4) = 0
num_df_per_set(5) = 0
num_df_per_set(6) = 0
df_ind(1) = 1
df_ind(2) = 5
df_ind(3) = 9
df_ind(4) = 9
df_ind(5) = 9
df_ind(6) = 9
dist_fact(1) = 30.0
dist_fact(2) = 30.1
dist_fact(3) = 30.2
dist_fact(4) = 30.3
dist_fact(5) = 31.0
dist_fact(6) = 31.1
dist_fact(7) = 31.2
dist_fact(8) = 31.3
call expcss (exoid, ids, num_elem_per_set, num_df_per_set,
1 elem_ind, df_ind, elem_list, side_list, dist_fact,
2 ierr)
write (iout, '("after expcss, error = ", i4)' ) ierr
prop_names(1) = "COLOR"
call expp(exoid, EXSSET, 30, prop_names(1), 100, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
call expp(exoid, EXSSET, 31, prop_names(1), 101, ierr)
write (iout, '("after expp, error = ", i4)' ) ierr
c write QA records
num_qa_rec = 2
qa_record(1,1) = "TESTWT1 fortran version"
qa_record(2,1) = "testwt1"
qa_record(3,1) = "03/16/94"
qa_record(4,1) = "15:41:33"
qa_record(1,2) = "FASTQ"
qa_record(2,2) = "fastq"
qa_record(3,2) = "07/07/93"
qa_record(4,2) = "16:41:33"
call expqa (exoid, num_qa_rec, qa_record, ierr)
write (iout, '("after expqa, error = ", i4)' ) ierr
c write information records
num_info = 3
inform(1) = "This is the first information record."
inform(2) = "This is the second information record."
inform(3) = "This is the third information record."
call expinf (exoid, num_info, inform, ierr)
write (iout, '("after expinf, error = ", i4)' ) ierr
c write results variables parameters and names
num_glo_vars = 1
var_names(1) = "glo vars"
call expvp (exoid, "g", num_glo_vars, ierr)
write (iout, '("after expvp, error = ", i4)' ) ierr
call expvnm (exoid, "g", 1, var_names(1), ierr)
write (iout, '("after expvan, error = ", i4)' ) ierr
num_nod_vars = 2
var_names(1) = "nod_var0"
var_names(2) = "nod_var1"
call expvp (exoid, "n", num_nod_vars, ierr)
write (iout, '("after expvp, error = ", i4)' ) ierr
call expvan (exoid, "n", num_nod_vars, var_names, ierr)
write (iout, '("after expvan, error = ", i4)' ) ierr
num_ele_vars = 3
var_names(1) = "ele_var0"
var_names(2) = "ele_var1"
var_names(3) = "ele_var2"
call expvp (exoid, "e", num_ele_vars, ierr)
write (iout, '("after expvp, error = ", i4)' ) ierr
call expvan (exoid, "e", num_ele_vars, var_names, ierr)
write (iout, '("after expvan, error = ", i4)' ) ierr
c write element variable truth table
k = 0
do 30 i = 1,num_elem_blk
do 20 j = 1,num_ele_vars
truth_tab(j,i) = 1
20 continue
30 continue
truth_tab(1,3) = 0
c call expvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ierr)
c write (iout, '("after expvtt, error = ", i4)' ) ierr
c for each time step, write the analysis results;
c the code below fills the arrays glob_var_vals,
c nodal_var_vals, and elem_var_vals with values for debugging purposes;
c obviously the analysis code will populate these arrays
whole_time_step = 1
num_time_steps = 10
do 110 i = 1, num_time_steps
time_value = real(i)/100.
c write time value
call exptim (exoid, whole_time_step, time_value, ierr)
write (iout, '("after exptim, error = ", i4)' ) ierr
c write global variables
do 50 j = 1, num_glo_vars
glob_var_vals(j) = real(j+1) * time_value
50 continue
call expgv (exoid, whole_time_step, num_glo_vars,
1 glob_var_vals, ierr)
write (iout, '("after expgv, error = ", i4)' ) ierr
c write nodal variables
do 70 k = 1, num_nod_vars
do 60 j = 1, num_nodes
nodal_var_vals(j) = real(k) + (real(j) * time_value)
60 continue
call expnv (exoid, whole_time_step, k, num_nodes,
1 nodal_var_vals, ierr)
write (iout, '("after expnv, error = ", i4)' ) ierr
70 continue
c write element variables
do 100 k = 1, num_ele_vars
do 90 j = 1, num_elem_blk
do 80 m = 1, num_elem_in_block(j)
elem_var_vals(m) = real(k+1) + real(j+1) +
1 (real(m)*time_value)
c write(iout,*)'elem_var_val(',m,'): ',elem_var_vals(m)
80 continue
if (k .eq. 1 .and. j .eq. 3) then
continue ! skip element block 3, variable 1
else
call expev (exoid, whole_time_step, k, ebids(j),
1 num_elem_in_block(j), elem_var_vals, ierr)
write (iout, '("after expev, error = ", i4)' ) ierr
endif
90 continue
100 continue
whole_time_step = whole_time_step + 1
c update the data file; this should be done at the end of every time
c step to ensure that no data is lost if the analysis dies
call exupda (exoid, ierr)
write (iout, '("after exupda, error = ", i4)' ) ierr
110 continue
c close the EXODUS files
call exclos (exoid, ierr)
write (iout, '("after exclos, error = ", i4)' ) ierr
stop
end