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