Exodus 7.21

/exodus_for/test/testrd_nsid.f
1 C Copyright (c) 2005-2017 National Technology & Engineering Solutions
2 C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
3 C NTESS, the U.S. Government retains certain rights in this software.
4 C
5 C Redistribution and use in source and binary forms, with or without
6 C modification, are permitted provided that the following conditions are
7 C met:
8 C
9 C * Redistributions of source code must retain the above copyright
10 C notice, this list of conditions and the following disclaimer.
11 C
12 C * Redistributions in binary form must reproduce the above
13 C copyright notice, this list of conditions and the following
14 C disclaimer in the documentation and/or other materials provided
15 C with the distribution.
16 C
17 C * Neither the name of NTESS nor the names of its
18 C contributors may be used to endorse or promote products derived
19 C from this software without specific prior written permission.
20 C
21 C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 C
33
34 program testrd
35
36 c
37 c This is a test program for the Fortran binding of the EXODUS II
38 c database read routines
39 c
40 c 09/07/93 V.R. Yarberry - Modified for API 2.00
41 implicit none
42
43 include 'exodusII.inc'
44
45 integer iin, iout, ierr, ioff
46 integer exoid, num_dim, num_nodes, num_elem, num_elem_blk
47 integer num_node_sets
48 integer num_side_sets
49 integer i, j, k, elem_map(100), connect(100), nnpe(10)
50 integer ids(10)
51 integer num_elem_in_block(10), num_nodes_per_elem(10)
52 integer num_attr(10)
53 integer cpu_ws,io_ws, mod_sz
54
55 real x(100), y(100), z(100)
56 real vers
57
58 character*(MXSTLN) coord_names(3)
59 character*(MXLNLN) titl
60 character*(MXSTLN) eltype(10)
61
62 data iin /5/, iout /6/
63
64
65 c
66 c open EXODUS II files
67 c
68
69 cpu_ws = 0
70 io_ws = 0
71
72 exoid = exopen("test-nsided.exo", exread, cpu_ws, io_ws,
73 * vers, ierr)
74 write (iout, '(/"after exopen, error = ",i3)')
75 1 ierr
76
77 write (iout, '("test-nsided.exo is an EXODUSII file; version ",
78 1 f4.2)') vers
79 write (iout, '(" I/O word size",i2)') io_ws
80
81 mod_sz = exlgmd(exoid)
82 write (iout, '(" Model Size",i2)') mod_sz
83
84 c
85 c read database parameters
86 c
87
88 call exgini (exoid, titl, num_dim, num_nodes, num_elem,
89 1 num_elem_blk, num_node_sets, num_side_sets, ierr)
90 write (iout, '(/"after exgini, error = ", i3)' ) ierr
91
92 write (iout, '("database parameters:"/
93 1 "title = ", a81 /
94 2 "num_dim = ", i3 /
95 3 "num_nodes = ", i3 /
96 4 "num_elem = ", i3 /
97 5 "num_elem_blk = ", i3 /
98 6 "num_node_sets = ", i3 /
99 7 "num_side_sets = ", i3)')
100 8 titl,num_dim, num_nodes, num_elem,
101 9 num_elem_blk,num_node_sets, num_side_sets
102
103
104 c
105 c read nodal coordinates values and names from database
106 c
107
108 call exgcor (exoid, x, y, z, ierr)
109 write (iout, '(/"after exgcor, error = ", i3)' ) ierr
110
111 write (iout, '("x coords = ")')
112 do 10 i = 1, num_nodes
113 write (iout, '(f5.1)') x(i)
114 10 continue
115
116 write (iout, '("y coords = ")')
117 do 20 i = 1, num_nodes
118 write (iout, '(f5.1)') y(i)
119 20 continue
120
121 if (num_dim .gt. 2) then
122 write (iout, '("z coords = ")')
123 do 22 i = 1, num_nodes
124 write (iout, '(f5.1)') z(i)
125 22 continue
126 endif
127
128 call exgcon (exoid, coord_names, ierr)
129 write (iout, '(/"after exgcon, error = ", i3)' ) ierr
130
131 write (iout, '("x coord name = ", a9)') coord_names(1)
132 write (iout, '("y coord name = ", a9)') coord_names(2)
133
134 c
135 c read element order map
136 c
137
138 call exgmap (exoid, elem_map, ierr)
139 write (iout, '(/"after exgmap, error = ", i3)' ) ierr
140
141 do 30 i = 1, num_elem
142 write (iout, '("elem_map(",i1,") = ", i1)') i, elem_map(i)
143 30 continue
144
145 c
146 c read element block parameters
147 c
148 c
149 call exgebi (exoid, ids, ierr)
150 write (iout, '(/"after exgebi, error = ", i3)' ) ierr
151
152 do 40 i = 1, num_elem_blk
153
154 call exgelb (exoid, ids(i), eltype(i), num_elem_in_block(i),
155 1 num_nodes_per_elem(i), num_attr(i), ierr)
156 write (iout, '(/"after exgelb, error = ", i3)' ) ierr
157
158 write (iout, '("element block id = ", i2,/
159 1 "element type = ", a9,/
160 2 "num_elem_in_block = ", i2,/
161 3 "num_nodes_per_elem = ", i2,/
162 4 "num_attr = ", i2)')
163 5 ids(i), eltype(i), num_elem_in_block(i),
164 6 num_nodes_per_elem(i), num_attr(i)
165
166 40 continue
167
168 c
169 c read element connectivity
170 c
171
172 do 60 i = 1, num_elem_blk
173
174 call exgelc (exoid, ids(i), connect, ierr)
175 write (iout, '(/"after exgelc, error = ", i3)' ) ierr
176
177 if (eltype(i) .eq. 'nsided' .or. eltype(i) .eq. 'NSIDED') then
178 call exgecpp(exoid, exeblk, ids(i), nnpe, ierr)
179 write (iout, '(/"after exgecpp, error = ", i3)' ) ierr
180
181 write (iout, '("connect array for elem block ", i2)') ids(i)
182
183 ioff = 0
184 do j = 1, num_elem_in_block(i)
185 write (iout, 100) j, nnpe(j), (connect(ioff+k),k=1,nnpe(j))
186 ioff = ioff + nnpe(j)
187 end do
188
189 end if
190 60 continue
191
192 C ... Test coordinate frames
193 call getfrm(exoid)
194
195 call exclos (exoid, ierr)
196 write (iout, '(/"after exclos, error = ", i3)' ) ierr
197 100 format(' Element ',i3,', Nodes/Element = ',i3,' -- ',20i3)
198 stop
199 end
200
201 subroutine getfrm(exoid)
202 implicit none
203 include 'exodusII.inc'
204
205 integer iout
206
207 integer exoid, ierr, i, j
208 integer numfrm; ! Assumed to be 3 for remaining dimensions
209 integer cfids(3), tags(3)
210 character*32 ctag
211 real coord(27)
212
213 data iout /6/
214
215 numfrm = exinqi(exoid, exncf)
216 write (iout,
217 1 '(/"There are ",i2," coordinate frames")')
218 2 numfrm
219
220 numfrm = 3
221 call exgfrm(exoid, numfrm, cfids, coord, tags, ierr);
222 write (6,'("after exgfrm, error = ", i4)') ierr
223
224 ! NOTE: These values may not be sensical; just used for testing.
225 do i=0,2
226 if (tags(i+1) .eq. excfrec) then
227 ctag = 'RECTANGULAR'
228 else if (tags(i+1) .eq. excfcyl) then
229 ctag = 'CYLINDRICAL'
230 else if (tags(i+1) .eq. excfsph) then
231 ctag = 'SPHERICAL'
232 end if
233
234 write (iout, 100) cfids(i+1), ctag, (coord(9*i+j),j=1,9)
235 end do
236
237 100 format(i5, 3x, a, 9f10.2)
238 return
239 end