1      program testwt3
2c
3c This is a test program for the Fortran binding of the EXODUS II
4c database write routines. This test writes GENISIS (geometry)
5c data to the history file.
6c
7c     08/10/93	V.R. Yarberry - Updated for use with 2.01 API
8
9      include 'exodus_app.inc'
10
11      integer iin, iout
12      integer exoid, exoidh, num_dim, num_nodes, num_elem, num_elem_blk
13      integer num_elem_in_block(2), num_node_sets
14      integer num_side_sets, error
15      integer i, j, k, m, elem_map(2), connect(4)
16      integer node_list(10), elem_list(10)
17      integer ebids(2),ids(2), num_nodes_per_set(2), num_elem_per_set(1)
18      integer node_ind(2), elem_ind(1), num_qa_rec, num_info
19      integer num_his_vars, num_glo_vars, num_nod_vars, num_ele_vars
20      integer truth_tab(3,2)
21      integer hist_time_step, whole_time_step, num_time_steps
22      integer cpu_word_size, io_word_size
23
24      real hist_var_vals(10), glob_var_vals(10), nodal_var_vals(8)
25      real time_value, elem_var_vals(20)
26      real x(8), y(8), dummy(1)
27      real attrib(1), dist_fact(8)
28
29      character*(MXLNLN) title
30      character*(MXSTLN) coord_names(3)
31      character*(MXSTLN) cname
32      character*(MXSTLN) var_names(3)
33      character*(MXSTLN) qa_record(4,2)
34      character*(MXLNLN) inform(3)
35
36      logical whole
37
38      data iin /5/, iout /6/
39
40c
41c  create EXODUS II files
42c
43      cpu_word_size = 4
44      io_word_size = 4
45c
46c     first create a "regular" file that contains everything except
47c     history variable info
48c
49      exoid = excre ("test.exo",
50     1               "r", EXCLOB, cpu_word_size, io_word_size, ierr)
51      write (iout,'("after excre for test.exo, id: ", i3)') exoid
52      write (iout,'("after excre, error = ", i3)') ierr
53
54c
55c     create a "history" file if you will output history variables
56c
57      exoidh = excre ("testh.exo",
58     1               "h", EXCLOB, cpu_word_size, io_word_size, ierr)
59      write (iout,'("after excre for testh.exo, id: ", i3)') exoidh
60      write (iout,'("after excre, error = ", i3)') ierr
61
62c
63c  initialize file with parameters
64c
65
66      title = "This is test 3 - genisis data in history file"
67      num_dim = 2
68      num_nodes = 8
69      num_elem = 2
70      num_elem_blk = 2
71      num_node_sets = 2
72      num_side_sets = 1
73
74      call expini (exoid, title, num_dim, num_nodes,
75     1             num_elem, num_elem_blk, num_node_sets,
76     2             num_side_sets, ierr)
77
78      write (iout, '("after expini, error = ", i3)' ) ierr
79
80      call expini (exoidh, title, num_dim, num_nodes,
81     1             num_elem, num_elem_blk, num_node_sets,
82     2             num_side_sets, ierr)
83
84      write (iout, '("after expini (h), error = ", i3)' ) ierr
85
86c
87c  write nodal coordinates values and names to database
88c
89
90      x(1) = 0.0
91      x(2) = 1.0
92      x(3) = 1.0
93      x(4) = 0.0
94      x(5) = 1.0
95      x(6) = 2.0
96      x(7) = 2.0
97      x(8) = 1.0
98      y(1) = 0.0
99      y(2) = 0.0
100      y(3) = 1.0
101      y(4) = 1.0
102      y(5) = 0.0
103      y(6) = 0.0
104      y(7) = 1.0
105      y(8) = 1.0
106
107      call expcor (exoid, x, y, dummy, ierr)
108      write (iout, '("after expcor, error = ", i3)' ) ierr
109
110      call expcor (exoidh, x, y, dummy, ierr)
111      write (iout, '("after expcor (h), error = ", i3)' ) ierr
112
113      coord_names(1) = "xcoorjun"
114      coord_names(2) = "ycoorjun"
115
116      call expcon (exoid, coord_names, ierr)
117      write (iout, '("after expcon, error = ", i3)' ) ierr
118
119      call expcon (exoidh, coord_names, ierr)
120      write (iout, '("after expcon (h), error = ", i3)' ) ierr
121
122
123c
124c write element order map
125c
126
127      do 10 i = 1, num_elem
128         elem_map(i) = i
12910    continue
130
131      call expmap (exoid, elem_map, ierr)
132      write (iout, '("after expmap, error = ", i3)' ) ierr
133
134      call expmap (exoidh, elem_map, ierr)
135      write (iout, '("after expmap (h), error = ", i3)' ) ierr
136
137c
138c write element block parameters
139c
140
141      num_elem_in_block(1) = 1
142      num_elem_in_block(2) = 1
143
144      ebids(1) = 10
145      ebids(2) = 11
146
147      cname = "quadjunk"
148
149      call expelb (exoid, ebids(1), cname, num_elem_in_block(1),
150     1		 4,1,ierr)
151      write (iout, '("after expelb, error = ", i3)' ) ierr
152
153      call expelb (exoid, ebids(2), cname, num_elem_in_block(2),
154     1		4,1,ierr)
155      write (iout, '("after expelb, error = ", i3)' ) ierr
156
157      call expelb (exoidh, ebids(1), cname, num_elem_in_block(1),
158     1		4,1,ierr)
159      write (iout, '("after expelb (h), error = ", i3)' ) ierr
160
161      call expelb (exoidh, ebids(2), cname, num_elem_in_block(2),
162     1		 4,1,ierr)
163      write (iout, '("after expelbi(h), error = ", i3)' ) ierr
164
165c
166c write element connectivity
167c
168
169      connect(1) = 1
170      connect(2) = 2
171      connect(3) = 3
172      connect(4) = 4
173
174      call expelc (exoid, ebids(1), connect, ierr)
175      write (iout, '("after expelc, error = ", i3)' ) ierr
176
177      call expelc (exoidh, ebids(1), connect, ierr)
178      write (iout, '("after expelci (h), error = ", i3)' ) ierr
179
180      connect(1) = 5
181      connect(2) = 6
182      connect(3) = 7
183      connect(4) = 8
184
185      call expelc (exoid, ebids(2), connect, ierr)
186      write (iout, '("after expelc, error = ", i3)' ) ierr
187
188      call expelc (exoidh, ebids(2), connect, ierr)
189      write (iout, '("after expelc (h), error = ", i3)' ) ierr
190
191c
192c write element block attributes
193c
194
195      attrib(1) = 3.14159
196      call expeat (exoid, ebids(1), attrib, ierr)
197      write (iout, '("after expeat, error = ", i3)' ) ierr
198
199      call expeat (exoidh, ebids(1), attrib, ierr)
200      write (iout, '("after expeat (h), error = ", i3)' ) ierr
201
202      attrib(1) = 6.14159
203      call expeat (exoid, ebids(2), attrib, ierr)
204      write (iout, '("after expeat, error = ", i3)' ) ierr
205
206      call expeat (exoidh, ebids(2), attrib, ierr)
207      write (iout, '("after expeat (h), error = ", i3)' ) ierr
208
209c
210c write individual node sets
211c
212
213      call expnp (exoid, 20, 5, ierr)
214      write (iout, '("after expnp, error = ", i3)' ) ierr
215
216      call expnp (exoidh, 20, 5, ierr)
217      write (iout, '("after expnp (h), error = ", i3)' ) ierr
218
219      node_list(1) = 100
220      node_list(2) = 101
221      node_list(3) = 102
222      node_list(4) = 103
223      node_list(5) = 104
224
225      dist_fact(1) = 1.0
226      dist_fact(2) = 2.0
227      dist_fact(3) = 3.0
228      dist_fact(4) = 4.0
229      dist_fact(5) = 5.0
230
231      call expns (exoid, 20, node_list, dist_fact, ierr)
232      write (iout, '("after expns, error = ", i3)' ) ierr
233
234      call expns (exoidh, 20, node_list, dist_fact, ierr)
235      write (iout, '("after expns (h), error = ", i3)' ) ierr
236
237      call expnp (exoid, 21, 3, ierr)
238      write (iout, '("after expnp, error = ", i3)' ) ierr
239
240      call expnp (exoidh, 21, 3, ierr)
241      write (iout, '("after expnp (h), error = ", i3)' ) ierr
242
243      node_list(1) = 200
244      node_list(2) = 201
245      node_list(3) = 202
246
247      dist_fact(1) = 1.1
248      dist_fact(2) = 2.1
249      dist_fact(3) = 3.1
250
251      call expns (exoid, 21, node_list, dist_fact, ierr)
252      write (iout, '("after expns, error = ", i3)' ) ierr
253
254      call expns (exoidh, 21, node_list, dist_fact, ierr)
255      write (iout, '("after expns (h), error = ", i3)' ) ierr
256
257c
258c write concatenated node sets; this produces the same information as
259c the above code which writes individual node sets
260c
261
262c     ids(1) = 20
263c     ids(2) = 21
264
265c     num_nodes_per_set(1) = 5
266c     num_nodes_per_set(2) = 3
267
268c     node_ind(1) = 1
269c     node_ind(2) = 6
270
271c     node_list(1) = 100
272c     node_list(2) = 101
273c     node_list(3) = 102
274c     node_list(4) = 103
275c     node_list(5) = 104
276c     node_list(6) = 200
277c     node_list(7) = 201
278c     node_list(8) = 202
279
280c     dist_fact(1) = 1.0
281c     dist_fact(2) = 2.0
282c     dist_fact(3) = 3.0
283c     dist_fact(4) = 4.0
284c     dist_fact(5) = 5.0
285c     dist_fact(6) = 1.1
286c     dist_fact(7) = 2.1
287c     dist_fact(8) = 3.1
288
289c     call expcns (exoid, ids, num_nodes_per_set, node_ind, node_list,
290c    1        dist_fact, ierr)
291c     write (iout, '("after expcns, error = ", i3)' ) ierr
292
293c
294c write individual side sets
295c
296
297      call expsp (exoid, 30, 2, 4, ierr)
298      write (iout, '("after expsp, error = ", i3)' ) ierr
299
300      call expsp (exoidh, 30, 2, 4, ierr)
301      write (iout, '("after expsp (h), error = ", i3)' ) ierr
302
303      elem_list(1) = 1
304      elem_list(2) = 2
305
306      node_list(1) = 1
307      node_list(2) = 2
308      node_list(3) = 3
309      node_list(4) = 4
310
311      dist_fact(1) = 0.0
312      dist_fact(2) = 0.0
313      dist_fact(3) = 0.0
314      dist_fact(4) = 0.0
315
316      call expss (exoid, 30, elem_list, node_list, ierr)
317      write (iout, '("after expss, error = ", i3)' ) ierr
318
319      call expssd (exoid, 30, dist_fact, ierr)
320      write (iout, '("after expssd, error = ", i3)' ) ierr
321
322      call expss (exoidh, 30, elem_list, node_list, ierr)
323      write (iout, '("after expss (h), error = ", i3)' ) ierr
324
325      call expssd (exoidh, 30, dist_fact, ierr)
326      write (iout, '("after expssd (h), error = ", i3)' ) ierr
327
328c
329c write concatenated side sets; this produces the same information as
330c the above code which writes individual side sets
331c
332
333c      ids(1) = 30
334
335c      num_elem_per_set(1) = 2
336
337c      num_nodes_per_set(1) = 4
338
339c      elem_ind(1) = 1
340
341c      node_ind(1) = 1
342
343c      elem_list(1) = 1
344c      elem_list(2) = 2
345
346c      node_list(1) = 1
347c      node_list(2) = 2
348c      node_list(3) = 3
349c      node_list(4) = 4
350
351c      dist_fact(1) = 0.0
352c      dist_fact(2) = 0.0
353c      dist_fact(3) = 0.0
354c      dist_fact(4) = 0.0
355
356c      call expcss (exoid, ids, num_elem_per_set, num_nodes_per_set,
357c     1             elem_ind, node_ind, elem_list, node_list, dist_fact,
358c     2             ierr)
359c      write (iout, '("after expcss, error = ", i3)' ) ierr
360
361c
362c write QA records
363c
364
365      num_qa_rec = 2
366
367      qa_record(1,1) = "PRONTO2D"
368      qa_record(2,1) = "pronto2d"
369      qa_record(3,1) = "3/10/92"
370      qa_record(4,1) = "15:41:33"
371      qa_record(1,2) = "FASTQ"
372      qa_record(2,2) = "fastq"
373      qa_record(3,2) = "2/10/92"
374      qa_record(4,2) = "11:41:33"
375
376      call expqa (exoid, num_qa_rec, qa_record, ierr)
377      write (iout, '("after expqa, error = ", i3)' ) ierr
378
379      call expqa (exoidh, num_qa_rec, qa_record, ierr)
380      write (iout, '("after expqa (h), error = ", i3)' ) ierr
381
382
383c
384c write information records
385c
386
387      num_info = 3
388
389      inform(1) = "This is the first information record."
390      inform(2) = "This is the second information record."
391      inform(3) = "This is the third information record."
392
393      call expinf (exoid, num_info, inform, ierr)
394      write (iout, '("after expinf, error = ", i3)' ) ierr
395
396      call expinf (exoidh, num_info, inform, ierr)
397      write (iout, '("after expinf (h), error = ", i3)' ) ierr
398
399
400c write results variables parameters and names
401
402      num_his_vars = 1
403
404      var_names(1) = "his_vars"
405
406      call expvp (exoidh, "h", num_his_vars, ierr)
407      write (iout, '("after expvp, error = ", i3)' ) ierr
408      call expvan (exoidh, "h", num_his_vars, var_names, ierr)
409      write (iout, '("after expvan, error = ", i3)' ) ierr
410
411
412      num_glo_vars = 1
413
414      var_names(1) = "glo_vars"
415
416      call expvp (exoid, "g", num_glo_vars, ierr)
417      write (iout, '("after expvp, error = ", i3)' ) ierr
418      call expvan (exoid, "g", num_glo_vars, var_names, ierr)
419      write (iout, '("after expvan, error = ", i3)' ) ierr
420
421
422      num_nod_vars = 2
423
424      var_names(1) = "nod_var0"
425      var_names(2) = "nod_var1"
426
427      call expvp (exoid, "n", num_nod_vars, ierr)
428      write (iout, '("after expvp, error = ", i3)' ) ierr
429      call expvan (exoid, "n", num_nod_vars, var_names, ierr)
430      write (iout, '("after expvan, error = ", i3)' ) ierr
431
432
433      num_ele_vars = 3
434
435      var_names(1) = "ele_var0"
436      var_names(2) = "ele_var1"
437      var_names(3) = "ele_var2"
438
439      call expvp (exoid, "e", num_ele_vars, ierr)
440      write (iout, '("after expvp, error = ", i3)' ) ierr
441      call expvan (exoid, "e", num_ele_vars, var_names, ierr)
442      write (iout, '("after expvan, error = ", i3)' ) ierr
443
444c
445c write element variable truth table
446c
447
448      k = 0
449
450      do 30 i = 1,num_elem_blk
451         do 20 j = 1,num_ele_vars
452            truth_tab(j,i) = 1
45320       continue
45430    continue
455
456      call exgebi (exoid, ebids, ierr)
457      write (iout, '("after exgebi, error = ", i3)' ) ierr
458      call expvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ebids,
459     &             ierr)
460      write (iout, '("after expvtt, error = ", i3)' ) ierr
461
462c
463c for each time step, write the analysis results;
464c the code below fills the arrays hist_var_vals, glob_var_vals,
465c nodal_var_vals, and elem_var_vals with values for debugging purposes;
466c obviously the analysis code will populate these arrays
467c
468
469      whole = .true.
470      hist_time_step = 1
471      whole_time_step = 1
472      num_time_steps = 10
473
474      do 110 i = 1, num_time_steps
475         time_value = real(i)/100
476
477c
478c if history time step
479c
480
481c
482c write time value to history file
483c
484
485         call exptim (exoidh, hist_time_step, time_value, ierr)
486         write (iout, '("after exptim, error = ", i3)' ) ierr
487
488c
489c write history variables to history file
490c
491
492         do 40 j = 1, num_his_vars
493            hist_var_vals(j) = real(j+1) * time_value
49440       continue
495
496         call exphv (exoidh, hist_time_step, num_his_vars,
497     1               hist_var_vals, ierr)
498         write (iout, '("after exphv, error = ", i3)' ) ierr
499
500         hist_time_step = hist_time_step + 1
501c
502c update the history file
503c
504
505         call exupda (exoidh, ierr)
506         write (iout, '("after exupda, error = ", i3)' ) ierr
507
508c
509c if whole time step
510c
511
512         if (whole) then
513
514c
515c write time value to regular file
516c
517
518            call exptim (exoid, whole_time_step, time_value, ierr)
519            write (iout, '("after exptim, error = ", i3)' ) ierr
520
521c
522c write global variables
523c
524
525            do 50 j = 1, num_glo_vars
526               glob_var_vals(j) = real(j+1) * time_value
52750          continue
528
529            call expgv (exoid, whole_time_step, num_glo_vars,
530     1                  glob_var_vals, ierr)
531            write (iout, '("after expgv, error = ", i3)' ) ierr
532
533c
534c write nodal variables
535c
536
537            do 70 k = 1, num_nod_vars
538               do 60 j = 1, num_nodes
539
540                  nodal_var_vals(j) = real(k) + (real(j) * time_value)
541
54260             continue
543
544               call expnv (exoid, whole_time_step, k, num_nodes,
545     1                     nodal_var_vals, ierr)
546               write (iout, '("after expnv, error = ", i3)' ) ierr
547
54870          continue
549
550c
551c write element variables
552c
553
554            do 100 k = 1, num_ele_vars
555               do 90 j = 1, num_elem_blk
556                  do 80 m = 1, num_elem_in_block(j)
557
558                     elem_var_vals(m) = real(k+1) + real(j+1) +
559     1                                  (real(m)*time_value)
560
56180                continue
562
563                  call expev (exoid, whole_time_step, k, ebids(j),
564     1                        num_elem_in_block(j), elem_var_vals, ierr)
565                  write (iout, '("after expev, error = ", i3)' ) ierr
566
56790             continue
568100         continue
569
570            whole_time_step = whole_time_step + 1
571
572c
573c update the data file; this should be done at the end of every time
574c step to ensure that no data is lost if the analysis dies
575c
576            call exupda (exoid, ierr)
577            write (iout, '("after exupda, error = ", i3)' ) ierr
578
579         endif
580
581110   continue
582
583c
584c close the EXODUS files
585c
586      call exclos (exoid, ierr)
587      write (iout, '("after exclos, error = ", i3)' ) ierr
588
589      call exclos (exoidh, ierr)
590      write (iout, '("after exclos, error = ", i3)' ) ierr
591
592      stop
593      end
594
595