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 "@(#)cg.f 1.1 Stardent 90/03/23" C Copyright (c) 1989 by C Stardent Computer Inc. C All Rights Reserved C C c *--------------------------------------------------------* c * * c * **** create_geom **** * c * * c * referenced by: cobj.f * c * * c * cg.f * c *--------------------------------------------------------* subroutine create_geom (avs_obj1, avs_obj2, num_nodes, & num_node_data,nodes,num_1d_elems,elem_1d,num_2d_elems, & elem_2d, num_3d_elems, elem_3d, num_states, node_data, & contour_flag, state, vert_colors, verts, material_table, & group_flag, group_list) include 'read_dyna3d.h' include '/usr/avs/include/geom.inc' integer num_nodes, num_node_data, num_1d_elems, num_2d_elems, 1 num_3d_elems, contour_flag, elem_1d(num_1d_elems, n1d), 2 elem_2d(num_2d_elems, n2d), elem_3d(num_3d_elems, n3d), 3 avs_obj1, avs_obj2, num_states, group_flag, group_list 4 (max_groups),state real nodes(3, num_nodes), node_data(num_nodes, num_node_data, & num_states),model_extent(6), def_fact, material_table(3, & max_material_types),vert_colors(3, 10000), verts(3, 10000) integer elem, node, i, node1, node2, 1 num_verts, elem_topo(4, 6), & j,index, data_index(20), material_code logical in_group, elem_in_group real pverts(3, 10000), red, green, blue, pcolors(3, 10000), 1 scale, comp_def_scale 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/ data data_index/DISP, VELOCITY, ACC, 17*0/ c ************** c *** body *** c ************** avs_obj1 = geom_create_obj (GEOM_POLYTRI, GEOM_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 (contour_flag .ne. 1) then do i = 1, num_nodes vert_colors(1, i) = red vert_colors(1, i) = green vert_colors(1, i) = blue end do end if do elem = 1, num_1d_elems material_code = elem_1d(elem, 3) 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) = material_table(1, material_code) pcolors(2, num_verts) = material_table(2, material_code) pcolors(3, num_verts) = material_table(3, material_code) 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) = material_table(1, material_code) pcolors(2, num_verts) = material_table(2, material_code) pcolors(3, num_verts) = material_table(3, material_code) end do 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, GEOM_NULL) c add 2d elements. do elem = 1, num_2d_elems material_code = elem_2d(elem, 5) in_group = elem_in_group(group_flag, group_list, material_code) 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) if (contour_flag .ne. 1) then pcolors(1, i) = material_table(1, material_code) pcolors(2, i) = material_table(2, material_code) pcolors(3, i) = material_table(3, material_code) else if (in_group) then pcolors(1, i) = vert_colors(1, node) pcolors(2, i) = vert_colors(2, node) pcolors(3, i) = vert_colors(3, node) else pcolors(1, i) = material_table(1, material_code) pcolors(2, i) = material_table(2, material_code) pcolors(3, i) = material_table(3, material_code) end if end do call geom_add_disjoint_polygon (avs_obj2, pverts, & GEOM_NULL, pcolors, 4, ior(GEOM_NOT_SHARED, & GEOM_CONVEX), GEOM_COPY_DATA) end do c add 3d elements. do elem = 1, num_3d_elems material_code = elem_3d(elem, 9) in_group = elem_in_group(group_flag, group_list, material_code) 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) if (contour_flag .ne. 1) then pcolors(1, j) = material_table(1, material_code) pcolors(2, j) = material_table(2, material_code) pcolors(3, j) = material_table(3, material_code) else if (in_group) then pcolors(1, j) = vert_colors(1, node) pcolors(2, j) = vert_colors(2, node) pcolors(3, j) = vert_colors(3, node) else pcolors(1, j) = material_table(1, material_code) pcolors(2, j) = material_table(2, material_code) pcolors(3, j) = material_table(3, material_code) end if end do call geom_add_disjoint_polygon (avs_obj2, pverts, & GEOM_NULL, pcolors, 4, ior(GEOM_NOT_SHARED, GEOM_CONVEX), & GEOM_COPY_DATA) end do end do if ((num_2d_elems .gt. 0) .or. (num_3d_elems .gt. 0)) then call geom_gen_normals (avs_obj2, 0) call geom_cvt_polyh_to_polytri (avs_obj2, & ior(GEOM_SURFACE, GEOM_WIREFRAME)) end if return end