/contrib/exodusii/5.22b/exodus/forbind/test/testwt2.f
FORTRAN Legacy | 1432 lines | 778 code | 322 blank | 332 comment | 0 complexity | 5427fe08b528e0765453606fb3ccaa60 MD5 | raw file
1 program testwt2 2c 3c This is a test program for the Fortran binding of the EXODUS II 4c database write routines. It tests multiple simultaneous output files. 5c 6c 09/07/93 V.R. Yarberry - Revised for 2.00 API 7 8 include 'exodusII.inc' 9 10 integer iin, iout 11 integer exoid, num_dim, num_nodes, num_elem, num_elem_blk 12 integer exoid2, num_dim2, num_nodes2, num_elem2, num_elem_blk2 13 integer num_elem_in_block(10), num_node_sets 14 integer num_elem_in_block2(10), num_node_sets2 15 integer num_side_sets, num_nodes_per_elem(10), numattr(10) 16 integer num_side_sets2, num_nodes_per_elem2(10), numattr2(10) 17 integer i, j, k, m, elem_map(5), connect(10) 18 integer elem_map2(5), connect2(10) 19 integer node_list(100), elem_list(100), side_list(100) 20 integer node_list2(100), elem_list2(100), side_list2(100) 21 integer ebids(10),ids(10),num_nodes_per_set(10) 22 integer num_elem_per_set(10), num_df_per_set(10) 23 integer ebids2(10) 24 integer df_ind(10), node_ind(10), elem_ind(10) 25 integer num_qa_rec, num_info 26 integer num_qa_rec2,num_info2 27 integer num_glo_vars, num_nod_vars, num_ele_vars 28 integer num_glo_vars2, num_nod_vars2, num_ele_vars2 29 integer truth_tab(3,5) 30 integer whole_time_step, num_time_steps 31 integer cpu_word_size, io_word_size 32 integer prop_array(2) 33 34 real glob_var_vals(100), nodal_var_vals(100) 35 real time_value, elem_var_vals(100) 36 real time_value2 37 real x(100), y(100), z(100) 38 real x2(100), y2(100), z2(100) 39 real attrib(100), dist_fact(100) 40 real attrib2(100), dist_fact2(100) 41 42 character*(MXLNLN) title 43 character*(MXLNLN) title2 44 character*(MXSTLN) coord_names(3) 45 character*(MXSTLN) coord_names2(3) 46 character*(MXSTLN) cname 47 character*(MXSTLN) cname2 48 character*(MXSTLN) var_names(3) 49 character*(MXSTLN) var_names2(3) 50 character*(MXSTLN) qa_record(4,2) 51 character*(MXSTLN) qa_record2(4,2) 52 character*(MXLNLN) inform(3) 53 character*(MXLNLN) inform2(3) 54 character*(MXSTLN) prop_names(2) 55 56 data iin /5/, iout /6/ 57 58c 59c create EXODUS II files 60c 61 cpu_word_size = 0 62 io_word_size = 4 63c 64c first create a "regular" file that contains everything except 65c history variable info 66c 67 exoid = excre ("test.exo", 68 1 EXCLOB, cpu_word_size, io_word_size, ierr) 69 write (iout,'("after excre for test.exo,id: ",i4,", err=",i3)') 70 1 exoid, ierr 71 write (iout,'(" cpu word size: ",i4," io word size: ",i4)') 72 1 cpu_word_size, io_word_size 73 write (iout, '("after excre, error = ", i4)' ) ierr 74 75 exoid2= excre ("test2.exo", 76 1 EXCLOB, cpu_word_size, io_word_size, ierr) 77 write (iout,'("after excre for test2.exo,id: ",i4,", err=",i3)') 78 1 exoid2, ierr 79 write (iout, '("after excre (2), error = ", i4)' ) ierr 80 81c 82c initialize file with parameters 83c 84 85 title = "This is test 2" 86 num_dim = 3 87 num_nodes = 26 88 num_elem = 5 89 num_elem_blk = 5 90 num_node_sets = 2 91 num_side_sets = 5 92 93 call expini (exoid, title, num_dim, num_nodes, 94 1 num_elem, num_elem_blk, num_node_sets, 95 2 num_side_sets, ierr) 96 97 write (iout, '("after expini, error = ", i4)' ) ierr 98 99 title2 = "This is test 2" 100 num_dim2 = 3 101 num_nodes2 = 26 102 num_elem2 = 5 103 num_elem_blk2 = 5 104 num_node_sets2 = 2 105 num_side_sets2 = 5 106 107 call expini (exoid2, title2, num_dim2, num_nodes2, 108 1 num_elem2, num_elem_blk2, num_node_sets2, 109 2 num_side_sets2, ierr) 110 111 write (iout, '("after expini (2), error = ", i4)' ) ierr 112 113 114c 115c write nodal coordinates values and names to database 116c 117c Quad #1 118 x(1) = 0.0 119 x(2) = 1.0 120 x(3) = 1.0 121 x(4) = 0.0 122 123 y(1) = 0.0 124 y(2) = 0.0 125 y(3) = 1.0 126 y(4) = 1.0 127 128 z(1) = 0.0 129 z(2) = 0.0 130 z(3) = 0.0 131 z(4) = 0.0 132 133c Quad #2 134 x(5) = 1.0 135 x(6) = 2.0 136 x(7) = 2.0 137 x(8) = 1.0 138 139 y(5) = 0.0 140 y(6) = 0.0 141 y(7) = 1.0 142 y(8) = 1.0 143 144 z(5) = 0.0 145 z(6) = 0.0 146 z(7) = 0.0 147 z(8) = 0.0 148 149c Hex #1 150 x(9) = 0.0 151 x(10) = 10.0 152 x(11) = 10.0 153 x(12) = 1.0 154 x(13) = 1.0 155 x(14) = 10.0 156 x(15) = 10.0 157 x(16) = 1.0 158 159 y(9) = 0.0 160 y(10) = 0.0 161 y(11) = 0.0 162 y(12) = 0.0 163 y(13) = 10.0 164 y(14) = 10.0 165 y(15) = 10.0 166 y(16) = 10.0 167 168 z(9) = 0.0 169 z(10) = 0.0 170 z(11) =-10.0 171 z(12) =-10.0 172 z(13) = 0.0 173 z(14) = 0.0 174 z(15) =-10.0 175 z(16) =-10.0 176 177c Tetra #1 178 x(17) = 0.0 179 x(18) = 1.0 180 x(19) = 10.0 181 x(20) = 7.0 182 183 y(17) = 0.0 184 y(18) = 0.0 185 y(19) = 0.0 186 y(20) = 5.0 187 188 z(17) = 0.0 189 z(18) = 5.0 190 z(19) = 2.0 191 z(20) = 3.0 192 193c Wedge #1 194 x(21) = 3.0 195 x(22) = 6.0 196 x(23) = 0.0 197 x(24) = 3.0 198 x(25) = 6.0 199 x(26) = 0.0 200 201 y(21) = 0.0 202 y(22) = 0.0 203 y(23) = 0.0 204 y(24) = 2.0 205 y(25) = 2.0 206 y(26) = 2.0 207 208 z(21) = 6.0 209 z(22) = 0.0 210 z(23) = 0.0 211 z(24) = 6.0 212 z(25) = 2.0 213 z(26) = 0.0 214 215 call expcor (exoid, x, y, z, ierr) 216 write (iout, '("after expcor, error = ", i4)' ) ierr 217 218c Quad #1 219 x2(1) = 0.0 220 x2(2) = 1.0 221 x2(3) = 1.0 222 x2(4) = 0.0 223 224 y2(1) = 0.0 225 y2(2) = 0.0 226 y2(3) = 1.0 227 y2(4) = 1.0 228 229 z2(1) = 0.0 230 z2(2) = 0.0 231 z2(3) = 0.0 232 z2(4) = 0.0 233 234c Quad #2 235 x2(5) = 1.0 236 x2(6) = 2.0 237 x2(7) = 2.0 238 x2(8) = 1.0 239 240 y2(5) = 0.0 241 y2(6) = 0.0 242 y2(7) = 1.0 243 y2(8) = 1.0 244 245 z2(5) = 0.0 246 z2(6) = 0.0 247 z2(7) = 0.0 248 z2(8) = 0.0 249 250c Hex #1 251 x2(9) = 0.0 252 x2(10) = 10.0 253 x2(11) = 10.0 254 x2(12) = 1.0 255 x2(13) = 1.0 256 x2(14) = 10.0 257 x2(15) = 10.0 258 x2(16) = 1.0 259 260 y2(9) = 0.0 261 y2(10) = 0.0 262 y2(11) = 0.0 263 y2(12) = 0.0 264 y2(13) = 10.0 265 y2(14) = 10.0 266 y2(15) = 10.0 267 y2(16) = 10.0 268 269 z2(9) = 0.0 270 z2(10) = 0.0 271 z2(11) =-10.0 272 z2(12) =-10.0 273 z2(13) = 0.0 274 z2(14) = 0.0 275 z2(15) =-10.0 276 z2(16) =-10.0 277 278c Tetra #1 279 x2(17) = 0.0 280 x2(18) = 1.0 281 x2(19) = 10.0 282 x2(20) = 7.0 283 284 y2(17) = 0.0 285 y2(18) = 0.0 286 y2(19) = 0.0 287 y2(20) = 5.0 288 289 z2(17) = 0.0 290 z2(18) = 5.0 291 z2(19) = 2.0 292 z2(20) = 3.0 293 294c Wedge #1 295 x2(21) = 3.0 296 x2(22) = 6.0 297 x2(23) = 0.0 298 x2(24) = 3.0 299 x2(25) = 6.0 300 x2(26) = 0.0 301 302 y2(21) = 0.0 303 y2(22) = 0.0 304 y2(23) = 0.0 305 y2(24) = 2.0 306 y2(25) = 2.0 307 y2(26) = 2.0 308 309 z2(21) = 6.0 310 z2(22) = 0.0 311 z2(23) = 0.0 312 z2(24) = 6.0 313 z2(25) = 2.0 314 z2(26) = 0.0 315 316 317 call expcor (exoid2, x2, y2, z2, ierr) 318 write (iout, '("after expcor (2), error = ", i4)' ) ierr 319 320 coord_names(1) = "xcoor" 321 coord_names(2) = "ycoor" 322 coord_names(3) = "zcoor" 323 324 call expcon (exoid, coord_names, ierr) 325 write (iout, '("after expcon, error = ", i4)' ) ierr 326 327 coord_names2(1) = "xcoor" 328 coord_names2(2) = "ycoor" 329 coord_names2(3) = "zcoor" 330 331 call expcon (exoid2, coord_names2, ierr) 332 write (iout, '("after expcon (2), error = ", i4)' ) ierr 333 334 335c 336c write element order map 337c 338 339 do 10 i = 1, num_elem 340 elem_map(i) = i 34110 continue 342 343 call expmap (exoid, elem_map, ierr) 344 write (iout, '("after expmap, error = ", i4)' ) ierr 345 346 do 12 i = 1, num_elem2 347 elem_map2(i) = i 34812 continue 349 350 call expmap (exoid2, elem_map2, ierr) 351 write (iout, '("after expmap (2), error = ", i4)' ) ierr 352 353c 354c write element block parameters 355c 356 357 num_elem_in_block(1) = 1 358 num_elem_in_block(2) = 1 359 num_elem_in_block(3) = 1 360 num_elem_in_block(4) = 1 361 num_elem_in_block(5) = 1 362 363 num_nodes_per_elem(1) = 4 364 num_nodes_per_elem(2) = 4 365 num_nodes_per_elem(3) = 8 366 num_nodes_per_elem(4) = 4 367 num_nodes_per_elem(5) = 6 368 369 ebids(1) = 10 370 ebids(2) = 11 371 ebids(3) = 12 372 ebids(4) = 13 373 ebids(5) = 14 374 375 numattr(1) = 1 376 numattr(2) = 1 377 numattr(3) = 1 378 numattr(4) = 1 379 numattr(5) = 1 380 381 cname = "quad" 382 383 call expelb (exoid,ebids(1),cname,num_elem_in_block(1), 384 1 num_nodes_per_elem(1),numattr(1),ierr) 385 write (iout, '("after expelb, error = ", i4)' ) ierr 386 387 call expelb (exoid,ebids(2),cname,num_elem_in_block(2), 388 1 num_nodes_per_elem(2),numattr(2),ierr) 389 write (iout, '("after expelb, error = ", i4)' ) ierr 390 391 cname = "hex" 392 call expelb (exoid,ebids(3),cname,num_elem_in_block(3), 393 1 num_nodes_per_elem(3),numattr(3),ierr) 394 write (iout, '("after expelb, error = ", i4)' ) ierr 395 396 cname = "tetra" 397 call expelb (exoid,ebids(4),cname,num_elem_in_block(4), 398 1 num_nodes_per_elem(4),numattr(4),ierr) 399 write (iout, '("after expelb, error = ", i4)' ) ierr 400 401 cname = "wedge" 402 call expelb (exoid,ebids(5),cname,num_elem_in_block(5), 403 1 num_nodes_per_elem(5),numattr(5),ierr) 404 write (iout, '("after expelb, error = ", i4)' ) ierr 405 406 num_elem_in_block2(1) = 1 407 num_elem_in_block2(2) = 1 408 num_elem_in_block2(3) = 1 409 num_elem_in_block2(4) = 1 410 num_elem_in_block2(5) = 1 411 412 num_nodes_per_elem2(1) = 4 413 num_nodes_per_elem2(2) = 4 414 num_nodes_per_elem2(3) = 8 415 num_nodes_per_elem2(4) = 4 416 num_nodes_per_elem2(5) = 6 417 418 ebids2(1) = 10 419 ebids2(2) = 11 420 ebids2(3) = 12 421 ebids2(4) = 13 422 ebids2(5) = 14 423 424 numattr2(1) = 1 425 numattr2(2) = 1 426 numattr2(3) = 1 427 numattr2(4) = 1 428 numattr2(5) = 1 429 430 cname2 = "quad" 431 432 call expelb(exoid2,ebids2(1),cname2,num_elem_in_block2(1), 433 1 num_nodes_per_elem2(1),numattr2(1),ierr) 434 write (iout, '("after expelb (2), error = ", i4)' ) ierr 435 436 call expelb(exoid2,ebids2(2),cname2,num_elem_in_block2(2), 437 1 num_nodes_per_elem2(2),numattr2(2),ierr) 438 write (iout, '("after expelb (2), error = ", i4)' ) ierr 439 440 cname2 = "hex" 441 call expelb(exoid2,ebids2(3),cname2,num_elem_in_block2(3), 442 1 num_nodes_per_elem(3),numattr(3),ierr) 443 write (iout, '("after expelb (2), error = ", i4)' ) ierr 444 445 cname2 = "tetra" 446 call expelb(exoid2,ebids2(4),cname2,num_elem_in_block2(4), 447 1 num_nodes_per_elem2(4),numattr2(4),ierr) 448 write (iout, '("after expelb (2), error = ", i4)' ) ierr 449 450 cname2 = "wedge" 451 call expelb(exoid2,ebids2(5),cname2,num_elem_in_block2(5), 452 1 num_nodes_per_elem2(5),numattr2(5),ierr) 453 write (iout, '("after expelb (2), error = ", i4)' ) ierr 454 455 456c write element block properties 457 458 prop_names(1) = "MATL" 459 prop_names(2) = "DENSITY" 460 call exppn(exoid,EXEBLK,2,prop_names,ierr) 461 write (iout, '("after exppn, error = ", i4)' ) ierr 462 463 call expp(exoid, EXEBLK, ebids(1), "MATL", 10, ierr) 464 write (iout, '("after expp, error = ", i4)' ) ierr 465 call expp(exoid, EXEBLK, ebids(2), "MATL", 20, ierr) 466 write (iout, '("after expp, error = ", i4)' ) ierr 467 call expp(exoid, EXEBLK, ebids(3), "MATL", 30, ierr) 468 write (iout, '("after expp, error = ", i4)' ) ierr 469 call expp(exoid, EXEBLK, ebids(4), "MATL", 40, ierr) 470 write (iout, '("after expp, error = ", i4)' ) ierr 471 call expp(exoid, EXEBLK, ebids(5), "MATL", 50, ierr) 472 write (iout, '("after expp, error = ", i4)' ) ierr 473 474 call exppn(exoid2,EXEBLK,2,prop_names,ierr) 475 write (iout, '("after exppn (2), error = ", i4)' ) ierr 476 477 call expp(exoid2, EXEBLK, ebids(1), "MATL", 100, ierr) 478 write (iout, '("after expp (2), error = ", i4)' ) ierr 479 call expp(exoid2, EXEBLK, ebids(2), "MATL", 200, ierr) 480 write (iout, '("after expp (2), error = ", i4)' ) ierr 481 call expp(exoid2, EXEBLK, ebids(3), "MATL", 300, ierr) 482 write (iout, '("after expp (2), error = ", i4)' ) ierr 483 call expp(exoid2, EXEBLK, ebids(4), "MATL", 400, ierr) 484 write (iout, '("after expp (2), error = ", i4)' ) ierr 485 call expp(exoid2, EXEBLK, ebids(5), "MATL", 500, ierr) 486 write (iout, '("after expp (2), error = ", i4)' ) ierr 487 488 489c 490c write element connectivity 491c 492 493 connect(1) = 1 494 connect(2) = 2 495 connect(3) = 3 496 connect(4) = 4 497 498 call expelc (exoid, ebids(1), connect, ierr) 499 write (iout, '("after expelc, error = ", i4)' ) ierr 500 501 connect(1) = 5 502 connect(2) = 6 503 connect(3) = 7 504 connect(4) = 8 505 506 call expelc (exoid, ebids(2), connect, ierr) 507 write (iout, '("after expelc, error = ", i4)' ) ierr 508 509 connect(1) = 9 510 connect(2) = 10 511 connect(3) = 11 512 connect(4) = 12 513 connect(5) = 13 514 connect(6) = 14 515 connect(7) = 15 516 connect(8) = 16 517 518 call expelc (exoid, ebids(3), connect, ierr) 519 write (iout, '("after expelc, error = ", i4)' ) ierr 520 521 connect(1) = 17 522 connect(2) = 18 523 connect(3) = 19 524 connect(4) = 20 525 526 call expelc (exoid, ebids(4), connect, ierr) 527 write (iout, '("after expelc, error = ", i4)' ) ierr 528 529 connect(1) = 21 530 connect(2) = 22 531 connect(3) = 23 532 connect(4) = 24 533 connect(5) = 25 534 connect(6) = 26 535 536 call expelc (exoid, ebids(5), connect, ierr) 537 write (iout, '("after expelc, error = ", i4)' ) ierr 538 539 connect2(1) = 1 540 connect2(2) = 2 541 connect2(3) = 3 542 connect2(4) = 4 543 544 call expelc (exoid2, ebids2(1), connect2, ierr) 545 write (iout, '("after expelc (2), error = ", i4)' ) ierr 546 547 connect2(1) = 5 548 connect2(2) = 6 549 connect2(3) = 7 550 connect2(4) = 8 551 552 call expelc (exoid2, ebids2(2), connect2, ierr) 553 write (iout, '("after expelc (2), error = ", i4)' ) ierr 554 555 connect2(1) = 9 556 connect2(2) = 10 557 connect2(3) = 11 558 connect2(4) = 12 559 connect2(5) = 13 560 connect2(6) = 14 561 connect2(7) = 15 562 connect2(8) = 16 563 564 call expelc (exoid2, ebids2(3), connect2, ierr) 565 write (iout, '("after expelc (2), error = ", i4)' ) ierr 566 567 connect2(1) = 17 568 connect2(2) = 18 569 connect2(3) = 19 570 connect2(4) = 20 571 572 call expelc (exoid2, ebids2(4), connect2, ierr) 573 write (iout, '("after expelc (2), error = ", i4)' ) ierr 574 575 connect2(1) = 21 576 connect2(2) = 22 577 connect2(3) = 23 578 connect2(4) = 24 579 connect2(5) = 25 580 connect2(6) = 26 581 582 call expelc (exoid2, ebids2(5), connect2, ierr) 583 write (iout, '("after expelc (2), error = ", i4)' ) ierr 584 585c 586c write element block attributes 587c 588 589 attrib(1) = 3.14159 590 call expeat (exoid, ebids(1), attrib, ierr) 591 write (iout, '("after expeat, error = ", i4)' ) ierr 592 593 attrib(1) = 6.14159 594 call expeat (exoid, ebids(2), attrib, ierr) 595 write (iout, '("after expeat, error = ", i4)' ) ierr 596 597 call expeat (exoid, ebids(3), attrib, ierr) 598 write (iout, '("after expeat, error = ", i4)' ) ierr 599 600 call expeat (exoid, ebids(4), attrib, ierr) 601 write (iout, '("after expeat, error = ", i4)' ) ierr 602 603 call expeat (exoid, ebids(5), attrib, ierr) 604 write (iout, '("after expeat, error = ", i4)' ) ierr 605 606 607 attrib2(1) = 3. 608 call expeat (exoid2, ebids2(1), attrib2, ierr) 609 write (iout, '("after expeat (2), error = ", i4)' ) ierr 610 611 attrib2(1) = 6. 612 call expeat (exoid2, ebids2(2), attrib2, ierr) 613 write (iout, '("after expeat (2), error = ", i4)' ) ierr 614 615 call expeat (exoid2, ebids2(3), attrib2, ierr) 616 write (iout, '("after expeat (2), error = ", i4)' ) ierr 617 618 call expeat (exoid2, ebids2(4), attrib2, ierr) 619 write (iout, '("after expeat (2), error = ", i4)' ) ierr 620 621 call expeat (exoid2, ebids(5), attrib2, ierr) 622 write (iout, '("after expeat (2), error = ", i4)' ) ierr 623 624 625c 626c write individual node sets 627c 628 629 call expnp (exoid, 20, 5, 5, ierr) 630 write (iout, '("after expnp, error = ", i4)' ) ierr 631 632 node_list(1) = 100 633 node_list(2) = 101 634 node_list(3) = 102 635 node_list(4) = 103 636 node_list(5) = 104 637 638 dist_fact(1) = 1.0 639 dist_fact(2) = 2.0 640 dist_fact(3) = 3.0 641 dist_fact(4) = 4.0 642 dist_fact(5) = 5.0 643 644 call expns (exoid, 20, node_list, ierr) 645 write (iout, '("after expns, error = ", i4)' ) ierr 646 call expnsd (exoid, 20, dist_fact, ierr) 647 write (iout, '("after expnsd, error = ", i4)' ) ierr 648 649 call expnp (exoid, 21, 3, 3, ierr) 650 write (iout, '("after expnp, error = ", i4)' ) ierr 651 652 node_list(1) = 200 653 node_list(2) = 201 654 node_list(3) = 202 655 656 dist_fact(1) = 1.1 657 dist_fact(2) = 2.1 658 dist_fact(3) = 3.1 659 660 call expns (exoid, 21, node_list, ierr) 661 write (iout, '("after expns, error = ", i4)' ) ierr 662 call expnsd (exoid, 21, dist_fact, ierr) 663 write (iout, '("after expnsd, error = ", i4)' ) ierr 664 665 prop_names(1) = "FACE" 666 call expp(exoid, EXNSET, 20, prop_names(1), 4, ierr) 667 write (iout, '("after expp, error = ", i4)' ) ierr 668 669 call expp(exoid, EXNSET, 21, prop_names(1), 5, ierr) 670 write (iout, '("after expp, error = ", i4)' ) ierr 671 672 prop_array(1) = 1000 673 prop_array(2) = 2000 674 675 prop_names(1) = "VELOCITY" 676 call exppa(exoid, EXNSET, prop_names(1), prop_array, ierr) 677 write (iout, '("after exppa, error = ", i4)' ) ierr 678 679C**** file 2 680 681 call expnp (exoid2, 20, 5, 5, ierr) 682 write (iout, '("after expnp (2), error = ", i4)' ) ierr 683 684 node_list2(1) = 100 685 node_list2(2) = 101 686 node_list2(3) = 102 687 node_list2(4) = 103 688 node_list2(5) = 104 689 690 dist_fact2(1) = 1.0 691 dist_fact2(2) = 2.0 692 dist_fact2(3) = 3.0 693 dist_fact2(4) = 4.0 694 dist_fact2(5) = 5.0 695 696 call expns (exoid2, 20, node_list2, ierr) 697 write (iout, '("after expns (2), error = ", i4)' ) ierr 698 call expnsd (exoid2, 20, dist_fact2, ierr) 699 write (iout, '("after expnsd (2), error = ", i4)' ) ierr 700 701 call expnp (exoid2, 21, 3, 3, ierr) 702 write (iout, '("after expnp (2), error = ", i4)' ) ierr 703 704 node_list2(1) = 200 705 node_list2(2) = 201 706 node_list2(3) = 202 707 708 dist_fact2(1) = 1.1 709 dist_fact2(2) = 2.1 710 dist_fact2(3) = 3.1 711 712 call expns (exoid2, 21, node_list2, ierr) 713 write (iout, '("after expns (2), error = ", i4)' ) ierr 714 call expnsd (exoid2, 21, dist_fact2, ierr) 715 write (iout, '("after expnsd (2), error = ", i4)' ) ierr 716 717c 718c write concatenated node sets; this produces the same information as 719c the above code which writes individual node sets 720c 721 722 ids(1) = 20 723 ids(2) = 21 724 725 num_nodes_per_set(1) = 5 726 num_nodes_per_set(2) = 3 727 728 node_ind(1) = 1 729 node_ind(2) = 6 730 731 node_list(1) = 100 732 node_list(2) = 101 733 node_list(3) = 102 734 node_list(4) = 103 735 node_list(5) = 104 736 node_list(6) = 200 737 node_list(7) = 201 738 node_list(8) = 202 739 740 dist_fact(1) = 1.0 741 dist_fact(2) = 2.0 742 dist_fact(3) = 3.0 743 dist_fact(4) = 4.0 744 dist_fact(5) = 5.0 745 dist_fact(6) = 1.1 746 dist_fact(7) = 2.1 747 dist_fact(8) = 3.1 748 749c call expcns (exoid, ids, num_nodes_per_set, node_ind, node_list, 750c 1 dist_fact, ierr) 751c write (iout, '("after expcns, error = ", i4)' ) ierr 752c 753 754 prop_names(1) = "FACE" 755 call expp(exoid2, EXNSET, 20, prop_names(1), 4, ierr) 756 write (iout, '("after expp (2), error = ", i4)' ) ierr 757 758 prop_names(1) = "FACE" 759 call expp(exoid2, EXNSET, 21, prop_names(1), 5, ierr) 760 write (iout, '("after expp (2), error = ", i4)' ) ierr 761 762 prop_array(1) = 1000 763 prop_array(2) = 2000 764 765 prop_names(1) = "VELOCITY" 766 call exppa(exoid2, EXNSET, prop_names(1), prop_array, ierr) 767 write (iout, '("after exppa (2), error = ", i4)' ) ierr 768 769c write individual side sets 770c 771 772c side set #1 - quad 773 774 elem_list(1) = 2 775 elem_list(2) = 2 776 777 side_list(1) = 4 778 side_list(2) = 2 779 780 dist_fact(1) = 30.0 781 dist_fact(2) = 30.1 782 dist_fact(3) = 30.2 783 dist_fact(4) = 30.3 784 785 call expsp (exoid, 30, 2, 4, ierr) 786 write (iout, '("after expsp, error = ", i4)' ) ierr 787 788 call expss (exoid, 30, elem_list, side_list, ierr) 789 write (iout, '("after expss, error = ", i4)' ) ierr 790 791 call expssd (exoid, 30, dist_fact, ierr) 792 write (iout, '("after expssd, error = ", i4)' ) ierr 793 794c side set #2 - quad, spanning 2 elements 795 796 elem_list(1) = 1 797 elem_list(2) = 2 798 799 side_list(1) = 2 800 side_list(2) = 3 801 802 dist_fact(1) = 31.0 803 dist_fact(2) = 31.1 804 dist_fact(3) = 31.2 805 dist_fact(4) = 31.3 806 807 call expsp (exoid, 31, 2, 4, ierr) 808 write (iout, '("after expsp, error = ", i3)' ) ierr 809 810 call expss (exoid, 31, elem_list, side_list, ierr) 811 write (iout, '("after expss, error = ", i3)' ) ierr 812 813 call expssd (exoid, 31, dist_fact, ierr) 814 write (iout, '("after expssd, error = ", i3)' ) ierr 815 816c side set #3 - hex 817 818 elem_list(1) = 3 819 elem_list(2) = 3 820 elem_list(3) = 3 821 elem_list(4) = 3 822 elem_list(5) = 3 823 elem_list(6) = 3 824 elem_list(7) = 3 825 826 side_list(1) = 5 827 side_list(2) = 3 828 side_list(3) = 3 829 side_list(4) = 2 830 side_list(5) = 4 831 side_list(6) = 1 832 side_list(7) = 6 833 834 call expsp (exoid, 32, 7, 0, ierr) 835 write (iout, '("after expsp, error = ", i4)' ) ierr 836 837 call expss (exoid, 32, elem_list, side_list, ierr) 838 write (iout, '("after expss, error = ", i4)' ) ierr 839 840c side set #4 - tetras 841 842 elem_list(1) = 4 843 elem_list(2) = 4 844 elem_list(3) = 4 845 elem_list(4) = 4 846 847 side_list(1) = 1 848 side_list(2) = 2 849 side_list(3) = 3 850 side_list(4) = 4 851 852 call expsp (exoid, 33, 4, 0, ierr) 853 write (iout, '("after expsp, error = ", i4)' ) ierr 854 855 call expss (exoid, 33, elem_list, side_list, ierr) 856 write (iout, '("after expss, error = ", i4)' ) ierr 857 858c side set #5 - wedges 859 860 elem_list(1) = 5 861 elem_list(2) = 5 862 elem_list(3) = 5 863 elem_list(4) = 5 864 elem_list(5) = 5 865 866 side_list(1) = 1 867 side_list(2) = 2 868 side_list(3) = 3 869 side_list(4) = 4 870 side_list(5) = 5 871 872 call expsp (exoid, 34, 5, 0, ierr) 873 write (iout, '("after expsp, error = ", i4)' ) ierr 874 875 call expss (exoid, 34, elem_list, side_list, ierr) 876 write (iout, '("after expss, error = ", i4)' ) ierr 877 878 879c side set #1 - quad 880 881 elem_list2(1) = 2 882 elem_list2(2) = 2 883 884 side_list2(1) = 4 885 side_list2(2) = 2 886 887 dist_fact2(1) = 30.0 888 dist_fact2(2) = 30.1 889 dist_fact2(3) = 30.2 890 dist_fact2(4) = 30.3 891 892 call expsp (exoid2, 30, 2, 4, ierr) 893 write (iout, '("after expsp (2), error = ", i4)' ) ierr 894 895 call expss (exoid2, 30, elem_list2, side_list2, ierr) 896 write (iout, '("after expss (2), error = ", i4)' ) ierr 897 898 call expssd (exoid2, 30, dist_fact2, ierr) 899 write (iout, '("after expssd (2), error = ", i4)' ) ierr 900 901c side set #2 - quad, spanning 2 elements 902 903 elem_list2(1) = 1 904 elem_list2(2) = 2 905 906 side_list2(1) = 2 907 side_list2(2) = 3 908 909 dist_fact2(1) = 31.0 910 dist_fact2(2) = 31.1 911 dist_fact2(3) = 31.2 912 dist_fact2(4) = 31.3 913 914 call expsp (exoid2, 31, 2, 4, ierr) 915 write (iout, '("after expsp (2), error = ", i3)' ) ierr 916 917 call expss (exoid2, 31, elem_list2, side_list2, ierr) 918 write (iout, '("after expss (2), error = ", i3)' ) ierr 919 920 call expssd (exoid2, 31, dist_fact2, ierr) 921 write (iout, '("after expssd (2), error = ", i3)' ) ierr 922 923c side set #3 - hex 924 925 elem_list2(1) = 3 926 elem_list2(2) = 3 927 elem_list2(3) = 3 928 elem_list2(4) = 3 929 elem_list2(5) = 3 930 elem_list2(6) = 3 931 elem_list2(7) = 3 932 933 side_list2(1) = 5 934 side_list2(2) = 3 935 side_list2(3) = 3 936 side_list2(4) = 2 937 side_list2(5) = 4 938 side_list2(6) = 1 939 side_list2(7) = 6 940 941 call expsp (exoid2, 32, 7, 0, ierr) 942 write (iout, '("after expsp (2), error = ", i4)' ) ierr 943 944 call expss (exoid2, 32, elem_list2, side_list2, ierr) 945 write (iout, '("after expss (2), error = ", i4)' ) ierr 946 947c side set #4 - tetras 948 949 elem_list2(1) = 4 950 elem_list2(2) = 4 951 elem_list2(3) = 4 952 elem_list2(4) = 4 953 954 side_list2(1) = 1 955 side_list2(2) = 2 956 side_list2(3) = 3 957 side_list2(4) = 4 958 959 call expsp (exoid2, 33, 4, 0, ierr) 960 write (iout, '("after expsp (2), error = ", i4)' ) ierr 961 962 call expss (exoid2, 33, elem_list2, side_list2, ierr) 963 write (iout, '("after expss (2), error = ", i4)' ) ierr 964 965c side set #5 - wedges 966 967 elem_list2(1) = 5 968 elem_list2(2) = 5 969 elem_list2(3) = 5 970 elem_list2(4) = 5 971 elem_list2(5) = 5 972 973 side_list2(1) = 1 974 side_list2(2) = 2 975 side_list2(3) = 3 976 side_list2(4) = 4 977 side_list2(5) = 5 978 979 call expsp (exoid2, 34, 5, 0, ierr) 980 write (iout, '("after expsp (2), error = ", i4)' ) ierr 981 982 call expss (exoid2, 34, elem_list2, side_list2, ierr) 983 write (iout, '("after expss (2), error = ", i4)' ) ierr 984 985c 986c write concatenated side sets; this produces the same information as 987c the above code which writes individual side sets 988c 989 ids(1) = 30 990 ids(2) = 31 991 ids(3) = 32 992 ids(4) = 33 993 ids(5) = 34 994 995c side set #1 996 node_list(1) = 8 997 node_list(2) = 5 998 node_list(3) = 6 999 node_list(4) = 7 1000 1001c side set #2 1002 node_list(5) = 2 1003 node_list(6) = 3 1004 node_list(7) = 7 1005 node_list(8) = 8 1006 1007c side set #3 1008 node_list(9) = 9 1009 node_list(10) = 12 1010 node_list(11) = 11 1011 node_list(12) = 10 1012 1013 node_list(13) = 11 1014 node_list(14) = 12 1015 node_list(15) = 16 1016 node_list(16) = 15 1017 1018 node_list(17) = 16 1019 node_list(18) = 15 1020 node_list(19) = 11 1021 node_list(20) = 12 1022 1023 node_list(21) = 10 1024 node_list(22) = 11 1025 node_list(23) = 15 1026 node_list(24) = 14 1027 1028 node_list(25) = 13 1029 node_list(26) = 16 1030 node_list(27) = 12 1031 node_list(28) = 9 1032 1033 node_list(29) = 14 1034 node_list(30) = 13 1035 node_list(31) = 9 1036 node_list(32) = 10 1037 1038 node_list(33) = 16 1039 node_list(34) = 13 1040 node_list(35) = 14 1041 node_list(36) = 15 1042 1043c side set #4 1044 node_list(37) = 17 1045 node_list(38) = 18 1046 node_list(39) = 20 1047 1048 node_list(40) = 18 1049 node_list(41) = 19 1050 node_list(42) = 20 1051 1052 node_list(43) = 20 1053 node_list(44) = 19 1054 node_list(45) = 17 1055 1056 node_list(46) = 19 1057 node_list(47) = 18 1058 node_list(48) = 17 1059 1060c side set #5 1061 node_list(49) = 25 1062 node_list(50) = 24 1063 node_list(51) = 21 1064 node_list(52) = 22 1065 1066 node_list(53) = 26 1067 node_list(54) = 25 1068 node_list(55) = 22 1069 node_list(56) = 23 1070 1071 node_list(57) = 26 1072 node_list(58) = 23 1073 node_list(59) = 21 1074 node_list(60) = 24 1075 1076 node_list(61) = 23 1077 node_list(62) = 22 1078 node_list(63) = 21 1079 1080 node_list(64) = 24 1081 node_list(65) = 25 1082 node_list(66) = 26 1083 1084 num_elem_per_set(1) = 2 1085 num_elem_per_set(2) = 2 1086 num_elem_per_set(3) = 7 1087 num_elem_per_set(4) = 4 1088 num_elem_per_set(5) = 5 1089 1090 num_nodes_per_set(1) = 4 1091 num_nodes_per_set(2) = 4 1092 num_nodes_per_set(3) = 28 1093 num_nodes_per_set(4) = 12 1094 num_nodes_per_set(5) = 20 1095 1096 elem_ind(1) = 1 1097 elem_ind(2) = 3 1098 elem_ind(3) = 5 1099 elem_ind(4) = 12 1100 elem_ind(5) = 16 1101 1102 node_ind(1) = 1 1103 node_ind(2) = 5 1104 node_ind(3) = 9 1105 node_ind(4) = 37 1106 node_ind(5) = 48 1107 1108 elem_list(1) = 3 1109 elem_list(2) = 3 1110 elem_list(3) = 1 1111 elem_list(4) = 3 1112 elem_list(5) = 4 1113 elem_list(6) = 4 1114 elem_list(7) = 4 1115 elem_list(8) = 4 1116 elem_list(9) = 4 1117 elem_list(10) = 4 1118 elem_list(11) = 4 1119 elem_list(12) = 5 1120 elem_list(13) = 5 1121 elem_list(14) = 5 1122 elem_list(15) = 5 1123 elem_list(16) = 6 1124 elem_list(17) = 6 1125 elem_list(18) = 6 1126 elem_list(19) = 6 1127 elem_list(20) = 6 1128 1129c side_list(1) = 1 1130c side_list(2) = 2 1131c side_list(3) = 3 1132c side_list(4) = 4 1133 1134 1135c call excn2s(exoid, num_elem_per_set, num_nodes_per_set, elem_ind, 1136c 1 node_ind, elem_list, node_list, side_list, ierr) 1137c write (iout, '("after excn2s, error = ", i4)' ) ierr 1138 1139 num_df_per_set(1) = 4 1140 num_df_per_set(2) = 4 1141 num_df_per_set(3) = 0 1142 num_df_per_set(4) = 0 1143 num_df_per_set(5) = 0 1144 1145 df_ind(1) = 1 1146 df_ind(2) = 5 1147 1148 1149 dist_fact(1) = 30.0 1150 dist_fact(2) = 30.1 1151 dist_fact(3) = 30.2 1152 dist_fact(4) = 30.3 1153 dist_fact(5) = 31.0 1154 dist_fact(6) = 31.1 1155 dist_fact(7) = 31.2 1156 dist_fact(8) = 31.3 1157 1158c call expcss (exoid, ids, num_elem_per_set, num_df_per_set, 1159c 1 elem_ind, df_ind, elem_list, side_list, dist_fact, 1160c 2 ierr) 1161c write (iout, '("after expcss, error = ", i4)' ) ierr 1162 1163c call expcss (exoid2, ids, num_elem_per_set, num_df_per_set, 1164c 1 elem_ind, df_ind, elem_list, side_list, dist_fact, 1165c 2 ierr) 1166c write (iout, '("after expcss (2), error = ", i4)' ) ierr 1167 1168 prop_names(1) = "COLOR" 1169 call expp(exoid, EXSSET, 30, prop_names(1), 100, ierr) 1170 write (iout, '("after expp, error = ", i4)' ) ierr 1171 1172 call expp(exoid, EXSSET, 31, prop_names(1), 101, ierr) 1173 write (iout, '("after expp, error = ", i4)' ) ierr 1174 1175 1176 prop_names(1) = "COLOR" 1177 call expp(exoid2, EXSSET, 30, prop_names(1), 100, ierr) 1178 write (iout, '("after expp (2), error = ", i4)' ) ierr 1179 1180 call expp(exoid2, EXSSET, 31, prop_names(1), 101, ierr) 1181 write (iout, '("after expp (2), error = ", i4)' ) ierr 1182 1183 1184c 1185c write QA records 1186c 1187 1188 num_qa_rec = 2 1189 1190 qa_record(1,1) = "TESTWT2 fortran version" 1191 qa_record(2,1) = "testwt2" 1192 qa_record(3,1) = "07/07/93" 1193 qa_record(4,1) = "15:41:33" 1194 qa_record(1,2) = "FASTQ" 1195 qa_record(2,2) = "fastq" 1196 qa_record(3,2) = "07/07/93" 1197 qa_record(4,2) = "16:41:33" 1198 1199 call expqa (exoid, num_qa_rec, qa_record, ierr) 1200 write (iout, '("after expqa, error = ", i4)' ) ierr 1201 1202 num_qa_rec2 = 2 1203 1204 qa_record2(1,1) = "TESTWT2 fortran version" 1205 qa_record2(2,1) = "testwt2" 1206 qa_record2(3,1) = "07/07/93" 1207 qa_record2(4,1) = "15:41:33" 1208 qa_record2(1,2) = "FASTQ" 1209 qa_record2(2,2) = "fastq" 1210 qa_record2(3,2) = "07/07/93" 1211 qa_record2(4,2) = "16:41:33" 1212 1213 call expqa (exoid2, num_qa_rec2, qa_record2, ierr) 1214 write (iout, '("after expqa (2), error = ", i4)' ) ierr 1215 1216 1217c 1218c write information records 1219c 1220 1221 num_info = 3 1222 1223 inform(1) = "This is the first information record." 1224 inform(2) = "This is the second information record." 1225 inform(3) = "This is the third information record." 1226 1227 call expinf (exoid, num_info, inform, ierr) 1228 write (iout, '("after expinf, error = ", i4)' ) ierr 1229 1230 num_info2 = 3 1231 1232 inform2(1) = "This is the first information record." 1233 inform2(2) = "This is the second information record." 1234 inform2(3) = "This is the third information record." 1235 1236 call expinf (exoid2, num_info2, inform2, ierr) 1237 write (iout, '("after expinf (2), error = ", i4)' ) ierr 1238 1239 1240c write results variables parameters and names 1241 1242 num_glo_vars = 1 1243 1244 var_names(1) = "glo_vars" 1245 1246 call expvp (exoid, "g", num_glo_vars, ierr) 1247 write (iout, '("after expvp, error = ", i4)' ) ierr 1248 call expvan (exoid, "g", num_glo_vars, var_names, ierr) 1249 write (iout, '("after expvan, error = ", i4)' ) ierr 1250 1251 num_glo_vars2 = 1 1252 1253 var_names2(1) = "glo_vars" 1254 1255 call expvp (exoid2, "g", num_glo_vars2, ierr) 1256 write (iout, '("after expvp (2), error = ", i4)' ) ierr 1257 call expvan (exoid2, "g", num_glo_vars2, var_names2, ierr) 1258 write (iout, '("after expvan (2), error = ", i4)' ) ierr 1259 1260 1261 num_nod_vars = 2 1262 1263 var_names(1) = "nod_var0" 1264 var_names(2) = "nod_var1" 1265 1266 call expvp (exoid, "n", num_nod_vars, ierr) 1267 write (iout, '("after expvp, error = ", i4)' ) ierr 1268 call expvan (exoid, "n", num_nod_vars, var_names, ierr) 1269 write (iout, '("after expvan, error = ", i4)' ) ierr 1270 1271 num_nod_vars2 = 2 1272 1273 var_names2(1) = "nod_var0" 1274 var_names2(2) = "nod_var1" 1275 1276 call expvp (exoid2, "n", num_nod_vars2, ierr) 1277 write (iout, '("after expvp (2), error = ", i4)' ) ierr 1278 call expvan (exoid2, "n", num_nod_vars2, var_names2, ierr) 1279 write (iout, '("after expvan (2), error = ", i4)' ) ierr 1280 1281 1282 num_ele_vars = 3 1283 1284 var_names(1) = "ele_var0" 1285 var_names(2) = "ele_var1" 1286 var_names(3) = "ele_var2" 1287 1288 call expvp (exoid, "e", num_ele_vars, ierr) 1289 write (iout, '("after expvp, error = ", i4)' ) ierr 1290 call expvan (exoid, "e", num_ele_vars, var_names, ierr) 1291 write (iout, '("after expvan, error = ", i4)' ) ierr 1292 1293 num_ele_vars2 = 3 1294 1295 var_names2(1) = "ele_var0" 1296 var_names2(2) = "ele_var1" 1297 var_names2(3) = "ele_var2" 1298 1299 call expvp (exoid2, "e", num_ele_vars2, ierr) 1300 write (iout, '("after expvp (2), error = ", i4)' ) ierr 1301 call expvan (exoid2, "e", num_ele_vars2, var_names2, ierr) 1302 write (iout, '("after expvan, error = ", i4)' ) ierr 1303 1304c 1305c write element variable truth table 1306c 1307 1308 k = 0 1309 1310 do 30 i = 1,num_elem_blk 1311 do 20 j = 1,num_ele_vars 1312 truth_tab(j,i) = 1 131320 continue 131430 continue 1315 1316 call exgebi (exoid, ebids, ierr) 1317 write (iout, '("after exgebi, error = ", i4)' ) ierr 1318 call exgebi (exoid2, ebids2, ierr) 1319 write (iout, '("after exgebi (2), error = ", i4)' ) ierr 1320 call expvtt (exoid, num_elem_blk, num_ele_vars, truth_tab, ierr) 1321 write (iout, '("after expvtt, error = ", i4)' ) ierr 1322 call expvtt (exoid2, num_elem_blk, num_ele_vars, truth_tab, ierr) 1323 write (iout, '("after expvtt, error = ", i4)' ) ierr 1324 1325c 1326c for each time step, write the analysis results; 1327c the code below fills the arrays glob_var_vals, 1328c nodal_var_vals, and elem_var_vals with values for debugging purposes; 1329c obviously the analysis code will populate these arrays 1330c 1331 1332 whole_time_step = 1 1333 num_time_steps = 10 1334 1335 do 110 i = 1, num_time_steps 1336 time_value = real(i)/100 1337 time_value2 = real(i)/100 1338c 1339c write time value to regular file 1340c 1341 1342 call exptim (exoid, whole_time_step, time_value, ierr) 1343 write (iout, '("after exptim, error = ", i4)' ) ierr 1344 1345 call exptim (exoid2, whole_time_step, time_value2, ierr) 1346 write (iout, '("after exptim (2), error = ", i4)' ) ierr 1347 1348c 1349c write global variables 1350c 1351 1352 do 50 j = 1, num_glo_vars 1353 glob_var_vals(j) = real(j+1) * time_value 135450 continue 1355 1356 call expgv (exoid, whole_time_step, num_glo_vars, 1357 1 glob_var_vals, ierr) 1358 write (iout, '("after expgv, error = ", i4)' ) ierr 1359 1360 call expgv (exoid2, whole_time_step, num_glo_vars, 1361 1 glob_var_vals, ierr) 1362 write (iout, '("after expgv (2), error = ", i4)' ) ierr 1363 1364c 1365c write nodal variables 1366c 1367 1368 do 70 k = 1, num_nod_vars 1369 do 60 j = 1, num_nodes 1370 1371 nodal_var_vals(j) = real(k) + (real(j) * time_value) 1372 137360 continue 1374 1375 call expnv (exoid, whole_time_step, k, num_nodes, 1376 1 nodal_var_vals, ierr) 1377 write (iout, '("after expnv, error = ", i4)' ) ierr 1378 1379 call expnv (exoid2, whole_time_step, k, num_nodes, 1380 1 nodal_var_vals, ierr) 1381 write (iout, '("after expnv (2), error = ", i4)' ) ierr 1382 138370 continue 1384 1385c 1386c write element variables 1387c 1388 1389 do 100 k = 1, num_ele_vars 1390 do 90 j = 1, num_elem_blk 1391 do 80 m = 1, num_elem_in_block(j) 1392 1393 elem_var_vals(m) = real(k+1) + real(j+1) + 1394 1 (real(m)*time_value) 1395 139680 continue 1397 1398 call expev (exoid, whole_time_step, k, ebids(j), 1399 1 num_elem_in_block(j), elem_var_vals, ierr) 1400 write (iout, '("after expev, error = ", i4)' ) ierr 1401 call expev (exoid2, whole_time_step, k, ebids(j), 1402 1 num_elem_in_block(j), elem_var_vals, ierr) 1403 write (iout, '("after expev (2), error = ", i4)' ) ierr 1404 140590 continue 1406100 continue 1407 1408 whole_time_step = whole_time_step + 1 1409 1410c 1411c update the data file; this should be done at the end of every time 1412c step to ensure that no data is lost if the analysis dies 1413c 1414 call exupda (exoid, ierr) 1415 write (iout, '("after exupda, error = ", i4)' ) ierr 1416 call exupda (exoid2, ierr) 1417 write (iout, '("after exupda (2), error = ", i4)' ) ierr 1418 1419110 continue 1420 1421c 1422c close the EXODUS files 1423c 1424 call exclos (exoid, ierr) 1425 write (iout, '("after exclos, error = ", i4)' ) ierr 1426 1427 call exclos (exoid2, ierr) 1428 write (iout, '("after exclos (2), error = ", i4)' ) ierr 1429 1430 stop 1431 end 1432