Exodus 8.24
Loading...
Searching...
No Matches
/exodus_for/test/testwt3.f
1C Copyright(C) 1999-2020 National Technology & Engineering Solutions
2C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
3C NTESS, the U.S. Government retains certain rights in this software.
4C
5C See packages/seacas/LICENSE for details
6
7 program testwt3
8
9c This is a test program for the Fortran binding of the EXODUS II
10c database write routines. This test writes GENISIS (geometry)
11c data to the history file.
12
13c 08/10/93 V.R. Yarberry - Updated for use with 2.01 API
14
15 include 'exodus_app.inc'
16
17 integer iin, iout
18 integer exoid, exoidh, num_dim, num_nodes, num_elem, num_elem_blk
19 integer num_elem_in_block(2), num_node_sets
20 integer num_side_sets, error
21 integer i, j, k, m, elem_map(2), connect(4)
22 integer node_list(10), elem_list(10)
23 integer ebids(2),ids(2), num_nodes_per_set(2), num_elem_per_set(1)
24 integer node_ind(2), elem_ind(1), num_qa_rec, num_info
25 integer num_his_vars, num_glo_vars, num_nod_vars, num_ele_vars
26 integer truth_tab(3,2)
27 integer hist_time_step, whole_time_step, num_time_steps
28 integer cpu_word_size, io_word_size
29
30 real hist_var_vals(10), glob_var_vals(10), nodal_var_vals(8)
31 real time_value, elem_var_vals(20)
32 real x(8), y(8), dummy(1)
33 real attrib(1), dist_fact(8)
34
35 character*(MXLNLN) title
36 character*(MXSTLN) coord_names(3)
37 character*(MXSTLN) cname
38 character*(MXSTLN) var_names(3)
39 character*(MXSTLN) qa_record(4,2)
40 character*(MXLNLN) inform(3)
41
42 logical whole
43
44 data iin /5/, iout /6/
45
46c create EXODUS II files
47
48 cpu_word_size = 4
49 io_word_size = 4
50
51c first create a "regular" file that contains everything except
52c history variable info
53
54 exoid = excre("test.exo",
55 1 "r", exclob, cpu_word_size, io_word_size, ierr)
56 write (iout,'("after excre for test.exo, id: ", i3)') exoid
57 write (iout,'("after excre, error = ", i3)') ierr
58
59c create a "history" file if you will output history variables
60
61 exoidh = excre("testh.exo",
62 1 "h", exclob, cpu_word_size, io_word_size, ierr)
63 write (iout,'("after excre for testh.exo, id: ", i3)') exoidh
64 write (iout,'("after excre, error = ", i3)') ierr
65
66c initialize file with parameters
67
68 title = "This is test 3 - genisis data in history file"
69 num_dim = 2
70 num_nodes = 8
71 num_elem = 2
72 num_elem_blk = 2
73 num_node_sets = 2
74 num_side_sets = 1
75
76 call expini (exoid, title, num_dim, num_nodes,
77 1 num_elem, num_elem_blk, num_node_sets,
78 2 num_side_sets, ierr)
79
80 write (iout, '("after expini, error = ", i3)' ) ierr
81
82 call expini (exoidh, title, num_dim, num_nodes,
83 1 num_elem, num_elem_blk, num_node_sets,
84 2 num_side_sets, ierr)
85
86 write (iout, '("after expini (h), error = ", i3)' ) ierr
87
88c write nodal coordinates values and names to database
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
122c write element order map
123
124 do 10 i = 1, num_elem
125 elem_map(i) = i
12610 continue
127
128 call expmap (exoid, elem_map, ierr)
129 write (iout, '("after expmap, error = ", i3)' ) ierr
130
131 call expmap (exoidh, elem_map, ierr)
132 write (iout, '("after expmap (h), error = ", i3)' ) ierr
133
134c write element block parameters
135
136 num_elem_in_block(1) = 1
137 num_elem_in_block(2) = 1
138
139 ebids(1) = 10
140 ebids(2) = 11
141
142 cname = "quadjunk"
143
144 call expelb (exoid, ebids(1), cname, num_elem_in_block(1),
145 1 4,1,ierr)
146 write (iout, '("after expelb, error = ", i3)' ) ierr
147
148 call expelb (exoid, ebids(2), cname, num_elem_in_block(2),
149 1 4,1,ierr)
150 write (iout, '("after expelb, error = ", i3)' ) ierr
151
152 call expelb (exoidh, ebids(1), cname, num_elem_in_block(1),
153 1 4,1,ierr)
154 write (iout, '("after expelb (h), error = ", i3)' ) ierr
155
156 call expelb (exoidh, ebids(2), cname, num_elem_in_block(2),
157 1 4,1,ierr)
158 write (iout, '("after expelbi(h), error = ", i3)' ) ierr
159
160c write element connectivity
161
162 connect(1) = 1
163 connect(2) = 2
164 connect(3) = 3
165 connect(4) = 4
166
167 call expelc (exoid, ebids(1), connect, ierr)
168 write (iout, '("after expelc, error = ", i3)' ) ierr
169
170 call expelc (exoidh, ebids(1), connect, ierr)
171 write (iout, '("after expelci (h), error = ", i3)' ) ierr
172
173 connect(1) = 5
174 connect(2) = 6
175 connect(3) = 7
176 connect(4) = 8
177
178 call expelc (exoid, ebids(2), connect, ierr)
179 write (iout, '("after expelc, error = ", i3)' ) ierr
180
181 call expelc (exoidh, ebids(2), connect, ierr)
182 write (iout, '("after expelc (h), error = ", i3)' ) ierr
183
184c write element block attributes
185
186 attrib(1) = 3.14159
187 call expeat (exoid, ebids(1), attrib, ierr)
188 write (iout, '("after expeat, error = ", i3)' ) ierr
189
190 call expeat (exoidh, ebids(1), attrib, ierr)
191 write (iout, '("after expeat (h), error = ", i3)' ) ierr
192
193 attrib(1) = 6.14159
194 call expeat (exoid, ebids(2), attrib, ierr)
195 write (iout, '("after expeat, error = ", i3)' ) ierr
196
197 call expeat (exoidh, ebids(2), attrib, ierr)
198 write (iout, '("after expeat (h), error = ", i3)' ) ierr
199
200c write individual node sets
201
202 call expnp (exoid, 20, 5, ierr)
203 write (iout, '("after expnp, error = ", i3)' ) ierr
204
205 call expnp (exoidh, 20, 5, ierr)
206 write (iout, '("after expnp (h), error = ", i3)' ) ierr
207
208 node_list(1) = 100
209 node_list(2) = 101
210 node_list(3) = 102
211 node_list(4) = 103
212 node_list(5) = 104
213
214 dist_fact(1) = 1.0
215 dist_fact(2) = 2.0
216 dist_fact(3) = 3.0
217 dist_fact(4) = 4.0
218 dist_fact(5) = 5.0
219
220 call expns (exoid, 20, node_list, dist_fact, ierr)
221 write (iout, '("after expns, error = ", i3)' ) ierr
222
223 call expns (exoidh, 20, node_list, dist_fact, ierr)
224 write (iout, '("after expns (h), error = ", i3)' ) ierr
225
226 call expnp (exoid, 21, 3, ierr)
227 write (iout, '("after expnp, error = ", i3)' ) ierr
228
229 call expnp (exoidh, 21, 3, ierr)
230 write (iout, '("after expnp (h), error = ", i3)' ) ierr
231
232 node_list(1) = 200
233 node_list(2) = 201
234 node_list(3) = 202
235
236 dist_fact(1) = 1.1
237 dist_fact(2) = 2.1
238 dist_fact(3) = 3.1
239
240 call expns (exoid, 21, node_list, dist_fact, ierr)
241 write (iout, '("after expns, error = ", i3)' ) ierr
242
243 call expns (exoidh, 21, node_list, dist_fact, ierr)
244 write (iout, '("after expns (h), error = ", i3)' ) ierr
245
246c write concatenated node sets; this produces the same information as
247c the above code which writes individual node sets
248
249c ids(1) = 20
250c ids(2) = 21
251
252c num_nodes_per_set(1) = 5
253c num_nodes_per_set(2) = 3
254
255c node_ind(1) = 1
256c node_ind(2) = 6
257
258c node_list(1) = 100
259c node_list(2) = 101
260c node_list(3) = 102
261c node_list(4) = 103
262c node_list(5) = 104
263c node_list(6) = 200
264c node_list(7) = 201
265c node_list(8) = 202
266
267c dist_fact(1) = 1.0
268c dist_fact(2) = 2.0
269c dist_fact(3) = 3.0
270c dist_fact(4) = 4.0
271c dist_fact(5) = 5.0
272c dist_fact(6) = 1.1
273c dist_fact(7) = 2.1
274c dist_fact(8) = 3.1
275
276c call expcns (exoid, ids, num_nodes_per_set, node_ind, node_list,
277c 1 dist_fact, ierr)
278c write (iout, '("after expcns, error = ", i3)' ) ierr
279
280c write individual side sets
281
282 call expsp (exoid, 30, 2, 4, ierr)
283 write (iout, '("after expsp, error = ", i3)' ) ierr
284
285 call expsp (exoidh, 30, 2, 4, ierr)
286 write (iout, '("after expsp (h), error = ", i3)' ) ierr
287
288 elem_list(1) = 1
289 elem_list(2) = 2
290
291 node_list(1) = 1
292 node_list(2) = 2
293 node_list(3) = 3
294 node_list(4) = 4
295
296 dist_fact(1) = 0.0
297 dist_fact(2) = 0.0
298 dist_fact(3) = 0.0
299 dist_fact(4) = 0.0
300
301 call expss (exoid, 30, elem_list, node_list, ierr)
302 write (iout, '("after expss, error = ", i3)' ) ierr
303
304 call expssd (exoid, 30, dist_fact, ierr)
305 write (iout, '("after expssd, error = ", i3)' ) ierr
306
307 call expss (exoidh, 30, elem_list, node_list, ierr)
308 write (iout, '("after expss (h), error = ", i3)' ) ierr
309
310 call expssd (exoidh, 30, dist_fact, ierr)
311 write (iout, '("after expssd (h), error = ", i3)' ) ierr
312
313c write concatenated side sets; this produces the same information as
314c the above code which writes individual side sets
315
316c ids(1) = 30
317
318c num_elem_per_set(1) = 2
319
320c num_nodes_per_set(1) = 4
321
322c elem_ind(1) = 1
323
324c node_ind(1) = 1
325
326c elem_list(1) = 1
327c elem_list(2) = 2
328
329c node_list(1) = 1
330c node_list(2) = 2
331c node_list(3) = 3
332c node_list(4) = 4
333
334c dist_fact(1) = 0.0
335c dist_fact(2) = 0.0
336c dist_fact(3) = 0.0
337c dist_fact(4) = 0.0
338
339c call expcss (exoid, ids, num_elem_per_set, num_nodes_per_set,
340c 1 elem_ind, node_ind, elem_list, node_list, dist_fact,
341c 2 ierr)
342c write (iout, '("after expcss, error = ", i3)' ) ierr
343
344c write QA records
345
346 num_qa_rec = 2
347
348 qa_record(1,1) = "PRONTO2D"
349 qa_record(2,1) = "pronto2d"
350 qa_record(3,1) = "3/10/92"
351 qa_record(4,1) = "15:41:33"
352 qa_record(1,2) = "FASTQ"
353 qa_record(2,2) = "fastq"
354 qa_record(3,2) = "2/10/92"
355 qa_record(4,2) = "11:41:33"
356
357 call expqa (exoid, num_qa_rec, qa_record, ierr)
358 write (iout, '("after expqa, error = ", i3)' ) ierr
359
360 call expqa (exoidh, num_qa_rec, qa_record, ierr)
361 write (iout, '("after expqa (h), error = ", i3)' ) ierr
362
363c write information records
364
365 num_info = 3
366
367 inform(1) = "This is the first information record."
368 inform(2) = "This is the second information record."
369 inform(3) = "This is the third information record."
370
371 call expinf (exoid, num_info, inform, ierr)
372 write (iout, '("after expinf, error = ", i3)' ) ierr
373
374 call expinf (exoidh, num_info, inform, ierr)
375 write (iout, '("after expinf (h), error = ", i3)' ) ierr
376
377c write results variables parameters and names
378
379 num_his_vars = 1
380
381 var_names(1) = "his_vars"
382
383 call expvp (exoidh, "h", num_his_vars, ierr)
384 write (iout, '("after expvp, error = ", i3)' ) ierr
385 call expvan (exoidh, "h", num_his_vars, var_names, ierr)
386 write (iout, '("after expvan, error = ", i3)' ) ierr
387
388 num_glo_vars = 1
389
390 var_names(1) = "glo_vars"
391
392 call expvp (exoid, "g", num_glo_vars, ierr)
393 write (iout, '("after expvp, error = ", i3)' ) ierr
394 call expvan (exoid, "g", num_glo_vars, var_names, ierr)
395 write (iout, '("after expvan, error = ", i3)' ) ierr
396
397 num_nod_vars = 2
398
399 var_names(1) = "nod_var0"
400 var_names(2) = "nod_var1"
401
402 call expvp (exoid, "n", num_nod_vars, ierr)
403 write (iout, '("after expvp, error = ", i3)' ) ierr
404 call expvan (exoid, "n", num_nod_vars, var_names, ierr)
405 write (iout, '("after expvan, error = ", i3)' ) ierr
406
407 num_ele_vars = 3
408
409 var_names(1) = "ele_var0"
410 var_names(2) = "ele_var1"
411 var_names(3) = "ele_var2"
412
413 call expvp (exoid, "e", num_ele_vars, ierr)
414 write (iout, '("after expvp, error = ", i3)' ) ierr
415 call expvan (exoid, "e", num_ele_vars, var_names, ierr)
416 write (iout, '("after expvan, error = ", i3)' ) ierr
417
418c write element variable truth table
419
420 k = 0
421
422 do 30 i = 1,num_elem_blk
423 do 20 j = 1,num_ele_vars
424 truth_tab(j,i) = 1
42520 continue
42630 continue
427
428 call exgebi (exoid, ebids, ierr)
429 write (iout, '("after exgebi, error = ", i3)' ) ierr
430 call expvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ebids,
431 & ierr)
432 write (iout, '("after expvtt, error = ", i3)' ) ierr
433
434c for each time step, write the analysis results;
435c the code below fills the arrays hist_var_vals, glob_var_vals,
436c nodal_var_vals, and elem_var_vals with values for debugging purposes;
437c obviously the analysis code will populate these arrays
438
439 whole = .true.
440 hist_time_step = 1
441 whole_time_step = 1
442 num_time_steps = 10
443
444 do 110 i = 1, num_time_steps
445 time_value = real(i)/100
446
447c if history time step
448
449c write time value to history file
450
451 call exptim (exoidh, hist_time_step, time_value, ierr)
452 write (iout, '("after exptim, error = ", i3)' ) ierr
453
454c write history variables to history file
455
456 do 40 j = 1, num_his_vars
457 hist_var_vals(j) = real(j+1) * time_value
45840 continue
459
460 call exphv (exoidh, hist_time_step, num_his_vars,
461 1 hist_var_vals, ierr)
462 write (iout, '("after exphv, error = ", i3)' ) ierr
463
464 hist_time_step = hist_time_step + 1
465
466c update the history file
467
468 call exupda (exoidh, ierr)
469 write (iout, '("after exupda, error = ", i3)' ) ierr
470
471c if whole time step
472
473 if (whole) then
474
475c write time value to regular file
476
477 call exptim (exoid, whole_time_step, time_value, ierr)
478 write (iout, '("after exptim, error = ", i3)' ) ierr
479
480c write global variables
481
482 do 50 j = 1, num_glo_vars
483 glob_var_vals(j) = real(j+1) * time_value
48450 continue
485
486 call expgv (exoid, whole_time_step, num_glo_vars,
487 1 glob_var_vals, ierr)
488 write (iout, '("after expgv, error = ", i3)' ) ierr
489
490c write nodal variables
491
492 do 70 k = 1, num_nod_vars
493 do 60 j = 1, num_nodes
494
495 nodal_var_vals(j) = real(k) + (real(j) * time_value)
496
49760 continue
498
499 call expnv (exoid, whole_time_step, k, num_nodes,
500 1 nodal_var_vals, ierr)
501 write (iout, '("after expnv, error = ", i3)' ) ierr
502
50370 continue
504
505c write element variables
506
507 do 100 k = 1, num_ele_vars
508 do 90 j = 1, num_elem_blk
509 do 80 m = 1, num_elem_in_block(j)
510
511 elem_var_vals(m) = real(k+1) + real(j+1) +
512 1 (real(m)*time_value)
513
51480 continue
515
516 call expev (exoid, whole_time_step, k, ebids(j),
517 1 num_elem_in_block(j), elem_var_vals, ierr)
518 write (iout, '("after expev, error = ", i3)' ) ierr
519
52090 continue
521100 continue
522
523 whole_time_step = whole_time_step + 1
524
525c update the data file; this should be done at the end of every time
526c step to ensure that no data is lost if the analysis dies
527
528 call exupda (exoid, ierr)
529 write (iout, '("after exupda, error = ", i3)' ) ierr
530
531 endif
532
533110 continue
534
535c close the EXODUS files
536
537 call exclos (exoid, ierr)
538 write (iout, '("after exclos, error = ", i3)' ) ierr
539
540 call exclos (exoidh, ierr)
541 write (iout, '("after exclos, error = ", i3)' ) ierr
542
543 stop
544 end
#define real
Definition exo_jack-windows.c:59
void expgv(int *idexo, int *time_step, int *num_glob_vars, real *glob_var_vals, int *ierr)
Definition exo_jack.c:2184
int excre(char *path, int *clobmode, int *cpu_word_size, int *io_word_size, int *ierr, int pathlen)
Definition exo_jack.c:179
void expini(int *idexo, char *title, void_int *num_dim, void_int *num_nodes, void_int *num_elem, void_int *num_elem_blk, void_int *num_node_sets, void_int *num_side_sets, int *ierr, int titlelen)
Definition exo_jack.c:242
void exgebi(int *idexo, void_int *elem_blk_ids, int *ierr)
Definition exo_jack.c:837
void expcor(int *idexo, real *x_coor, real *y_coor, real *z_coor, int *ierr)
Definition exo_jack.c:558
void expnp(int *idexo, entity_id *node_set_id, void_int *num_nodes_in_set, void_int *num_dist_in_set, int *ierr)
Definition exo_jack.c:1505
void expssd(int *idexo, entity_id *side_set_id, real *side_set_dist_fact, int *ierr)
Definition exo_jack.c:1744
void expnv(int *idexo, int *time_step, int *nodal_var_index, void_int *num_nodes, real *nodal_var_vals, int *ierr)
Definition exo_jack.c:2215
void expsp(int *idexo, entity_id *side_set_id, void_int *num_sides_in_set, void_int *num_df_in_set, int *ierr)
Definition exo_jack.c:1686
void expvan(int *idexo, char *var_type, int *num_vars, char *var_names, int *ierr, int var_typelen, int var_nameslen)
Definition exo_jack.c:1942
void expqa(int *idexo, int *num_qa_records, char *qa_record, int *ierr, int qa_recordlen)
Definition exo_jack.c:313
void expeat(int *idexo, entity_id *elem_blk_id, real *attrib, int *ierr)
Definition exo_jack.c:928
void exclos(int *idexo, int *ierr)
Definition exo_jack.c:230
void expev(int *idexo, int *time_step, int *elem_var_index, entity_id *elem_blk_id, void_int *num_elem_this_blk, real *elem_var_vals, int *ierr)
Definition exo_jack.c:2270
void expss(int *idexo, entity_id *side_set_id, void_int *side_set_elem_list, void_int *side_set_side_list, int *ierr)
Definition exo_jack.c:1724
void expelb(int *idexo, entity_id *elem_blk_id, char *elem_type, void_int *num_elem_this_blk, void_int *num_nodes_per_elem, void_int *num_attr, int *ierr, int elem_typelen)
Definition exo_jack.c:764
void expvtt(int *idexo, int *num_entity, int *num_var, int *var_tab, int *ierr)
Definition exo_jack.c:2062
void expns(int *idexo, entity_id *node_set_id, void_int *node_set_node_list, int *ierr)
Definition exo_jack.c:1534
void expmap(int *idexo, void_int *elem_map, int *ierr)
Definition exo_jack.c:695
void expelc(int *idexo, entity_id *elem_blk_id, void_int *connect, int *ierr)
Definition exo_jack.c:846
void expcon(int *idexo, char *coord_names, int *ierr, int coord_nameslen)
Definition exo_jack.c:576
void expinf(int *idexo, int *num_info, char *info, int *ierr, int infolen)
Definition exo_jack.c:449
void expvp(int *idexo, char *var_type, int *num_vars, int *ierr, int var_typelen)
Definition exo_jack.c:1920
void exupda(int *idexo, int *ierr)
Definition exo_jack.c:236
void exptim(int *idexo, int *time_step, real *time_value, int *ierr)
Definition exo_jack.c:2399