Exodus 7.21

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