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 "@(#)cl.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_label **** * c * * c * referenced by: cobj.f * c * * c * cl.f * c *--------------------------------------------------------* subroutine create_label (avs_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) 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),state, 2 elem_2d(num_2d_elems, n2d), elem_3d(num_3d_elems, n3d), 3 avs_obj,avs_obj2,num_states,group_flag, group_list(max_groups) 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) character label*10, format*10 integer elem, node, i, node1, node2, 1 num_verts, elem_topo(4, 6), j, 2 index, data_index(20), material_code logical in_group, elem_in_group real label_color(3), cx, cy, cz, ref_pt(3),offset(3), & label_height,pverts(3,4),pcolors(3,4) 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 label_color/1.0, 1.0, 1.0/ data offset/0.0, 0.0, 0.0/ c ************** c *** body *** c ************** avs_obj = geom_create_obj (GEOM_LABEL, GEOM_NULL) label_height = 1.0 / (num_1d_elems + num_2d_elems + num_3d_elems) if (label_height .lt. 0.02) label_height = 0.02 C ifdef use 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) = vert_colors(1, node1) pcolors(2, num_verts) = vert_colors(2, node1) pcolors(3, num_verts) = vert_colors(3, node1) 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) = vert_colors(1, node2) pcolors(2, num_verts) = vert_colors(2, node2) pcolors(3, num_verts) = vert_colors(3, node2) end do C endif c label 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) format = '(i'//char(int(log10(float(elem))) + 49)//')' write (label, format) elem cx = 0.0 cy = 0.0 cz = 0.0 do i = 1, 4 node = elem_2d(elem, i) cx = cx + verts(1, node) cy = cy + verts(2, node) cz = cz + verts(3, node) end do ref_pt(1) = cx / 4.0 ref_pt(2) = cy / 4.0 ref_pt(3) = cz / 4.0 call geom_add_label (avs_obj, label, ref_pt, offset, & label_height, label_color, -1) end do c label 3d elements. C ifdef use do elem = 1, 0 !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 C endif return end