Exodus 7.21

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