Exodus 7.21

/exodus_for/test/testrdd.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 testrdd
35
36 c
37 c This is a test program for the Fortran binding of the EXODUS II
38 c database read routines with double precision
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
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, elem_map(2), connect(4), node_list(10)
50 integer elem_list(10), side_list(10), ids(5)
51 integer num_elem_per_set(2), num_nodes_per_set(2)
52 integer num_df_per_set(2)
53 integer num_df_in_set, num_sides_in_set
54 integer df_ind(2), node_ind(2), elem_ind(2), num_qa_rec, num_info
55 integer num_glo_vars, num_nod_vars, num_ele_vars
56 integer truth_tab(3,2)
57 integer num_time_steps
58 integer num_elem_in_block(2), num_nodes_per_elem(2)
59 integer num_attr(2)
60 integer num_nodes_in_set, num_elem_in_set
61 integer df_list_len, list_len, elem_list_len
62 integer node_num, time_step, var_index, beg_time, end_time
63 integer elem_num
64 integer cpu_ws,io_ws
65 integer num_props, prop_value
66
67 real*8 time_value, time_values(10), var_values(10)
68 real*8 x(8), y(8), dummy(1)
69 real*8 attrib(1), dist_fact(8)
70 real*8 vers
71
72 character*(MXSTLN) coord_names(3), qa_record(4,2), var_names(3)
73 character*(MXLNLN) inform(3), titl
74 character typ*(MXSTLN)
75 character*(MXSTLN) prop_names(3)
76
77 data iin /5/, iout /6/
78
79
80 c
81 c open EXODUS II files
82 c
83
84 cpu_ws = 8
85 io_ws = 0
86
87 exoid = exopen("test.exo", exread, cpu_ws, io_ws, vers, ierr)
88 write (iout, '(/"after exopen, error = ",i3)')
89 1 ierr
90
91 write (iout, '("test.exo is an EXODUSII file; version ",
92 1 f4.2)') vers
93 write (iout, '(" I/O word size",i2)') io_ws
94
95 c
96 c read database parameters
97 c
98
99 call exgini (exoid, titl, num_dim, num_nodes, num_elem,
100 1 num_elem_blk, num_node_sets, num_side_sets, ierr)
101 write (iout, '(/"after exgini, error = ", i3)' ) ierr
102
103 write (iout, '("database parameters:"/
104 1 "title = ", a81 /
105 2 "num_dim = ", i3 /
106 3 "num_nodes = ", i3 /
107 4 "num_elem = ", i3 /
108 5 "num_elem_blk = ", i3 /
109 6 "num_node_sets = ", i3 /
110 7 "num_side_sets = ", i3)')
111 8 titl,num_dim, num_nodes, num_elem,
112 9 num_elem_blk,num_node_sets, num_side_sets
113
114
115 c
116 c read nodal coordinates values and names from database
117 c
118
119 call exgcor (exoid, x, y, dummy, ierr)
120 write (iout, '(/"after exgcor, error = ", i3)' ) ierr
121
122 write (iout, '("x coords = ")')
123 do 10 i = 1, num_nodes
124 write (iout, '(f5.1)') x(i)
125 10 continue
126
127 write (iout, '("y coords = ")')
128 do 20 i = 1, num_nodes
129 write (iout, '(f5.1)') y(i)
130 20 continue
131
132 call exgcon (exoid, coord_names, ierr)
133 write (iout, '(/"after exgcon, error = ", i3)' ) ierr
134
135 write (iout, '("x coord name = ", a9)') coord_names(1)
136 write (iout, '("y coord name = ", a9)') coord_names(2)
137
138 c
139 c read element order map
140 c
141
142 call exgmap (exoid, elem_map, ierr)
143 write (iout, '(/"after exgmap, error = ", i3)' ) ierr
144
145 do 30 i = 1, num_elem
146 write (iout, '("elem_map(",i1,") = ", i1)') i, elem_map(i)
147 30 continue
148
149 c
150 c read element block parameters
151 c
152 c
153 call exgebi (exoid, ids, ierr)
154 write (iout, '(/"after exgebi, error = ", i3)' ) ierr
155
156 do 40 i = 1, num_elem_blk
157
158 call exgelb (exoid, ids(i), typ, num_elem_in_block(i),
159 1 num_nodes_per_elem(i), num_attr(i), ierr)
160 write (iout, '(/"after exgelb, error = ", i3)' ) ierr
161
162 write (iout, '("element block id = ", i2,/
163 1 "element type = ", a9,/
164 2 "num_elem_in_block = ", i2,/
165 3 "num_nodes_per_elem = ", i2,/
166 4 "num_attr = ", i2)')
167 5 ids(i), typ, num_elem_in_block(i),
168 6 num_nodes_per_elem(i), num_attr(i)
169
170 40 continue
171
172 c read element block properties */
173
174 num_props = exinqi(exoid, exnebp)
175 write (iout,
176 1 '(/"There are ",i2," properties for each element block")')
177 2 num_props
178
179
180 call exgpn(exoid, exeblk, prop_names, ierr)
181 write (iout, '("after exgpn, error = ", i3)' ) ierr
182
183 do 47 i = 1, num_props
184 do 45 j = 1, num_elem_blk
185 call exgp(exoid, exeblk,ids(j),prop_names(i),prop_value,ierr)
186 if (ierr .eq. 0) then
187 write( iout,
188 1 '("elem block ",i2," property(",i2,"): ",a," = ",i5)' )
189 2 j, i, prop_names(i), prop_value
190 else
191 write (iout, '(/"after exgp, error = ", i3)' ) ierr
192 endif
193 45 continue
194 47 continue
195
196 c
197 c read element connectivity
198 c
199
200 do 60 i = 1, num_elem_blk
201
202 call exgelc (exoid, ids(i), connect, ierr)
203 write (iout, '(/"after exgelc, error = ", i3)' ) ierr
204
205 write (iout, '("connect array for elem block ", i2)') ids(i)
206
207 do 50 j = 1, num_nodes_per_elem(i)
208 write (iout, '(i3)') connect(j)
209 50 continue
210
211 60 continue
212
213 c
214 c read element block attributes
215 c
216
217 do 70 i = 1, num_elem_blk
218
219 call exgeat (exoid, ids(i), attrib, ierr)
220 write (iout, '(/"after exgeat, error = ", i3)' ) ierr
221
222 write (iout, '("element block ", i2, " attributes = ", f6.4)')
223 1 ids(i), attrib
224
225 70 continue
226
227 c
228 c read individual node sets
229 c
230 if (num_node_sets .gt. 0) then
231 call exgnsi (exoid, ids, ierr)
232 write (iout, '(/"after exgnsi, error = ", i3)' ) ierr
233 endif
234
235 do 100 i = 1, num_node_sets
236
237 call exgnp (exoid, ids(i), num_nodes_in_set,
238 1 num_df_in_set, ierr)
239 write (iout, '(/"after exgnp, error = ", i3)' ) ierr
240
241 write (iout, '(/"node set ", i2, " parameters: ",/
242 2 "num_nodes = ", i2)') ids(i), num_nodes_in_set
243
244 call exgns (exoid, ids(i), node_list, ierr)
245 write (iout, '(/"after exgns, error = ", i3)' ) ierr
246 call exgnsd (exoid, ids(i), dist_fact, ierr)
247 write (iout, '(/"after exgnsd, error = ", i3)' ) ierr
248
249 write (iout, '(/"node list for node set ", i2)') ids(i)
250
251 do 80 j = 1, num_nodes_in_set
252 write (iout, '(i3)') node_list(j)
253 80 continue
254
255 write (iout, '("dist factors for node set ", i2)') ids(i)
256
257 do 90 j = 1, num_nodes_in_set
258 write (iout, '(f5.2)') dist_fact(j)
259 90 continue
260
261 100 continue
262
263 c read node set properties
264
265 num_props = exinqi(exoid, exnnsp)
266 write (iout,
267 1 '(/"There are ",i2," properties for each node set")')
268 2 num_props
269
270
271 call exgpn(exoid, exnset, prop_names, ierr)
272 write (iout, '("after exgpn, error = ", i3)' ) ierr
273
274 do 107 i = 1, num_props
275 do 105 j = 1, num_node_sets
276 call exgp(exoid,exnset,ids(j),prop_names(i),prop_value,ierr)
277 if (ierr .eq. 0) then
278 write( iout,
279 1 '("node set ",i2," property(",i2,"): ",a," = ",i5)' )
280 2 j, i, prop_names(i), prop_value
281 else
282 write (iout, '(/"after exgp, error = ", i3)' ) ierr
283 endif
284 105 continue
285 107 continue
286
287 c
288 c read concatenated node sets; this produces the same information as
289 c the above code which reads individual node sets
290 c
291 num_node_sets = exinqi(exoid, exnods)
292 if (num_node_sets .gt. 0) then
293 list_len = exinqi(exoid, exnsnl)
294 write(iout,'(/"after EXNSNL =",i3," exinq, error = ",i3)')
295 1 list_len,ierr
296
297 list_len = exinqi(exoid, exnsdf)
298 write(iout,'(/"after EXNSDF =",i3," exinq, error = ",i3)')
299 1 list_len,ierr
300
301 call exgcns (exoid, ids, num_nodes_per_set, num_df_per_set,
302 1 node_ind, df_ind, node_list, dist_fact, ierr)
303 write (iout, '(/"after exgcns, error = ", i3)' ) ierr
304
305 write (iout, '(/"concatenated node set info")')
306
307 write (iout, '("ids = ")')
308
309 do 110 i = 1, num_node_sets
310 write (iout, '(i3)') ids(i)
311 110 continue
312
313 write (iout, '("num_nodes_per_set = ")')
314
315 do 120 i = 1, num_node_sets
316 write (iout, '(i3)') num_nodes_per_set(i)
317 120 continue
318
319 write (iout, '("node_ind = ")')
320
321 do 130 i = 1, num_node_sets
322 write (iout, '(i3)') node_ind(i)
323 130 continue
324
325 write (iout, '("node_list = ")')
326
327 do 140 i = 1, list_len
328 write (iout, '(i3)') node_list(i)
329 140 continue
330
331 write (iout, '("dist_fact = ")')
332
333 do 150 i = 1, list_len
334 write (iout, '(f5.3)') dist_fact(i)
335 150 continue
336 endif
337
338 c
339 c read individual side sets
340 c
341 if (num_side_sets .gt. 0) then
342 call exgssi (exoid, ids, ierr)
343 write (iout, '(/"after exgssi, error = ", i3)' ) ierr
344 endif
345
346 do 190 i = 1, num_side_sets
347
348 call exgsp (exoid, ids(i), num_sides_in_set, num_df_in_set,
349 1 ierr)
350 write (iout, '(/"after exgsp, error = ", i3)' ) ierr
351
352 write (iout, '("side set ", i2, " parameters:",/
353 2 "num_sides = ", i3,/
354 3 "num_dist_factors = ", i3)')
355 4 ids(i), num_sides_in_set, num_df_in_set
356
357 call exgss (exoid, ids(i), elem_list, side_list, ierr)
358 write (iout, '(/"after exgss, error = ", i3)' ) ierr
359
360 call exgssd (exoid, ids(i), dist_fact, ierr)
361 write (iout, '(/"after exgssd, error = ", i3)' ) ierr
362
363 write (iout, '(/"element list for side set ", i2)') ids(i)
364
365 num_elem_in_set = num_sides_in_set
366 do 160 j = 1, num_elem_in_set
367 write (iout, '(i3)') elem_list(j)
368 160 continue
369
370 write (iout, '("side list for side set ", i2)') ids(i)
371
372 do 170 j = 1, num_sides_in_set
373 write (iout, '(i3)') side_list(j)
374 170 continue
375
376
377 write (iout, '("dist factors for side set ", i2)') ids(i)
378
379 do 180 j = 1, num_df_in_set
380 write (iout, '(f6.3)') dist_fact(j)
381 180 continue
382
383 190 continue
384
385 c read side set properties
386
387 num_props = exinqi(exoid, exnssp)
388 write (iout,
389 1 '(/"There are ",i2," properties for each side set")')
390 2 num_props
391
392
393 call exgpn(exoid, exsset, prop_names, ierr)
394 write (iout, '("after exgpn, error = ", i3)' ) ierr
395
396 do 197 i = 1, num_props
397 do 195 j = 1, num_side_sets
398 call exgp(exoid, exsset,ids(j),prop_names(i),prop_value,ierr)
399 if (ierr .eq. 0) then
400 write( iout,
401 1 '("side set ",i2," property(",i2,"): ",a," = ",i5)' )
402 2 j, i, prop_names(i), prop_value
403 else
404 write (iout, '(/"after exgp, error = ", i3)' ) ierr
405 endif
406 195 continue
407 197 continue
408
409 num_side_sets = exinqi(exoid, exsids)
410 write (iout, '(/"after exinq: EXSIDS =",i3,", error = ",i3)')
411 1 num_side_sets,ierr
412
413 if (num_side_sets .gt. 0) then
414 elem_list_len = exinqi(exoid, exssel)
415 write (iout, '(/"after exinq: EXSSEL =",i3,", error = ",i3)')
416 1 elem_list_len,ierr
417
418 df_list_len = exinqi(exoid, exssdf)
419 write (iout, '(/"after exinq: EXSSDF =",i3,", error = ",i3)')
420 1 df_list_len,ierr
421 c
422 c read concatenated side sets; this produces the same information as
423 c the above code which reads individual side sets
424 c
425 c NOTE: SKIP concatenated side set until routine exgcss has been redefined
426 c if (.TRUE.) goto 275
427 c
428 call exgcss (exoid, ids, num_elem_per_set, num_df_per_set,
429 1 elem_ind, df_ind, elem_list, side_list, dist_fact,
430 2 ierr)
431 write (iout, '(/"after exgcss, error = ", i3)' ) ierr
432
433 write (iout, '("concatenated side set info")')
434
435 write (iout, '("ids = ")')
436
437 do 200 i = 1, num_side_sets
438 write (iout, '(i3)') ids(i)
439 200 continue
440
441 write (iout, '("num_elem_per_set = ")')
442
443 do 210 i = 1, num_side_sets
444 write (iout, '(i3)') num_elem_per_set(i)
445 210 continue
446
447 write (iout, '("num_df_per_set = ")')
448
449 do 220 i = 1, num_side_sets
450 write (iout, '(i3)') num_df_per_set(i)
451 220 continue
452
453 write (iout, '("elem_ind = ")')
454
455 do 230 i = 1, num_side_sets
456 write (iout, '(i3)') elem_ind(i)
457 230 continue
458
459 write (iout, '("df_ind = ")')
460
461 do 240 i = 1, num_side_sets
462 write (iout, '(i3)') df_ind(i)
463 240 continue
464
465 write (iout, '("elem_list = ")')
466
467 do 250 i = 1, elem_list_len
468 write (iout, '(i3)') elem_list(i)
469 250 continue
470
471 write (iout, '("side_list = ")')
472
473 do 260 i = 1, elem_list_len
474 write (iout, '(i3)') side_list(i)
475 260 continue
476
477 write (iout, '("dist_fact = ")')
478
479 do 270 i = 1, df_list_len
480 write (iout, '(f6.3)') dist_fact(i)
481 270 continue
482 endif
483
484 c
485 c read QA records
486 c
487 num_qa_rec = exinqi(exoid, exqa)
488 call exgqa (exoid, qa_record, ierr)
489 write (iout, '(/"after exgqa, error = ", i3)' ) ierr
490
491 write (iout, '("QA records = ")')
492
493 do 290 i = 1, num_qa_rec
494 do 280 j = 1, 4
495 write (iout, '(a)') qa_record(j,i)
496 280 continue
497 290 continue
498
499 c
500 c read information records
501 c
502 num_info = exinqi(exoid, exinfo)
503
504 call exginf (exoid, inform, ierr)
505 write (iout, '(/"after exginf, error = ", i3)' ) ierr
506
507 write (iout, '("info records = ")')
508
509 do 300 i = 1, num_info
510 write (iout, '(a81)') inform(i)
511 300 continue
512
513 c
514 c read global variables parameters and names
515 c
516 call exgvp (exoid, "g", num_glo_vars, ierr)
517 write (iout, '(/"after exgvp, error = ", i3)' ) ierr
518
519 call exgvan (exoid, "g", num_glo_vars, var_names, ierr)
520 write (iout, '(/"after exgvan, error = ", i3)' ) ierr
521
522 write (iout, '("There are ",i2," global variables; their names ",
523 1 "are :")') num_glo_vars
524
525 do 320 i = 1, num_glo_vars
526 write (iout, '(a9)') var_names(i)
527 320 continue
528
529 c
530 c read nodal variables parameters and names
531 c
532 call exgvp (exoid, "n", num_nod_vars, ierr)
533 write (iout, '(/"after exgvp, error = ", i3)' ) ierr
534
535 call exgvan (exoid, "n", num_nod_vars, var_names, ierr)
536 write (iout, '(/"after exgvan, error = ", i3)' ) ierr
537
538 write (iout, '("There are ",i2," nodal variables; their names ",
539 1 "are :")') num_nod_vars
540
541 do 330 i = 1, num_nod_vars
542 write (iout, '(a9)') var_names(i)
543 330 continue
544
545 c
546 c read element variables parameters and names
547 c
548 call exgvp (exoid, "e", num_ele_vars, ierr)
549 write (iout, '(/"after exgvp, error = ", i3)' ) ierr
550
551 call exgvan (exoid, "e", num_ele_vars, var_names, ierr)
552 write (iout, '(/"after exgvan, error = ", i3)' ) ierr
553
554 write (iout, '("There are ",i2," element variables; their names ",
555 1 "are :")') num_ele_vars
556
557 do 340 i = 1, num_ele_vars
558 write (iout, '(a9)') var_names(i)
559 340 continue
560
561 c
562 c read element variable truth table
563 c
564 call exgvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ierr)
565 write (iout, '(/"after exgvtt, error = ", i3)' ) ierr
566
567 write (iout, '("This is the element variable truth table:")')
568
569 do 360 i = 1, num_elem_blk
570 do 350 j = 1, num_ele_vars
571 write (iout, '(i2)') truth_tab(j,i)
572 350 continue
573 360 continue
574
575 c
576 c determine how many time steps are stored
577 c
578 num_time_steps = exinqi(exoid, extims)
579 write (iout, '("There are ",i2," time steps in the database.")')
580 1 num_time_steps
581 c
582 c read time value at one time step
583 c
584 time_step = 3
585 call exgtim (exoid, time_step, time_value, ierr)
586 write (iout, '(/"after exgtim, error = ", i3)' ) ierr
587
588 write (iout, '("time value at time step ",i2," = ", f5.3)')
589 1 time_step, time_value
590 c
591 c read time values at all time steps
592 c
593 call exgatm (exoid, time_values, ierr)
594 write (iout, '(/"after exgatm, error = ", i3)' ) ierr
595
596 write (iout, '("time values at all time steps are:")')
597
598 do 370 i = 1, num_time_steps
599 write (iout, '(f5.3)') time_values(i)
600 370 continue
601
602 var_index = 1
603 beg_time = 1
604 end_time = -1
605 c
606 c read all global variables at one time step
607 c
608 call exggv (exoid, time_step, num_glo_vars, var_values, ierr)
609 write (iout, '(/"after exggv, error = ", i3)' ) ierr
610
611 write (iout, '("global variable values at time step ",i2)')
612 1 time_step
613
614 do 400 i = 1, num_glo_vars
615 write (iout, '(f5.3)') var_values(i)
616 400 continue
617
618 c
619 c read a single global variable through time
620 c
621 call exggvt (exoid, var_index, beg_time, end_time, var_values,
622 1 ierr)
623 write (iout, '(/"after exggvt, error = ", i3)' ) ierr
624
625 write (iout, '("global variable ",i2," values through time:")')
626 1 var_index
627
628 do 410 i = 1, num_time_steps
629 write (iout, '(f5.3)') var_values(i)
630 410 continue
631
632 c
633 c read a nodal variable at one time step
634 c
635 call exgnv (exoid, time_step, var_index, num_nodes, var_values,
636 1 ierr)
637 write (iout, '(/"after exgnv, error = ", i3)' ) ierr
638
639 write (iout, '("nodal variable ",i2," values at time step ",i2)')
640 1 var_index, time_step
641
642 do 420 i = 1, num_nodes
643 write (iout, '(f5.3)') var_values(i)
644 420 continue
645
646 c
647 c read a nodal variable through time
648 c
649 node_num = 1
650
651 call exgnvt (exoid, var_index, node_num, beg_time, end_time,
652 1 var_values, ierr)
653 write (iout, '(/"after exgnvt, error = ", i3)' ) ierr
654
655 write (iout, '("nodal variable ",i2," values for node ",i2,
656 1 " through time:")') var_index, node_num
657
658 do 430 i = 1, num_time_steps
659 write (iout, '(f5.3)') var_values(i)
660 430 continue
661
662 c
663 c read an element variable at one time step
664 c
665 call exgebi (exoid, ids, ierr)
666 write (iout, '(/"after exgebi, error = ", i3)' ) ierr
667
668 do 450 i = 1, num_elem_blk
669
670 call exgev (exoid, time_step, var_index, ids(i),
671 1 num_elem_in_block(i), var_values, ierr)
672 write (iout, '(/"after exgev, error = ", i3)' ) ierr
673
674 if (ierr .eq. 0) then
675 write (iout, '("element variable ",i2," values of element ",
676 1 "block ",i2," at time step ",i2)')
677 2 var_index, ids(i), time_step
678 endif
679
680 do 440 j = 1, num_elem_in_block(i)
681 write (iout, '(f5.3)') var_values(j)
682 440 continue
683
684 450 continue
685
686 c
687 c read an element variable through time
688 c
689 var_index = 2
690 elem_num = 2
691
692 call exgevt (exoid, var_index, elem_num, beg_time, end_time,
693 1 var_values, ierr)
694 write (iout, '(/"after exgevt, error = ", i3)' ) ierr
695
696 write (iout, '("element variable ",i2," values for element ",i2,
697 1 " through time:")') var_index, elem_num
698
699 do 460 i = 1, num_time_steps
700 write (iout, '(f5.3)') var_values(i)
701 460 continue
702
703 call exclos (exoid, ierr)
704 write (iout, '(/"after exclos, error = ", i3)' ) ierr
705
706 stop
707 end
708