Exodus 7.21

/exodus_for/test/testwt.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 testwt
35 c
36 c This is a test program for the Fortran binding of the EXODUS II
37 c database write routines.
38 c
39 include 'exodusII.inc'
40
41 integer iin, iout
42 integer exoid, num_dim,num_nodes,elem_map(5),num_elem,num_elem_blk
43 integer num_elem_in_block(10), num_nodes_per_elem(10),numattr(10)
44 integer num_node_sets, num_side_sets
45 integer i, j, k, m, connect(10)
46 integer node_list(100), elem_list(100), side_list(100)
47 integer ebids(10),ids(10), num_nodes_per_set(10)
48 integer num_elem_per_set(10), num_df_per_set(10)
49 integer df_ind(10), node_ind(10), elem_ind(10)
50 integer num_qa_rec, num_info
51 integer num_glo_vars, num_nod_vars, num_ele_vars
52 integer truth_tab(3,5)
53 integer whole_time_step, num_time_steps
54 integer cpu_word_size, io_word_size
55 integer prop_array(2)
56
57 real glob_var_vals(100), nodal_var_vals(100)
58 real time_value, elem_var_vals(100)
59 real x(100), y(100), z(100)
60 real attrib(100), dist_fact(100)
61
62 character*(MXSTLN) coord_names(3)
63 character*(MXSTLN) blk_names(5)
64 character*(MXSTLN) nset_names(2)
65 character*(MXSTLN) sset_names(5)
66 character*(MXSTLN) cname
67 character*(MXSTLN) var_names(3)
68 character*(MXSTLN) qa_record(4,2)
69 character*(MXLNLN) inform(3)
70 character*(MXSTLN) prop_names(2)
71 character*(MXSTLN) attrib_names(1)
72
73 data iin /5/, iout /6/
74
75 call exopts (exabrt, ierr)
76 write (iout,'("after exopts, error = ", i4)') ierr
77 cpu_word_size = 0
78 io_word_size = 0
79 c
80 c create EXODUS II files
81 c
82 exoid = excre("test.exo",
83 1 exclob, cpu_word_size, io_word_size, ierr)
84 write (iout,'("after excre for test.exo, id: ", i4)') exoid
85 write (iout,'(" cpu word size: ",i4," io word size: ",i4)')
86 1 cpu_word_size, io_word_size
87 write (iout,'("after excre, error = ", i4)') ierr
88 c
89 c initialize file with parameters
90 c
91
92 num_dim = 3
93 num_nodes = 26
94 num_elem = 5
95 num_elem_blk = 5
96 num_node_sets = 2
97 num_side_sets = 5
98 call expini (exoid, "This is a test", num_dim, num_nodes,
99 1 num_elem, num_elem_blk, num_node_sets,
100 2 num_side_sets, ierr)
101
102 write (iout, '("after expini, error = ", i4)' ) ierr
103
104 if (ierr .ne. 0) then
105 call exclos(exoid,ierr)
106 call exit (0)
107 endif
108
109 c
110 c write nodal coordinates values and names to database
111 c
112 c Quad #1
113 x(1) = 0.0
114 x(2) = 1.0
115 x(3) = 1.0
116 x(4) = 0.0
117
118 y(1) = 0.0
119 y(2) = 0.0
120 y(3) = 1.0
121 y(4) = 1.0
122
123 z(1) = 0.0
124 z(2) = 0.0
125 z(3) = 0.0
126 z(4) = 0.0
127
128 c Quad #2
129 x(5) = 1.0
130 x(6) = 2.0
131 x(7) = 2.0
132 x(8) = 1.0
133
134 y(5) = 0.0
135 y(6) = 0.0
136 y(7) = 1.0
137 y(8) = 1.0
138
139 z(5) = 0.0
140 z(6) = 0.0
141 z(7) = 0.0
142 z(8) = 0.0
143
144 c Hex #1
145 x(9) = 0.0
146 x(10) = 10.0
147 x(11) = 10.0
148 x(12) = 1.0
149 x(13) = 1.0
150 x(14) = 10.0
151 x(15) = 10.0
152 x(16) = 1.0
153
154 y(9) = 0.0
155 y(10) = 0.0
156 y(11) = 0.0
157 y(12) = 0.0
158 y(13) = 10.0
159 y(14) = 10.0
160 y(15) = 10.0
161 y(16) = 10.0
162
163 z(9) = 0.0
164 z(10) = 0.0
165 z(11) =-10.0
166 z(12) =-10.0
167 z(13) = 0.0
168 z(14) = 0.0
169 z(15) =-10.0
170 z(16) =-10.0
171
172 c Tetra #1
173 x(17) = 0.0
174 x(18) = 1.0
175 x(19) = 10.0
176 x(20) = 7.0
177
178 y(17) = 0.0
179 y(18) = 0.0
180 y(19) = 0.0
181 y(20) = 5.0
182
183 z(17) = 0.0
184 z(18) = 5.0
185 z(19) = 2.0
186 z(20) = 3.0
187
188 c Wedge #1
189 x(21) = 3.0
190 x(22) = 6.0
191 x(23) = 0.0
192 x(24) = 3.0
193 x(25) = 6.0
194 x(26) = 0.0
195
196 y(21) = 0.0
197 y(22) = 0.0
198 y(23) = 0.0
199 y(24) = 2.0
200 y(25) = 2.0
201 y(26) = 2.0
202
203 z(21) = 6.0
204 z(22) = 0.0
205 z(23) = 0.0
206 z(24) = 6.0
207 z(25) = 2.0
208 z(26) = 0.0
209 call expcor (exoid, x, y, z, ierr)
210 write (iout, '("after expcor, error = ", i4)' ) ierr
211 if (ierr .ne. 0) then
212 call exclos(exoid,ierr)
213 call exit (0)
214 endif
215
216
217 coord_names(1) = "xcoor"
218 coord_names(2) = "ycoor"
219 coord_names(3) = "zcoor"
220
221 call expcon (exoid, coord_names, ierr)
222 write (iout, '("after expcon, error = ", i4)' ) ierr
223 call exupda(exoid,ierr)
224 if (ierr .ne. 0) then
225 call exclos(exoid,ierr)
226 call exit (0)
227 endif
228
229
230 c
231 c write element order map
232 c
233
234 do 10 i = 1, num_elem
235 elem_map(i) = i
236 10 continue
237
238 call expmap (exoid, elem_map, ierr)
239 write (iout, '("after expmap, error = ", i4)' ) ierr
240 if (ierr .ne. 0) then
241 call exclos(exoid,ierr)
242 call exit (0)
243 endif
244
245 c
246 c write element block parameters
247 c
248
249 num_elem_in_block(1) = 1
250 num_elem_in_block(2) = 1
251 num_elem_in_block(3) = 1
252 num_elem_in_block(4) = 1
253 num_elem_in_block(5) = 1
254
255 num_nodes_per_elem(1) = 4
256 num_nodes_per_elem(2) = 4
257 num_nodes_per_elem(3) = 8
258 num_nodes_per_elem(4) = 4
259 num_nodes_per_elem(5) = 6
260
261 ebids(1) = 10
262 ebids(2) = 11
263 ebids(3) = 12
264 ebids(4) = 13
265 ebids(5) = 14
266
267 numattr(1) = 1
268 numattr(2) = 1
269 numattr(3) = 1
270 numattr(4) = 1
271 numattr(5) = 1
272
273 cname = "quad"
274 call expelb (exoid,ebids(1),cname,num_elem_in_block(1),
275 1 num_nodes_per_elem(1),numattr(1),ierr)
276 write (iout, '("after expelb, error = ", i4)' ) ierr
277 if (ierr .ne. 0) then
278 call exclos(exoid,ierr)
279 call exit (0)
280 endif
281
282 call expelb (exoid,ebids(2),cname,num_elem_in_block(2),
283 1 num_nodes_per_elem(2),numattr(2),ierr)
284 write (iout, '("after expelb, error = ", i4)' ) ierr
285 if (ierr .ne. 0) then
286 call exclos(exoid,ierr)
287 call exit (0)
288 endif
289
290 cname = "hex"
291 call expelb (exoid,ebids(3),cname,num_elem_in_block(3),
292 1 num_nodes_per_elem(3),numattr(3),ierr)
293 write (iout, '("after expelb, error = ", i4)' ) ierr
294 if (ierr .ne. 0) then
295 call exclos(exoid,ierr)
296 call exit (0)
297 endif
298
299 cname = "tetra"
300 call expelb (exoid,ebids(4),cname,num_elem_in_block(4),
301 1 num_nodes_per_elem(4),numattr(4),ierr)
302 write (iout, '("after expelb, error = ", i4)' ) ierr
303 if (ierr .ne. 0) then
304 call exclos(exoid,ierr)
305 call exit (0)
306 endif
307
308 cname = "wedge"
309 call expelb (exoid,ebids(5),cname,num_elem_in_block(5),
310 1 num_nodes_per_elem(5),numattr(5),ierr)
311 write (iout, '("after expelb, error = ", i4)' ) ierr
312 if (ierr .ne. 0) then
313 call exclos(exoid,ierr)
314 call exit (0)
315 endif
316
317 blk_names(1) = "block_a";
318 blk_names(2) = "block_b";
319 blk_names(3) = "block_c";
320 blk_names(4) = "block_d";
321 blk_names(5) = "block_e";
322
323 call expnams(exoid, ex_elem_block, num_elem_blk, blk_names, ierr)
324 write (iout, '("after expnams, error = ", i4)' ) ierr
325 if (ierr .ne. 0) then
326 call exclos(exoid,ierr)
327 call exit (0)
328 endif
329
330 c write element block properties
331
332 prop_names(1) = "MATL"
333 prop_names(2) = "DENSITY"
334 call exppn(exoid,ex_elem_block,2,prop_names,ierr)
335 write (iout, '("after exppn, error = ", i4)' ) ierr
336 if (ierr .ne. 0) then
337 call exclos(exoid,ierr)
338 call exit (0)
339 endif
340
341 call expp(exoid, ex_elem_block, ebids(1), "MATL", 10, ierr)
342 write (iout, '("after expp, error = ", i4)' ) ierr
343 if (ierr .ne. 0) then
344 call exclos(exoid,ierr)
345 call exit (0)
346 endif
347 call expp(exoid, ex_elem_block, ebids(2), "MATL", 20, ierr)
348 write (iout, '("after expp, error = ", i4)' ) ierr
349 if (ierr .ne. 0) then
350 call exclos(exoid,ierr)
351 call exit (0)
352 endif
353 call expp(exoid, ex_elem_block, ebids(3), "MATL", 30, ierr)
354 write (iout, '("after expp, error = ", i4)' ) ierr
355 if (ierr .ne. 0) then
356 call exclos(exoid,ierr)
357 call exit (0)
358 endif
359 call expp(exoid, ex_elem_block, ebids(4), "MATL", 40, ierr)
360 write (iout, '("after expp, error = ", i4)' ) ierr
361 if (ierr .ne. 0) then
362 call exclos(exoid,ierr)
363 call exit (0)
364 endif
365 call expp(exoid, ex_elem_block, ebids(5), "MATL", 50, ierr)
366 write (iout, '("after expp, error = ", i4)' ) ierr
367 if (ierr .ne. 0) then
368 call exclos(exoid,ierr)
369 call exit (0)
370 endif
371
372 c
373 c write element connectivity
374 c
375
376 connect(1) = 1
377 connect(2) = 2
378 connect(3) = 3
379 connect(4) = 4
380
381 call expelc (exoid, ebids(1), connect, ierr)
382 write (iout, '("after expelc, error = ", i4)' ) ierr
383 if (ierr .ne. 0) then
384 call exclos(exoid,ierr)
385 call exit (0)
386 endif
387
388 connect(1) = 5
389 connect(2) = 6
390 connect(3) = 7
391 connect(4) = 8
392
393 call expelc (exoid, ebids(2), connect, ierr)
394 write (iout, '("after expelc, error = ", i4)' ) ierr
395 if (ierr .ne. 0) then
396 call exclos(exoid,ierr)
397 call exit (0)
398 endif
399
400 connect(1) = 9
401 connect(2) = 10
402 connect(3) = 11
403 connect(4) = 12
404 connect(5) = 13
405 connect(6) = 14
406 connect(7) = 15
407 connect(8) = 16
408
409 call expelc (exoid, ebids(3), connect, ierr)
410 write (iout, '("after expelc, error = ", i4)' ) ierr
411 if (ierr .ne. 0) then
412 call exclos(exoid,ierr)
413 call exit (0)
414 endif
415
416 connect(1) = 17
417 connect(2) = 18
418 connect(3) = 19
419 connect(4) = 20
420
421 call expelc (exoid, ebids(4), connect, ierr)
422 write (iout, '("after expelc, error = ", i4)' ) ierr
423 if (ierr .ne. 0) then
424 call exclos(exoid,ierr)
425 call exit (0)
426 endif
427
428 connect(1) = 21
429 connect(2) = 22
430 connect(3) = 23
431 connect(4) = 24
432 connect(5) = 25
433 connect(6) = 26
434
435 call expelc (exoid, ebids(5), connect, ierr)
436 write (iout, '("after expelc, error = ", i4)' ) ierr
437 if (ierr .ne. 0) then
438 call exclos(exoid,ierr)
439 call exit (0)
440 endif
441
442 c
443 c write element block attributes
444 c
445 attrib(1) = 3.14159
446 call expeat (exoid, ebids(1), attrib, ierr)
447 write (iout, '("after expeat, error = ", i4)' ) ierr
448 if (ierr .ne. 0) then
449 call exclos(exoid,ierr)
450 call exit (0)
451 endif
452
453 attrib(1) = 6.14159
454 call expeat (exoid, ebids(2), attrib, ierr)
455 write (iout, '("after expeat, error = ", i4)' ) ierr
456 if (ierr .ne. 0) then
457 call exclos(exoid,ierr)
458 call exit (0)
459 endif
460
461 call expeat (exoid, ebids(3), attrib, ierr)
462 write (iout, '("after expeat, error = ", i4)' ) ierr
463 if (ierr .ne. 0) then
464 call exclos(exoid,ierr)
465 call exit (0)
466 endif
467
468 call expeat (exoid, ebids(4), attrib, ierr)
469 write (iout, '("after expeat, error = ", i4)' ) ierr
470 if (ierr .ne. 0) then
471 call exclos(exoid,ierr)
472 call exit (0)
473 endif
474
475 call expeat (exoid, ebids(5), attrib, ierr)
476 write (iout, '("after expeat, error = ", i4)' ) ierr
477 if (ierr .ne. 0) then
478 call exclos(exoid,ierr)
479 call exit (0)
480 endif
481
482 attrib_names(1) = 'THICKNESS'
483 do i=1, 5
484 call expean (exoid, ebids(i), 1, attrib_names, ierr)
485 write (iout, '("after expean, error = ", i4)' ) ierr
486 if (ierr .ne. 0) then
487 call exclos(exoid,ierr)
488 call exit (0)
489 endif
490 end do
491 c
492 c write individual node sets
493 c
494
495 node_list(1) = 100
496 node_list(2) = 101
497 node_list(3) = 102
498 node_list(4) = 103
499 node_list(5) = 104
500
501 dist_fact(1) = 1.0
502 dist_fact(2) = 2.0
503 dist_fact(3) = 3.0
504 dist_fact(4) = 4.0
505 dist_fact(5) = 5.0
506
507 call expnp (exoid, 20, 5, 5, ierr)
508 write (iout, '("after expnp, error = ", i4)' ) ierr
509 if (ierr .ne. 0) then
510 call exclos(exoid,ierr)
511 call exit (0)
512 endif
513 call expns (exoid, 20, node_list, ierr)
514 write (iout, '("after expns, error = ", i4)' ) ierr
515 if (ierr .ne. 0) then
516 call exclos(exoid,ierr)
517 call exit (0)
518 endif
519 call expnsd (exoid, 20, dist_fact, ierr)
520 write (iout, '("after expnsd, error = ", i4)' ) ierr
521 if (ierr .ne. 0) then
522 call exclos(exoid,ierr)
523 call exit (0)
524 endif
525
526 node_list(1) = 200
527 node_list(2) = 201
528 node_list(3) = 202
529
530 dist_fact(1) = 1.1
531 dist_fact(2) = 2.1
532 dist_fact(3) = 3.1
533
534 call expnp (exoid, 21, 3, 3, ierr)
535 write (iout, '("after expnp, error = ", i4)' ) ierr
536 if (ierr .ne. 0) then
537 call exclos(exoid,ierr)
538 call exit (0)
539 endif
540 call expns (exoid, 21, node_list, ierr)
541 write (iout, '("after expns, error = ", i4)' ) ierr
542 if (ierr .ne. 0) then
543 call exclos(exoid,ierr)
544 call exit (0)
545 endif
546 call expnsd (exoid, 21, dist_fact, ierr)
547 write (iout, '("after expnsd, error = ", i4)' ) ierr
548 if (ierr .ne. 0) then
549 call exclos(exoid,ierr)
550 call exit (0)
551 endif
552
553 c
554 c write concatenated node sets; this produces the same information as
555 c the above code which writes individual node sets
556 c
557
558 ids(1) = 20
559 ids(2) = 21
560
561 num_nodes_per_set(1) = 5
562 num_nodes_per_set(2) = 3
563
564 num_df_per_set(1) = 5
565 num_df_per_set(2) = 3
566
567 node_ind(1) = 1
568 node_ind(2) = 6
569
570 df_ind(1) = 1
571 df_ind(2) = 6
572
573 node_list(1) = 100
574 node_list(2) = 101
575 node_list(3) = 102
576 node_list(4) = 103
577 node_list(5) = 104
578 node_list(6) = 200
579 node_list(7) = 201
580 node_list(8) = 202
581
582 dist_fact(1) = 1.0
583 dist_fact(2) = 2.0
584 dist_fact(3) = 3.0
585 dist_fact(4) = 4.0
586 dist_fact(5) = 5.0
587 dist_fact(6) = 1.1
588 dist_fact(7) = 2.1
589 dist_fact(8) = 3.1
590
591 c call expcns (exoid, ids, num_nodes_per_set, num_df_per_set,
592 c 1 node_ind, df_ind, node_list, dist_fact, ierr)
593 c write (iout, '("after expcns, error = ", i4)' ) ierr
594
595 nset_names(1) = "nodeset_a1";
596 nset_names(2) = "nodeset_b2";
597
598 call expnams(exoid, ex_node_set, num_node_sets, nset_names, ierr)
599 write (iout, '("after expnams, error = ", i4)' ) ierr
600 if (ierr .ne. 0) then
601 call exclos(exoid,ierr)
602 call exit (0)
603 endif
604
605
606 c write node set properties
607
608 prop_names(1) = "FACE"
609 call expp(exoid, ex_node_set, 20, prop_names(1), 4, ierr)
610 write (iout, '("after expp, error = ", i4)' ) ierr
611 if (ierr .ne. 0) then
612 call exclos(exoid,ierr)
613 call exit (0)
614 endif
615
616 call expp(exoid, ex_node_set, 21, prop_names(1), 5, ierr)
617 write (iout, '("after expp, error = ", i4)' ) ierr
618 if (ierr .ne. 0) then
619 call exclos(exoid,ierr)
620 call exit (0)
621 endif
622
623 prop_array(1) = 1000
624 prop_array(2) = 2000
625
626 prop_names(1) = "VELOCITY"
627 call exppa(exoid, ex_node_set, prop_names(1), prop_array, ierr)
628 write (iout, '("after exppa, error = ", i4)' ) ierr
629 if (ierr .ne. 0) then
630 call exclos(exoid,ierr)
631 call exit (0)
632 endif
633
634 c
635 c write individual side sets
636 c
637
638 c side set #1 - quad
639
640 elem_list(1) = 2
641 elem_list(2) = 2
642
643 side_list(1) = 4
644 side_list(2) = 2
645
646 dist_fact(1) = 30.0
647 dist_fact(2) = 30.1
648 dist_fact(3) = 30.2
649 dist_fact(4) = 30.3
650
651 call expsp (exoid, 30, 2, 4, ierr)
652 write (iout, '("after expsp, error = ", i4)' ) ierr
653 if (ierr .ne. 0) then
654 call exclos(exoid,ierr)
655 call exit (0)
656 endif
657
658 call expss (exoid, 30, elem_list, side_list, ierr)
659 write (iout, '("after expss, error = ", i4)' ) ierr
660 if (ierr .ne. 0) then
661 call exclos(exoid,ierr)
662 call exit (0)
663 endif
664
665 call expssd (exoid, 30, dist_fact, ierr)
666 write (iout, '("after expssd, error = ", i4)' ) ierr
667 if (ierr .ne. 0) then
668 call exclos(exoid,ierr)
669 call exit (0)
670 endif
671
672 c side set #2 - quad, spanning 2 elements
673
674 elem_list(1) = 1
675 elem_list(2) = 2
676
677 side_list(1) = 2
678 side_list(2) = 3
679
680 dist_fact(1) = 31.0
681 dist_fact(2) = 31.1
682 dist_fact(3) = 31.2
683 dist_fact(4) = 31.3
684
685 call expsp (exoid, 31, 2, 4, ierr)
686 write (iout, '("after expsp, error = ", i4)' ) ierr
687 if (ierr .ne. 0) then
688 call exclos(exoid,ierr)
689 call exit (0)
690 endif
691
692 call expss (exoid, 31, elem_list, side_list, ierr)
693 write (iout, '("after expss, error = ", i4)' ) ierr
694 if (ierr .ne. 0) then
695 call exclos(exoid,ierr)
696 call exit (0)
697 endif
698
699 call expssd (exoid, 31, dist_fact, ierr)
700 write (iout, '("after expssd, error = ", i4)' ) ierr
701 if (ierr .ne. 0) then
702 call exclos(exoid,ierr)
703 call exit (0)
704 endif
705
706 c side set #3 - hex
707
708 elem_list(1) = 3
709 elem_list(2) = 3
710 elem_list(3) = 3
711 elem_list(4) = 3
712 elem_list(5) = 3
713 elem_list(6) = 3
714 elem_list(7) = 3
715
716 side_list(1) = 5
717 side_list(2) = 3
718 side_list(3) = 3
719 side_list(4) = 2
720 side_list(5) = 4
721 side_list(6) = 1
722 side_list(7) = 6
723
724 call expsp (exoid, 32, 7, 0, ierr)
725 write (iout, '("after expsp, error = ", i4)' ) ierr
726 if (ierr .ne. 0) then
727 call exclos(exoid,ierr)
728 call exit (0)
729 endif
730
731 call expss (exoid, 32, elem_list, side_list, ierr)
732 write (iout, '("after expss, error = ", i4)' ) ierr
733 if (ierr .ne. 0) then
734 call exclos(exoid,ierr)
735 call exit (0)
736 endif
737
738 c side set #4 - tetras
739
740 elem_list(1) = 4
741 elem_list(2) = 4
742 elem_list(3) = 4
743 elem_list(4) = 4
744
745 side_list(1) = 1
746 side_list(2) = 2
747 side_list(3) = 3
748 side_list(4) = 4
749
750 call expsp (exoid, 33, 4, 0, ierr)
751 write (iout, '("after expsp, error = ", i4)' ) ierr
752 if (ierr .ne. 0) then
753 call exclos(exoid,ierr)
754 call exit (0)
755 endif
756
757 call expss (exoid, 33, elem_list, side_list, ierr)
758 write (iout, '("after expss, error = ", i4)' ) ierr
759 if (ierr .ne. 0) then
760 call exclos(exoid,ierr)
761 call exit (0)
762 endif
763
764 c side set #5 - wedges
765
766 elem_list(1) = 5
767 elem_list(2) = 5
768 elem_list(3) = 5
769 elem_list(4) = 5
770 elem_list(5) = 5
771
772 side_list(1) = 1
773 side_list(2) = 2
774 side_list(3) = 3
775 side_list(4) = 4
776 side_list(5) = 5
777
778 call expsp (exoid, 34, 5, 0, ierr)
779 write (iout, '("after expsp, error = ", i4)' ) ierr
780 if (ierr .ne. 0) then
781 call exclos(exoid,ierr)
782 call exit (0)
783 endif
784
785 call expss (exoid, 34, elem_list, side_list, ierr)
786 write (iout, '("after expss, error = ", i4)' ) ierr
787 if (ierr .ne. 0) then
788 call exclos(exoid,ierr)
789 call exit (0)
790 endif
791
792
793 c write concatenated side sets; this produces the same information as
794 c the above code which writes individual side sets
795 c
796
797 ids(1) = 30
798 ids(2) = 31
799 ids(3) = 32
800 ids(4) = 33
801 ids(5) = 34
802
803 c side set #1
804 node_list(1) = 8
805 node_list(2) = 5
806 node_list(3) = 6
807 node_list(4) = 7
808
809 c side set #2
810 node_list(5) = 2
811 node_list(6) = 3
812 node_list(7) = 7
813 node_list(8) = 8
814
815 c side set #3
816 node_list(9) = 9
817 node_list(10) = 12
818 node_list(11) = 11
819 node_list(12) = 10
820
821 node_list(13) = 11
822 node_list(14) = 12
823 node_list(15) = 16
824 node_list(16) = 15
825
826 node_list(17) = 16
827 node_list(18) = 15
828 node_list(19) = 11
829 node_list(20) = 12
830
831 node_list(21) = 10
832 node_list(22) = 11
833 node_list(23) = 15
834 node_list(24) = 14
835
836 node_list(25) = 13
837 node_list(26) = 16
838 node_list(27) = 12
839 node_list(28) = 9
840
841 node_list(29) = 14
842 node_list(30) = 13
843 node_list(31) = 9
844 node_list(32) = 10
845
846 node_list(33) = 16
847 node_list(34) = 13
848 node_list(35) = 14
849 node_list(36) = 15
850
851 c side set #4
852 node_list(37) = 17
853 node_list(38) = 18
854 node_list(39) = 20
855
856 node_list(40) = 18
857 node_list(41) = 19
858 node_list(42) = 20
859
860 node_list(43) = 20
861 node_list(44) = 19
862 node_list(45) = 17
863
864 node_list(46) = 19
865 node_list(47) = 18
866 node_list(48) = 17
867
868 c side set #5
869 node_list(49) = 25
870 node_list(50) = 24
871 node_list(51) = 21
872 node_list(52) = 22
873
874 node_list(53) = 26
875 node_list(54) = 25
876 node_list(55) = 22
877 node_list(56) = 23
878
879 node_list(57) = 26
880 node_list(58) = 23
881 node_list(59) = 21
882 node_list(60) = 24
883
884 node_list(61) = 23
885 node_list(62) = 22
886 node_list(63) = 21
887
888 node_list(64) = 24
889 node_list(65) = 25
890 node_list(66) = 26
891
892 num_elem_per_set(1) = 2
893 num_elem_per_set(2) = 2
894 num_elem_per_set(3) = 7
895 num_elem_per_set(4) = 4
896 num_elem_per_set(5) = 5
897
898 num_nodes_per_set(1) = 4
899 num_nodes_per_set(2) = 4
900 num_nodes_per_set(3) = 28
901 num_nodes_per_set(4) = 12
902 num_nodes_per_set(5) = 20
903
904 elem_ind(1) = 1
905 elem_ind(2) = 3
906 elem_ind(3) = 5
907 elem_ind(4) = 12
908 elem_ind(5) = 16
909
910 node_ind(1) = 1
911 node_ind(2) = 5
912 node_ind(3) = 9
913 node_ind(4) = 37
914 node_ind(5) = 48
915
916 elem_list(1) = 3
917 elem_list(2) = 3
918 elem_list(3) = 1
919 elem_list(4) = 3
920 elem_list(5) = 4
921 elem_list(6) = 4
922 elem_list(7) = 4
923 elem_list(8) = 4
924 elem_list(9) = 4
925 elem_list(10) = 4
926 elem_list(11) = 4
927 elem_list(12) = 5
928 elem_list(13) = 5
929 elem_list(14) = 5
930 elem_list(15) = 5
931 elem_list(16) = 6
932 elem_list(17) = 6
933 elem_list(18) = 6
934 elem_list(19) = 6
935 elem_list(20) = 6
936
937 c side_list(1) = 1
938 c side_list(2) = 2
939 c side_list(3) = 3
940 c side_list(4) = 4
941
942 c call excn2s(exoid, num_elem_per_set, num_nodes_per_set, elem_ind,
943 c 1 node_ind, elem_list, node_list, side_list, ierr)
944 c write (iout, '("after excn2s, error = ", i4)' ) ierr
945
946
947 num_df_per_set(1) = 4
948 num_df_per_set(2) = 4
949 num_df_per_set(3) = 0
950 num_df_per_set(4) = 0
951 num_df_per_set(5) = 0
952
953 df_ind(1) = 1
954 df_ind(2) = 5
955
956 dist_fact(1) = 30.0
957 dist_fact(2) = 30.1
958 dist_fact(3) = 30.2
959 dist_fact(4) = 30.3
960 dist_fact(5) = 31.0
961 dist_fact(6) = 31.1
962 dist_fact(7) = 31.2
963 dist_fact(8) = 31.3
964
965 c call expcss (exoid, ids, num_elem_per_set, num_df_per_set,
966 c 1 elem_ind, df_ind, elem_list, side_list, dist_fact,
967 c 2 ierr)
968 c write (iout, '("after expcss, error = ", i4)' ) ierr
969
970 prop_names(1) = "COLOR"
971 call expp(exoid, ex_side_set, 30, prop_names(1), 100, ierr)
972 write (iout, '("after expp, error = ", i4)' ) ierr
973 if (ierr .ne. 0) then
974 call exclos(exoid,ierr)
975 call exit (0)
976 endif
977
978 call expp(exoid, ex_side_set, 31, prop_names(1), 101, ierr)
979 write (iout, '("after expp, error = ", i4)' ) ierr
980 if (ierr .ne. 0) then
981 call exclos(exoid,ierr)
982 call exit (0)
983 endif
984
985 sset_names(1) = "surf_first"
986 sset_names(2) = "surf_second";
987 sset_names(3) = "surf_third";
988 sset_names(4) = "surf_fourth";
989 sset_names(5) = "surf_fifth";
990
991 call expnams(exoid, ex_side_set, num_side_sets, sset_names, ierr)
992 write (iout, '("after expnams, error = ", i4)' ) ierr
993 if (ierr .ne. 0) then
994 call exclos(exoid,ierr)
995 call exit (0)
996 endif
997 c
998 c
999 c write QA records
1000 c
1001
1002 num_qa_rec = 2
1003
1004 qa_record(1,1) = "TESTWT fortran version"
1005 qa_record(2,1) = "testwt"
1006 qa_record(3,1) = "07/07/93"
1007 qa_record(4,1) = "15:41:33"
1008 qa_record(1,2) = "FASTQ"
1009 qa_record(2,2) = "fastq"
1010 qa_record(3,2) = "07/07/93"
1011 qa_record(4,2) = "16:41:33"
1012
1013 call expqa (exoid, num_qa_rec, qa_record, ierr)
1014 write (iout, '("after expqa, error = ", i4)' ) ierr
1015 if (ierr .ne. 0) then
1016 call exclos(exoid,ierr)
1017 call exit (0)
1018 endif
1019
1020
1021 c
1022 c write information records
1023 c
1024
1025 num_info = 3
1026
1027 inform(1) = "This is the first information record."
1028 inform(2) = "This is the second information record."
1029 inform(3) = "This is the third information record."
1030
1031 call expinf (exoid, num_info, inform, ierr)
1032 write (iout, '("after expinf, error = ", i4)' ) ierr
1033 if (ierr .ne. 0) then
1034 call exclos(exoid,ierr)
1035 call exit (0)
1036 endif
1037
1038 c write results variables parameters and names
1039
1040 num_glo_vars = 1
1041
1042 var_names(1) = "glo_vars"
1043
1044 call expvp (exoid, "g", num_glo_vars, ierr)
1045 write (iout, '("after expvp, error = ", i4)' ) ierr
1046 if (ierr .ne. 0) then
1047 call exclos(exoid,ierr)
1048 call exit (0)
1049 endif
1050 call expvan (exoid, "g", num_glo_vars, var_names, ierr)
1051 write (iout, '("after expvan, error = ", i4)' ) ierr
1052 if (ierr .ne. 0) then
1053 call exclos(exoid,ierr)
1054 call exit (0)
1055 endif
1056
1057
1058 num_nod_vars = 2
1059
1060 var_names(1) = "nod_var0"
1061 var_names(2) = "nod_var1"
1062
1063 call expvp (exoid, "n", num_nod_vars, ierr)
1064 write (iout, '("after expvp, error = ", i4)' ) ierr
1065 if (ierr .ne. 0) then
1066 call exclos(exoid,ierr)
1067 call exit (0)
1068 endif
1069 call expvan (exoid, "n", num_nod_vars, var_names, ierr)
1070 write (iout, '("after expvan, error = ", i4)' ) ierr
1071 if (ierr .ne. 0) then
1072 call exclos(exoid,ierr)
1073 call exit (0)
1074 endif
1075
1076
1077 num_ele_vars = 3
1078
1079 var_names(1) = "ele_var0"
1080 var_names(2) = "ele_var1"
1081 var_names(3) = "ele_var2"
1082
1083 call expvp (exoid, "e", num_ele_vars, ierr)
1084 write (iout, '("after expvp, error = ", i4)' ) ierr
1085 if (ierr .ne. 0) then
1086 call exclos(exoid,ierr)
1087 call exit (0)
1088 endif
1089 call expvan (exoid, "e", num_ele_vars, var_names, ierr)
1090 write (iout, '("after expvan, error = ", i4)' ) ierr
1091 if (ierr .ne. 0) then
1092 call exclos(exoid,ierr)
1093 call exit (0)
1094 endif
1095
1096 c
1097 c write element variable truth table
1098 c
1099
1100 k = 0
1101
1102 do 30 i = 1,num_elem_blk
1103 do 20 j = 1,num_ele_vars
1104 truth_tab(j,i) = 1
1105 20 continue
1106 30 continue
1107
1108 call expvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ierr)
1109 write (iout, '("after expvtt, error = ", i4)' ) ierr
1110 if (ierr .ne. 0) then
1111 call exclos(exoid,ierr)
1112 call exit (0)
1113 endif
1114
1115 c
1116 c for each time step, write the analysis results;
1117 c the code below fills the arrays glob_var_vals,
1118 c nodal_var_vals, and elem_var_vals with values for debugging purposes;
1119 c obviously the analysis code will populate these arrays
1120 c
1121
1122 whole_time_step = 1
1123 num_time_steps = 10
1124
1125 do 110 i = 1, num_time_steps
1126 time_value = real(i)/100.
1127 c
1128 c write time value
1129 c
1130
1131 call exptim (exoid, whole_time_step, time_value, ierr)
1132 write (iout, '("after exptim, error = ", i4)' ) ierr
1133 if (ierr .ne. 0) then
1134 call exclos(exoid,ierr)
1135 call exit (0)
1136 endif
1137
1138 c
1139 c write global variables
1140 c
1141
1142 do 50 j = 1, num_glo_vars
1143 glob_var_vals(j) = real(j+1) * time_value
1144 50 continue
1145
1146 call expgv (exoid, whole_time_step, num_glo_vars,
1147 1 glob_var_vals, ierr)
1148 write (iout, '("after expgv, error = ", i4)' ) ierr
1149 if (ierr .ne. 0) then
1150 call exclos(exoid,ierr)
1151 call exit (0)
1152 endif
1153
1154 c
1155 c write nodal variables
1156 c
1157
1158 do 70 k = 1, num_nod_vars
1159 do 60 j = 1, num_nodes
1160
1161 nodal_var_vals(j) = real(k) + (real(j) * time_value)
1162
1163 60 continue
1164
1165 call expnv (exoid, whole_time_step, k, num_nodes,
1166 1 nodal_var_vals, ierr)
1167 write (iout, '("after expnv, error = ", i4)' ) ierr
1168 if (ierr .ne. 0) then
1169 call exclos(exoid,ierr)
1170 call exit (0)
1171 endif
1172
1173 70 continue
1174
1175 c
1176 c write element variables
1177 c
1178
1179 do 100 k = 1, num_ele_vars
1180 do 90 j = 1, num_elem_blk
1181 do 80 m = 1, num_elem_in_block(j)
1182
1183 elem_var_vals(m) = real(k+1) + real(j+1) +
1184 1 (real(m)*time_value)
1185 c write(iout,*)'elem_var_val(',m,'): ',elem_var_vals(m)
1186
1187 80 continue
1188
1189 call expev (exoid, whole_time_step, k, ebids(j),
1190 1 num_elem_in_block(j), elem_var_vals, ierr)
1191 write (iout, '("after expev, error = ", i4)' ) ierr
1192 if (ierr .ne. 0) then
1193 call exclos(exoid,ierr)
1194 call exit (0)
1195 endif
1196
1197 90 continue
1198 100 continue
1199
1200 whole_time_step = whole_time_step + 1
1201
1202 c
1203 c update the data file; this should be done at the end of every time
1204 c step to ensure that no data is lost if the analysis dies
1205 c
1206 call exupda (exoid, ierr)
1207 write (iout, '("after exupda, error = ", i4)' ) ierr
1208 if (ierr .ne. 0) then
1209 call exclos(exoid,ierr)
1210 call exit (0)
1211 endif
1212
1213 110 continue
1214
1215 c
1216 c close the EXODUS files
1217 c
1218 call exclos (exoid, ierr)
1219 write (iout, '("after exclos, error = ", i4)' ) ierr
1220
1221 stop
1222 end
1223