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