C INTERNATIONAL AVS CENTER C (This disclaimer must remain at the top of all files) C C WARRANTY DISCLAIMER C C This module and the files associated with it are distributed free of charge. C It is placed in the public domain and permission is granted for anyone to use, C duplicate, modify, and redistribute it unless otherwise noted. Some modules C may be copyrighted. You agree to abide by the conditions also included in C the AVS Licensing Agreement, version 1.0, located in the main module C directory located at the International AVS Center ftp site and to include C the AVS Licensing Agreement when you distribute any files downloaded from C that site. C C The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module provide absolutely C NO WARRANTY OF ANY KIND with respect to this software. The entire risk as to C the quality and performance of this software is with the user. IN NO EVENT C WILL The International AVS Center, MCNC, the AVS Consortium and the individual C submitting the module and files associated with said module BE LIABLE TO C ANYONE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE, INCLUDING, C WITHOUT LIMITATION, DAMAGES RESULTING FROM LOST DATA OR LOST PROFITS, OR ANY C SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES. C C This AVS module and associated files are public domain software unless C otherwise noted. Permission is hereby granted to do whatever you like with C it, subject to the conditions that may exist in copyrighted materials. Should C you wish to make a contribution toward the improvement, modification, or C general performance of this module, please send us your comments: why you C liked or disliked it, how you use it, and most important, how it helps your C work. We will receive your comments at avs@ncsc.org. C C Please send AVS module bug reports to avs@ncsc.org. C C "@(#)a1de.f 1.1 Stardent 90/03/23" C Copyright (c) 1989 by C Stardent Computer Inc. C All Rights Reserved C C This software comprises unpublished confidential information of C Stardent Computer Inc. and may not be used, copied or made C available to anyone, except in accordance with the license C under which it is furnished. C C This file is under sccs control at Stardent in: C /sccs/avs/user_modules/data/read_dyna3d/src/s.a1de.f C C c *--------------------------------------------------------* c * * c * **** add_1d_elems **** * c * * c * * c * referenced by: read_dyna3d.f * c * * c * a1de.f * c *--------------------------------------------------------* subroutine create_obj (avs_obj1, avs_obj2, num_nodes, nodes, num_1d_elems, & elem_1d, num_2d_elems, elem_2d, num_3d_elems, elem_3d, & num_steps, node_data, def_num, def_flag) #include "read_dyna3d.h" integer num_nodes, num_1d_elems, num_2d_elems, num_3d_elems, 1 elem_1d(num_1d_elems, 2), elem_2d(num_2d_elems, 4), 2 elem_3d(num_3d_elems, 8), avs_obj1, avs_obj2, num_steps, 3 def_num, def_flag real nodes(3, num_nodes), node_data(num_nodes, max_node_data, num_steps) integer elem, node, i, node1, node2, geom_create_obj, geom_shared, 1 geom_not_shared, geom_convex, num_verts, elem_topo(4, 6), j, 2 index real pverts(3, 10000), red, green, blue, pcolors(3, 10000), verts(3, 10000) data elem_topo/1, 2, 6, 5, 2, 3, 7, 6, 5, 6, 7, 8, 4, 1, 5, 8, 1 3, 4, 8, 7, 4, 3, 2, 1/ c ************** c *** body *** c ************** avs_obj1 = geom_create_obj (GEOM_POLYTRI, NULL) c call geom_add_vertices (avs_obj, verts, num_nodes, GEOM_COPY_DATA) red = 1.0 green = 0.8 blue = 0.0 num_verts = 0 if (def_flag) then index = def_num * 3 do i = 1, num_nodes verts(1, i) = nodes(1, i) + node_data(i, index, state) verts(2, i) = nodes(2, i) + node_data(i, index + 1, state) verts(3, i) = nodes(3, i) + node_data(i, index + 2, state) end do do elem = 1, num_1d_elems node1 = elem_1d(elem, 1) node2 = elem_1d(elem, 2) num_verts = num_verts + 1 pverts(1, num_verts) = verts(1, node1) pverts(2, num_verts) = verts(2, node1) pverts(3, num_verts) = verts(3, node1) pcolors(1, num_verts) = red pcolors(2, num_verts) = green pcolors(3, num_verts) = blue num_verts = num_verts + 1 pverts(1, num_verts) = verts(1, node2) pverts(2, num_verts) = verts(2, node2) pverts(3, num_verts) = verts(3, node2) pcolors(1, num_verts) = red pcolors(2, num_verts) = green pcolors(3, num_verts) = blue end do else do elem = 1, num_1d_elems node1 = elem_1d(elem, 1) node2 = elem_1d(elem, 2) num_verts = num_verts + 1 pverts(1, num_verts) = nodes(1, node1) pverts(2, num_verts) = nodes(2, node1) pverts(3, num_verts) = nodes(3, node1) pcolors(1, num_verts) = red pcolors(2, num_verts) = green pcolors(3, num_verts) = blue num_verts = num_verts + 1 pverts(1, num_verts) = nodes(1, node2) pverts(2, num_verts) = nodes(2, node2) pverts(3, num_verts) = nodes(3, node2) pcolors(1, num_verts) = red pcolors(2, num_verts) = green pcolors(3, num_verts) = blue end do end if call geom_add_disjoint_line (avs_obj1, pverts, pcolors, num_verts, & GEOM_COPY_DATA) c create object for 2d and 3d elements. avs_obj2 = geom_create_obj (GEOM_POLYHEDRON, NULL) c add 2d elements. red = 1.0 green = 0.0 blue = 1.0 if (def_flag) then do elem = 1, num_2d_elems do i = 1, 4 node = elem_2d(elem, i) pverts(1, i) = verts(1, node) pverts(2, i) = verts(2, node) pverts(3, i) = verts(3, node) pcolors(1, i) = red pcolors(2, i) = green pcolors(3, i) = blue end do call geom_add_disjoint_polygon (avs_obj2, pverts, NULL, pcolors, & 4, ior(GEOM_NOT_SHARED, GEOM_CONVEX), & GEOM_COPY_DATA) end do else do elem = 1, num_2d_elems do i = 1, 4 node = elem_2d(elem, i) pverts(1, i) = nodes(1, node) pverts(2, i) = nodes(2, node) pverts(3, i) = nodes(3, node) pcolors(1, i) = red pcolors(2, i) = green pcolors(3, i) = blue end do call geom_add_disjoint_polygon (avs_obj2, pverts, NULL, pcolors, & 4, ior(GEOM_NOT_SHARED, GEOM_CONVEX), & GEOM_COPY_DATA) end do end if c add 3d elements. red = 0.0 green = 1.0 blue = 1.0 if (def_flag) then do elem = 1, num_3d_elems do i = 1, 6 do j = 1, 4 node = elem_3d(elem, elem_topo(j, i)) pverts(1, j) = verts(1, node) pverts(2, j) = verts(2, node) pverts(3, j) = verts(3, node) pcolors(1, j) = red pcolors(2, j) = green pcolors(3, j) = blue end do call geom_add_disjoint_polygon (avs_obj2, pverts, NULL, pcolors, & 4, ior(GEOM_NOT_SHARED, GEOM_CONVEX), & GEOM_COPY_DATA) end do end do else do elem = 1, num_3d_elems do i = 1, 6 do j = 1, 4 node = elem_3d(elem, elem_topo(j, i)) pverts(1, j) = nodes(1, node) pverts(2, j) = nodes(2, node) pverts(3, j) = nodes(3, node) pcolors(1, j) = red pcolors(2, j) = green pcolors(3, j) = blue end do call geom_add_disjoint_polygon (avs_obj2, pverts, NULL, pcolors, & 4, ior(GEOM_NOT_SHARED, GEOM_CONVEX), & GEOM_COPY_DATA) end do end do end if call geom_gen_normals (avs_obj2, 0) call geom_gen_normals (avs_obj2, 0) call geom_cvt_polyh_to_polytri (avs_obj2, ior(GEOM_SURFACE, GEOM_WIREFRAME)) return end