Exodus 7.21

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