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 "@(#)cobj.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_obj **** *
c * *
c * create an avs object. *
c * *
c * referenced by: read_dyna3d.f *
c * *
c * cobj.f *
c *--------------------------------------------------------*
subroutine create_obj (line_obj, poly_obj, label_obj, 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, state, contour_type, def_flag,
& model_extent, def_fact, contour_flag, data_ranges,
& shrink_flag, shrink_fact, material_table,
& group_flag, group_list, label_flag)
include 'read_dyna3d.h'
integer num_nodes, num_node_data, num_1d_elems, num_2d_elems,
& num_3d_elems,elem_1d(num_1d_elems, n1d),
& elem_2d(num_2d_elems, n2d), elem_3d(num_3d_elems, n3d),
& line_obj, poly_obj, num_states, def_num, def_flag, state,
& contour_flag, contour_type, shrink_flag, shrink_fact,
& group_flag, group_list(max_groups), label_flag, label_obj
real nodes(3, num_nodes), node_data(num_nodes, num_node_data,
& num_states), model_extent(6), def_fact, data_ranges(2,
& num_node_data, num_states), material_table(3,
& max_material_types)
integer elem, node, i, node1, node2, geom_create_obj,
& geom_shared,geom_not_shared, geom_convex, num_verts,
& elem_topo(4, 6), j, index, data_index(20)
real pverts(3, 10000), red, green, blue, pcolors(3, 10000),
& verts(3, 10000), scale, comp_def_scale, vert_colors(3, 10000)
data elem_topo/1, 2, 6, 5, 2, 3, 7, 6, 5, 6, 7, 8, 4, 1, 5, 8,
& 3, 4, 8, 7, 4, 3, 2, 1/
data data_index/DISP, VELOCITY, ACC, 17*0/
c **************
c *** body ***
c **************
if (contour_flag) then
call map_values (num_nodes, num_states, contour_type,
& num_node_data, node_data, vert_colors, state, data_ranges)
else
do i = 1, num_nodes
vert_colors(1, i) = red
vert_colors(1, i) = green
vert_colors(1, i) = blue
end do
end if
if (def_flag) then
scale = comp_def_scale (num_nodes, num_node_data, num_states,
& node_data, state, model_extent, def_fact)
print *, 'scale:', scale
do i = 1, num_nodes
verts(1, i) = nodes(1, i) + scale * node_data(i, 2, state)
verts(2, i) = nodes(2, i) + scale * node_data(i, 3, state)
verts(3, i) = nodes(3, i) + scale * node_data(i, 4, state)
end do
else
do i = 1, num_nodes
verts(1, i) = nodes(1, i)
verts(2, i) = nodes(2, i)
verts(3, i) = nodes(3, i)
end do
end if
write (0, *) '============================================'
write (0, *) 'group:', (group_list(i), i = 1, group_list(1))
write (0, *) '============================================'
if (shrink_flag) then
call create_shrink_geom (line_obj, poly_obj, 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, shrink_fact, material_table,
& group_flag, group_list)
else if (label_flag) then
call create_label (label_obj, 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)
else
call create_geom (line_obj, poly_obj, 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)
end if
return
end