evolver-2.30c.dfsg/ 0000755 0001753 0001753 00000000000 11672223713 014433 5 ustar hazelsct hazelsct evolver-2.30c.dfsg/evolver.1 0000644 0001753 0001753 00000006775 11410765113 016211 0 ustar hazelsct hazelsct .\"Modified from man(1) of FreeBSD, the NetBSD mdoc.template, and mdoc.samples.
.\"See Also:
.\"man mdoc.samples for a complete listing of options
.\"man mdoc for the short list of editing options
.\"/usr/share/misc/mdoc.template
.Dd Mon May 19 2003 \" DATE
.Dt Evolver 1 \" Program name and manual section number
.Sh NAME \" Section Header - required - don't modify
.Nm evolver
.\" The following lines are read in generating the apropos(man -k) database. Use only key
.\" words here as the database is built based on the words here and in the .ND line.
.Nd The Surface Evolver, minimize energy of a surface
.Sh SYNOPSIS \" Section Header - required - don't modify
.Nm
.Op Fl adehimqwxy \" [-adehimqwxy]
.Op Fl f Ar file \" [-f file]
.Op Fl pN \" [-pN]
.Op Ar datafile \" Underlined argument - use .Ar anywhere to underline
.Sh DESCRIPTION \" Section Header - required - don't modify
The Surface Evolver is a program that minimizes the energy of a triangulated
surface according to designated energies and constraints. This man page only
documents command line options and environment variables. The full package
and documentation are available at http://www.susqu.edu/brakke/evolver.
.Pp \" Inserts a space
Command line options:
.Bl -tag -width -indent \" Differs from above in tag removed
.It Ar datafile
Text file defining a surface. If omitted, you will be prompted.
.It Fl a
Autoconvert to named quantities when needed (default is on); use "-a-" to
deactivate autoconversion.
.It Fl d
Begin with parser debugging on (equivalent to "debug" runtime command).
Beware of copious output.
.It Fl e
Echo stdin to stdout; meant for testing piped input.
.It Fl f Ar file
After loading datafile, read commands from
.Ar file ,
then command line prompt.
.It Fl h
Print help for command line options.
.It Fl i
Preserve datafile numbers for element id's, rather than renumbering.
.It Fl m
Begin with memory debugging on (equivalent to "memdebug" runtime command).
Beware of copious output.
.It Fl pN
Run with N concurrent processes.
.It Fl q
Convert to named quantities at start (equivalent to "convert_to_quantities"
runtime command).
.It Fl Q
Suppress echoing of "read" section of datafile, and other files read in.
.It Fl w
Exit immediately after any warning or error message; meant for batch runs.
.It Fl x
Exit immediately after any error message; meant for batch runs.
.It Fl y
Break to user prompt after any warning message.
.El \" Ends the list
.Pp
.\" .Sh ENVIRONMENT \" May not be needed
.\" .Bl -tag -width "ENV_VAR_1" -indent \" ENV_VAR_1 is width of the string ENV_VAR_1
.\" .It Ev ENV_VAR_1
.\" Description of ENV_VAR_1
.\" .It Ev ENV_VAR_2
.\" Description of ENV_VAR_2
.\" .El
.Sh ENVIRONMENT VARIABLES
.Bl -tag -width "EVOLVERPATH" -compact
.It EVOLVERPATH
Colon-separated list of paths automatically searched for datafiles, included
files, or help documentation.
.Sh FURTHER DOCUMENTATION
See manual224.pdf in the Evolver distribution, browse evolver.htm in the
doc subdirectory of the distribution, or browse the documentation on-line
at http://www.susqu.edu/brakke/evolver/html/evolver.htm
.Sh WEBSITE
The Surface Evolver home page is http://www.susqu.edu/brakke/evolver.
.Sh BUGS
Send bug reports to brakke@susqu.edu. Please include the datafile and
exact instructions for reproducing the problem.
evolver-2.30c.dfsg/README 0000644 0001753 0001753 00000012567 11410765113 015321 0 ustar hazelsct hazelsct Instructions for installing the Surface Evolver on unix-style systems.
Quick start:
1. Unpack the Evolver archive.
2. In the src subdirectory, edit Makefile to uncomment the lines for
your system.
3. Run "make".
4. Test by running "./evolver ../fe/cube.fe"
Detailed instructions:
1. The Evolver is distributed in a compressed tar archive evolver-2.30.tar.gz
available from http://www.susqu.edu/brakke/evolver. Get this file into a
working directory. The packed archive is about 2MB, unpacks to about 5MB.
You will probably need another 3 or 4 MB to compile.
2. Uncompress the archive with
gunzip evolver-2.30.tar.gz
Extract the files with
tar xvf evolver.tar
This will unpack into three subdirectories: src (source code),
doc (the html version of the manual), and fe (sample datafiles).
The working directory will also contain a PDF version of the manual,
and a man page, evolver.1.
3. Install the man page: copy evolver.1 to some appropriate place on your
manpath, such as /usr/local/share/man/man1. You may have to become root
to have permission to do this.
4. Set the EVOLVERPATH environment variable: Evolver needs to find the initial
datafile and sometimes other files (e.g. command files for the "read"
command, the help documentation files). If the named file is not in the
current directory, then an environment variable called EVOLVERPATH will be
consulted for a directory search list. The datafile directory and the
directory with the HTML documentation files should definitely be included.
The format is the same as the usual PATH environment variable. Set it up
as usual in your system, in .profile or .login or .cshrc or wherever:
Unix C shell:
setenv EVOLVERPATH /usr/you/evolver/fe:/usr/you/evolver/doc
Bourne shell:
EVOLVERPATH=/usr/you/evolver/fe:/usr/you/evolver/doc
export EVOLVERPATH
5. Change to the src subdirectory of your Evolver directory.
6. Modify Makefile for your system. Makefile begins with sets of macro
definitions for various systems. If your system is listed, remove the
comment symbols '#' from start of the appropriate lines. If your system
is not there, use the GENERIC lines, or set up your own. If you do define
your own, be sure to put a corresponding section in include.h.
7. In Makefile, edit the CFLAGS line to have the proper options (optimization,
floating point option, etc.).
8. In Makefile, GRAPH should be the name of a screen graphics interface file.
Use glutgraph.o if possible; most systems have OpenGL/GLUT graphics now.
GLUT graphics uses a separate thread to display graphics, so if you use
GLUT, you must put -DPTHREADS in CFLAGS and put -lpthread in GRAPHLIB.
If not using GLUT, for primitive X windows graphics you can use xgraph.o.
For no built-in screen graphics at all you can use nulgraph.o. GRAPHLIB
should be the appropriate graphics library plus any other libraries needed.
9. If you want to use parallel processes on a multiprocessor machine,
put -DPTHREADS in CFLAGS and put -lpthread in GRAPHLIB. Currently, the
only calculations done in parallel are basic energies and named quantities.
The number of processes actually done in parallel can be controlled
with the -p n command line option.
10. If you want Evolver to be able to use geomview, include -DOOGL in CFLAGS.
11. If you want Evolver to operate in a higher space dimension than the
the default maximum of 4, include -DMAXCOORD=n in CFLAGS, where n is
the maximum space dimension. This sets the upper limit of dimensionality,
and is used for allocating space in data structures.
12. If your system supports the long double data type, you can compute and
print values in higher precision by compiling with -DLONGDOUBLE in CFLAGS.
But this slows computations, and should be used only by precision fanatics.
13. If you wish to use the commands based on the METIS partitioning
software (metis, kmetis, body_metis, and metis_factor), then
you should download the METIS package from,
http://www-users.cs.umn.edu/~karypis/metis/
and "make" the library libmetis.a (on some systems, make complains it
cannot find ranlib, but the resulting libmetis.a still works).
In Evolver's Makefile, add -DMETIS to CFLAGS, and add -lmetis to GRAPHLIB.
You will probably also have to add -L metispath to GRAPHLIB to tell
the linker where to find libmetis.a. Note that METIS is incorporated
in the Windows executable. If you are using hessian commands on very
large surfaces, then metis_factor can be much faster than the other
sparse matrix factoring schemes in Evolver, and I highly recommend it.
14. From the shell command prompt in the src directory, run "make". This
will produce the Evolver executable file named "evolver" in the src
directory. If there are errors, hopefully you will only have to change
the system-specific parts of Makefile and include.h to get things to work.
If significant changes to other files are needed, let me know at
brakke@susqu.edu.
15. Copy the evolver executable to someplace on your PATH, such as
$HOME/bin or /usr/local/bin, or make a link someplace on your PATH to
the evolver executable.
16. Test by opening a new shell and running "evolver cube". Now you
should be able to follow the tutorials in the HTML or printed manual.
End of README
evolver-2.30c.dfsg/fe/ 0000755 0001753 0001753 00000000000 11410765113 015020 5 ustar hazelsct hazelsct evolver-2.30c.dfsg/fe/unshear.cmd 0000755 0001753 0001753 00000005546 11410765113 017167 0 ustar hazelsct hazelsct // unshear.cmd
// Evolver command to get torus fundamental region closer to rectangular.
// Works in either 2 or 3 dimensions. (eventually, just 2D now)
// NOTE: "unshear" needs to change the torus periods, but can't directly
// since torus_periods is a read-only variable (because it is remembered
// as a formula). So the assumption is that the shear entries of the
// torus_periods matrix are variables of particular names, shearij for
// torus_periods[i][j]. (remember indexing starts with 1)
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
if not is_defined("shear21") then
errprintf "unshear.cmd assumes torus_periods[2][1] defined as shear21.\n" ;
// 2D version
unshear2 := {
local shifts,vshifts,wrap1,wrap2,wraprest;
// test for horizontal shear
shifts := floor(torus_periods[2][1]/torus_periods[1][1] + .5);
shear21 -= shifts*torus_periods[1][1];
// move vertices over
foreach vertex vv do
{ vshifts := -floor(vv.x*inverse_periods[1][1]+vv.y*inverse_periods[1][2]);
if vshifts != 0 then
wrap_vertex(vv.id,(vshifts imod 32));
};
// change edge wraps
foreach edge ee where ((ee.wrap idiv 64) imod 32) == 1 do
{ wrap1 := ee.wrap imod 64;
wraprest := ee.wrap - wrap1;
if wrap1 > 15 then wrap1 -= 32;
wrap1 += shifts;
ee.wrap := wraprest + (wrap1 imod 32);
};
foreach edge ee where ((ee.wrap idiv 64) imod 32) == 31 do
{ wrap1 := ee.wrap imod 64;
wraprest := ee.wrap - wrap1;
if wrap1 > 15 then wrap1 -= 32;
wrap1 += -shifts;
ee.wrap := wraprest + (wrap1 imod 32);
};
recalc; // get inverse periods set up right for next stage
// test for vertical shear
shifts := floor(torus_periods[1][2]/torus_periods[2][2] + .5);
shear12 -= shifts*torus_periods[2][2];
// move vertices over
foreach vertex vv do
{ vshifts := -floor(vv.x*inverse_periods[2][1]+vv.y*inverse_periods[2][2]);
if vshifts != 0 then
wrap_vertex(vv.id,(vshifts imod 32)*64);
};
// change edge wraps
foreach edge ee where (ee.wrap imod 32) == 1 do
{ wrap2 := (ee.wrap idiv 64) imod 64;
wraprest := ee.wrap - wrap2*64;
if wrap2 > 15 then wrap2 -= 32;
wrap2 += shifts;
ee.wrap := wraprest + (wrap2 imod 32)*64;
};
foreach edge ee where (ee.wrap imod 32) == 31 do
{ wrap2 := (ee.wrap idiv 64) imod 64;
wraprest := ee.wrap - wrap2*64;
if wrap2 > 15 then wrap2 -= 32;
wrap2 -= shifts;
ee.wrap := wraprest + (wrap2 imod 32)*64;
};
}
// 3D version
unshear3 := {
errprintf "Unshear not yet implemented for 3D.\n";
}
// Overall command, just a wrapper
unshear := {
if not torus then
{ errprintf "Unshear only relevant to torus model.\n";
return;
};
if space_dimension == 2 then unshear2
else if space_dimension == 3 then unshear3
else errprintf "Unshear not implemented for space dimension %d\n",
space_dimension;
}
evolver-2.30c.dfsg/fe/quadbbox.cmd 0000755 0001753 0001753 00000012535 11410765113 017323 0 ustar hazelsct hazelsct // quadbbox.cmd
// Finds bounding box for each facet in quadratic model.
// Not suitable for torus model.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: Run eboxes or fboxes. Results left in the arrays ebox or fbox
// attributes.
define edge attribute ebox real [6] // xmin,xmax,ymin,ymax,zmin,zmax
define facet attribute fbox real [6]
eboxes := {
local ii,v0,v1,v2,v4,uopt,denom;
if ( !quadratic ) then print "eboxes: Must be in quadratic mode.\n"
else foreach edge ee do
{ ii := 1;
while ( ii <= 3 ) do
{
if ( ii == 1 ) then
{ v0 := ee.vertex[1].x;
v2 := ee.vertex[2].x;
v1 := ee.vertex[3].x;
} else if ( ii == 2 ) then
{ v0 := ee.vertex[1].y;
v2 := ee.vertex[2].y;
v1 := ee.vertex[3].y;
} else
{ v0 := ee.vertex[1].z;
v2 := ee.vertex[2].z;
v1 := ee.vertex[3].z;
} ;
if ( v0 > v1 )
then { set ee ebox[2*ii-1] v1; set ee ebox[2*ii] v0; }
else { set ee ebox[2*ii-1] v0; set ee ebox[2*ii] v1; };
if ( v2 < ee.ebox[2*ii-1] ) then set ee ebox[2*ii-1] v2;
if ( v2 > ee.ebox[2*ii] ) then set ee ebox[2*ii] v2;
denom := v0 - 2*v1 + v2;
if ( denom == 0.0 ) then { ii := ii+1; continue; };
uopt := (-1.5*v0 + 2*v1 - .5*v2)/denom;
if ( uopt <= 0.0 or uopt >= 1.0 )
then { ii := ii+1;continue; };
v4 := 0.5*(1-uopt)*(2-uopt)*v0 + uopt*(2-uopt)*v1
+ 0.5*uopt*(uopt-1)*v2;
if ( v4 < ee.ebox[2*ii-1] ) then set ee ebox[2*ii-1] v4;
if ( v4 > ee.ebox[2*ii] ) then set ee ebox[2*ii] v4;
ii := ii + 1;
}
}
}
fboxes := {
local ii,v0,v1,v2,v3,v4,v5,uopt,denom;
local a11,a12,b1,a21,a22,b2,vopt,vcrit;
eboxes;
if ( ! quadratic ) then print "fboxes: Must be in quadratic mode.\n"
else foreach facet ff do
{
ii := 0; /* which coordinate */
while ( ii < 3 ) do
{ ii := ii + 1; // so can use continue
/* first, edge boxes */
set ff fbox[2*ii-1] ff.edge[1].ebox[2*ii-1];
set ff fbox[2*ii] ff.edge[1].ebox[2*ii];
if ( ff.edge[2].ebox[2*ii-1] < ff.fbox[2*ii-1] )
then set ff fbox[2*ii-1] ff.edge[2].ebox[2*ii-1];
if ( ff.edge[2].ebox[2*ii] > ff.fbox[2*ii] )
then set ff fbox[2*ii] ff.edge[2].ebox[2*ii];
if ( ff.edge[3].ebox[2*ii-1] < ff.fbox[2*ii-1] )
then set ff fbox[2*ii-1] ff.edge[3].ebox[2*ii-1];
if ( ff.edge[3].ebox[2*ii] > ff.fbox[2*ii] )
then set ff fbox[2*ii] ff.edge[3].ebox[2*ii];
if ( ii == 1 ) then
{ v0 := ff.edge[1].vertex[1].x;
v1 := ff.edge[1].vertex[3].x;
v2 := ff.edge[1].vertex[2].x;
v3 := ff.edge[3].vertex[3].x;
v4 := ff.edge[2].vertex[3].x;
v5 := ff.edge[2].vertex[2].x;
} else if ( ii == 2 ) then
{ v0 := ff.edge[1].vertex[1].y;
v1 := ff.edge[1].vertex[3].y;
v2 := ff.edge[1].vertex[2].y;
v3 := ff.edge[3].vertex[3].y;
v4 := ff.edge[2].vertex[3].y;
v5 := ff.edge[2].vertex[2].y;
} else
{ v0 := ff.edge[1].vertex[1].z;
v1 := ff.edge[1].vertex[3].z;
v2 := ff.edge[1].vertex[2].z;
v3 := ff.edge[3].vertex[3].z;
v4 := ff.edge[2].vertex[3].z;
v5 := ff.edge[2].vertex[2].z;
};
// x_u coeff of u
a11 := v0 - 2*v1 + v2;
// x_u coeff of v
a12 := v0 - v1 - v3 + v4;
// x_u rhs
b1 := -(-1.5*v0 + 2*v1 - .5*v2);
// x_v coeff of u
a21 := v0 - v1 - v3 + v4;
// x_v coeff of v
a22 := v0 - 2*v3 + v5;
// x_v rhs
b2 := -(-1.5*v0 + 2*v3 - 0.5*v5);
// solve for critical point
denom := a11*a22 - a12*a21;
if ( denom == 0.0 ) then continue;
uopt := (b1*a22 - b2*a12)/denom;
vopt := (a11*b2 - a21*b1)/denom;
if ( uopt <= 0.0 ) then continue;
if ( vopt <= 0.0 ) then continue;
if ( uopt+vopt >= 2.0 ) then continue;
vcrit := 0.5*(uopt+vopt-1)*(uopt+vopt-2)*v0
+ uopt*(2-uopt-vopt)*v1
+ 0.5*uopt*(uopt-1)*v2
+ vopt*(2-uopt-vopt)*v3
+ uopt*vopt*v4
+ 0.5*vopt*(vopt-1)*v5;
if ( vcrit < ff.fbox[2*ii-1] ) then set ff fbox[2*ii-1] vcrit;
if ( vcrit > ff.fbox[2*ii] ) then set ff fbox[2*ii] vcrit;
}
}
}
evolver-2.30c.dfsg/fe/ansurf.cmd 0000755 0001753 0001753 00000004433 11410765113 017012 0 ustar hazelsct hazelsct // ansurf.cmd
// Surface Evolver command to produce file of ANSYS input for
// vertices, edges, and faces to produce a surface
// for ANSYS meshing. Beware this is a very simple-minded
// translation to ANSYS format.
// Modified Feb. 2006 to not assume consecutive numbering of elements.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// usage: ansurf >>> "filename"
// Attributes to hold ANSYS numbering of elements
define vertex attribute ansurf_knumber real
define edge attribute ansurf_lnumber real
define facet attribute ansurf_alnumber real
// vertices as ANSYS keypoints
ansurf_nodes := {
local knumber;
knumber := 0;
foreach vertex vv do
{ printf "k,,%20.15g,%20.15g,%20.15g\n",x,y,z;
knumber += 1;
vv.ansurf_knumber := knumber;
}
}
ansurf_edges := {
local lnumber;
lnumber := 0;
if (quadratic) then
foreach edge ee do
{ printf "larc,%g,%g,%g\n",ee.vertex[1].ansurf_knumber,
ee.vertex[2].ansurf_knumber,ee.vertex[3].ansurf_knumber;
lnumber += 1;
ee.ansurf_lnumber := lnumber;
}
else
foreach edge ee do
{ printf "l,%g,%g\n",ee.vertex[1].ansurf_knumber,
ee.vertex[2].ansurf_knumber;
lnumber += 1;
ee.ansurf_lnumber := lnumber;
}
}
ansurf_faces := {
local alnumber;
alnumber := 0;
foreach facet ff do
{ printf "al,%g,%g,%g\n",
ff.edge[1].ansurf_lnumber,ff.edge[2].ansurf_lnumber,
ff.edge[3].ansurf_lnumber;
alnumber += 1;
ff.ansurf_alnumber := alnumber;
}
}
// define volumes, one per body
ansurf_bodies := { foreach body bb do
{ // select areas
local flag;
flag := 0;
foreach bb.facet ff do
{ if flag then printf "ASEL,A,AREA,,%g,%g\n",ff.ansurf_alnumber,
ff.ansurf_alnumber
else printf "ASEL,S,AREA,,%g,%g\n",ff.ansurf_alnumber,
ff.ansurf_alnumber;
flag := 1;
};
printf "VA,ALL\n";
}
}
// define areas
ansurf := { printf "/PREP7\n";
printf "/NOPR\n";
ansurf_nodes;
ansurf_edges;
ansurf_faces;
ansurf_bodies;
}
// Usage: ansurf >>> "ansys_file"
evolver-2.30c.dfsg/fe/x3d.cmd 0000755 0001753 0001753 00000004676 11410765113 016223 0 ustar hazelsct hazelsct // x3d.cmd
// Surface Evolver script to export surface as an X3D file for 3D viewing
// in a browser.
// Usage: x3d >>> "filename.x3d"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
define rgb real[16][4];
rgb[1][1] := 0.0; rgb[1][2] := 0.0; rgb[1][3] := 0.0;
rgb[2][1] := 0.0; rgb[2][2] := 0.0; rgb[2][3] := 1.;
rgb[3][1] := 0.0; rgb[3][2] := 1.; rgb[3][3] := 0.0;
rgb[4][1] := 0.0; rgb[4][2] := 1.; rgb[4][3] := 1.;
rgb[5][1] := 1.; rgb[5][2] := 0.0; rgb[5][3] := 0.0;
rgb[6][1] := 1.; rgb[6][2] := 0.0; rgb[6][3] := 1.;
rgb[7][1] := 1.; rgb[7][2] := 0.5; rgb[7][3] := 0.;
rgb[8][1] := .6; rgb[8][2] := .6; rgb[8][3] := .6;
rgb[9][1] := .3; rgb[9][2] := .3; rgb[9][3] := .3;
rgb[10][1] := .3; rgb[10][2] := .8; rgb[10][3] := 1.;
rgb[11][1] := .5; rgb[11][2] := 1.; rgb[11][3] := .5;
rgb[12][1] := .5; rgb[12][2] := 1.; rgb[12][3] := 1.;
rgb[13][1] := 1.; rgb[13][2] := .5; rgb[13][3] := .5;
rgb[14][1] := 1.; rgb[14][2] := .5; rgb[14][3] := 1;
rgb[15][1] := 1.; rgb[15][2] := 1.; rgb[15][3] := .0;
rgb[16][1] := 1; rgb[16][2] := 1; rgb[16][3] := 1;
x3d := {
printf"\n";
printf"\n";
printf "\n";
printf " \n";
printf " \n",datafilename;
printf " \n";
printf " \n";
printf " \n";
printf " \n";
printf " \n";
foreach facet ff where color >= 0 do
{ printf " \n";
printf " \n";
printf " \n", rgb[ff.color+1][1],
rgb[ff.color+1][2],rgb[ff.color+1][3];
printf " \n";
printf " \n";
printf " \n",
ff.vertex[1].x,ff.vertex[1].y,ff.vertex[1].z,
ff.vertex[2].x,ff.vertex[2].y,ff.vertex[2].z,
ff.vertex[3].x,ff.vertex[3].y,ff.vertex[3].z;
printf " \n";
printf " \n";
};
printf " \n";
printf " \n";
printf "\n";
}
evolver-2.30c.dfsg/fe/octa.fe 0000644 0001753 0001753 00000002113 11410765113 016257 0 ustar hazelsct hazelsct // octa.fe
// Evolver data file for symmetric nonstable film in octahedral frame.
// Pop edges, iterate, then pop vertices.
vertices
1 0 0 0
2 2 0 0 fixed
3 0 2 0 fixed
4 -2 0 0 fixed
5 0 -2 0 fixed
6 0 0 2 fixed
7 0 0 -2 fixed
edges
1 2 3 fixed
2 3 4 fixed
3 4 5 fixed
4 5 2 fixed
5 2 6 fixed
6 3 6 fixed
7 4 6 fixed
8 5 6 fixed
9 7 2 fixed
10 7 3 fixed
11 7 4 fixed
12 7 5 fixed
13 1 2
14 1 3
15 1 4
16 1 5
17 1 6
18 7 1
faces
1 13 1 -14
2 14 2 -15
3 15 3 -16
4 16 4 -13
5 13 5 -17
6 14 6 -17
7 15 7 -17
8 16 8 -17
9 9 -13 -18
10 10 -14 -18
11 11 -15 -18
12 12 -16 -18
read
// Typical evolution, winding up with the central tetrahedral point
// version of the octahedral film. This evolution is not real tidy,
// taking several more pops before settling down, but is just recorded
// from a trial sequence without tidying up.
gogo := { o; U; g 20; t .1; g 10; o; g 20; u; V; t .1; o; g 12; o; u;
V; u; V; g 10; t .1; o; V; g 10; t .1; u; V; g 10; t .1; g 10;
}
evolver-2.30c.dfsg/fe/gaussref.cmd 0000755 0001753 0001753 00000004625 11410765113 017336 0 ustar hazelsct hazelsct // gaussref.cmd
// Refining using Gauss map as criterion.
// Refines edges where difference in normal
// exceeds user-set amount.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: set the variable gaussref_tolerance, and do gaussref.
// Set by user; difference in normals in radians
gaussref_tolerance := 0.3
gaussref := {
local ax,ay,az,bx,by,bz,diff,maga,magb,alen,maxdiff,triples,blen;
local gaussref_count;
gaussref_count := 0;
foreach edge eee do
{ if max ( eee.vertex[1].edge,valence) <= 2 and
max ( eee.vertex[2].edge,valence) <= 2 then
{ ax := eee.vertex[1].vertexnormal[1];
ay := eee.vertex[1].vertexnormal[2];
az := eee.vertex[1].vertexnormal[3];
bx := eee.vertex[2].vertexnormal[1];
by := eee.vertex[2].vertexnormal[2];
bz := eee.vertex[2].vertexnormal[3];
diff := pi/2 - abs(pi/2 - acos(ax*bx+ay*by+az*bz)) ;
if ( diff > gaussref_tolerance )
then {
refine eee; gaussref_count += 1;
}
}
else if eee.valence == 2 then
{ ax := eee.facet[1].x[1];
ay := eee.facet[1].x[2];
az := eee.facet[1].x[3];
bx := eee.facet[2].x[1];
by := eee.facet[2].x[2];
bz := eee.facet[2].x[3];
maga := sqrt(ax^2+ay^2+az^2);
magb := sqrt(bx^2+by^2+bz^2);
diff := pi/2 - abs(pi/2 - acos((ax*bx+ay*by+az*bz)/maga/magb)) ;
if ( diff > gaussref_tolerance )
then {
refine eee; gaussref_count += 1;
}
}
else if eee.valence >= 3 then
{ // check bend in continuation triple lines
ax := eee.x;
ay := eee.y;
az := eee.z;
alen := eee.length;
maxdiff := 0;
triples := 0;
foreach eee.vertex vvv do
{ foreach vvv.edge eeee where (eeee.id != eee.id) and (valence >= 3) do
{ triples += 1;
bx := eeee.x;
by := eeee.y;
bz := eeee.z;
blen := eeee.length;
diff := pi/2 - abs(pi/2 - acos((ax*bx+ay*by+az*bz)/alen/blen)) ;
if ( diff > gaussref_tolerance )
then {
if ( diff > maxdiff ) then maxdiff := diff;
}
}
};
if ( (triples <= 1) and (maxdiff > gaussref_tolerance) )
then {
refine eee; gaussref_count += 1;
}
}
};
printf "Edges refined by gaussref: %d\n",gaussref_count;
}
evolver-2.30c.dfsg/fe/mound.fe 0000644 0001753 0001753 00000004032 11410765113 016455 0 ustar hazelsct hazelsct // mound.fe
// Evolver data for drop of prescribed volume sitting on plane with gravity.
// Contact angle with plane can be varied.
PARAMETER angle = 90 // interior angle between plane and surface, degrees
gravity_constant 0 // start with gravity off
#define WALLT (-cos(angle*pi/180)) // virtual tension of facet on plane
constraint 1 /* the table top */
formula: x3 = 0
energy: // for contact angle
e1: -(WALLT*y)
e2: 0
e3: 0
vertices
1 0.0 0.0 0.0 constraint 1 /* 4 vertices on plane */
2 1.0 0.0 0.0 constraint 1
3 1.0 1.0 0.0 constraint 1
4 0.0 1.0 0.0 constraint 1
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
9 2.0 2.0 0.0 fixed /* for table top */
10 2.0 -1.0 0.0 fixed
11 -1.0 -1.0 0.0 fixed
12 -1.0 2.0 0.0 fixed
edges /* given by endpoints and attribute */
1 1 2 constraint 1 /* 4 edges on plane */
2 2 3 constraint 1
3 3 4 constraint 1
4 4 1 constraint 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 5
10 2 6
11 3 7
12 4 8
13 9 10 no_refine fixed /* for table top */
14 10 11 no_refine fixed
15 11 12 no_refine fixed
16 12 9 no_refine fixed
faces /* given by oriented edge loop */
1 1 10 -5 -9
2 2 11 -6 -10
3 3 12 -7 -11
4 4 9 -8 -12
5 5 6 7 8
7 13 14 15 16 no_refine density 0 fixed /* table top for display */
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 volume 1 density 1
read
re := {refine edges where on_constraint 1 }
// Typical evolution
gogo := { re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Evolution with 45 degree contact angle
gogo2 := { angle := 45; re; g 5; V;V; r; g 5; V;V; r; g 5; hessian; hessian; }
// Evolution with 90 contact and high gravity
gogo3 := { angle := 90; G 5; re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Evolution with 90 contact and negative gravity, i.e. pendant drop
gogo4 := { angle := 90; G -2; re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Pendant drop falling off ceiling
gogo5 := { angle := 90; G -5; re; g 10; t .1; unset vertex constraint 1; g 3; }
evolver-2.30c.dfsg/fe/iges128.cmd 0000755 0001753 0001753 00000017335 11410765113 016703 0 ustar hazelsct hazelsct // iges128.cmd
// Surface Evolver script to write IGES file for surface, using IGES
// rational B-spline entity (type 128).
// Documentation on IGES format: http://www.iges5x.org/taxonomy/
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// usage: iges >>> "filename.igs"
// Set up color translation array
define iges_colors integer [16];
//iges_colors[black] := 1
iges_colors[red] := 2
iges_colors[green] := 3
iges_colors[blue] := 4
iges_colors[yellow] := 5
iges_colors[magenta] := 6
iges_colors[cyan] := 7
iges_colors[white] := 8
iges_colors[brown] := -1 // using colors defined at start of directory
iges_colors[lightgray] := -3
iges_colors[darkgray] := -5
iges_colors[lightblue] := -7
iges_colors[lightgreen] := -9
iges_colors[lightcyan] := -11
iges_colors[lightred] := -13
iges_colors[lightmagenta] := -15
iges := {
// Flag section
// Don't need this since not doing binary or compressed format.
// Start section
start_counter := 0;
start_counter += 1;
printf "%-72sS%07d\n","IGES version of Surface Evolver surface",start_counter;
start_counter += 1;
printf " %-69sS%07d\n",datafilename,start_counter;
start_counter += 1;
printf "%-72sS%07d\n","Created using iges.cmd Evolver script.",
start_counter;
// Global section
global_counter := 0;
global_counter += 1;
printf "%-72sG%07d\n","1H,,1H;,",global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
message := sprintf "%s,",datafilename;
printf "%02dH%-69sG%07d\n",sizeof(datafilename),message,global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","32,75,6,75,15,,1.0,1,2HIN,32768,0.0394,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000,", global_counter; // date
xmax := max(vertex,abs(x));
ymax := max(vertex,abs(y));
zmax := max(vertex,abs(z));
maxsize := (xmax > ymax) ? xmax : ymax;
maxsize := (zmax > maxsize) ? zmax : maxsize;
message := sprintf "%g,%g,",maxsize/10000000,maxsize;
global_counter += 1;
printf "%-72sG%07d\n",message, global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Name of author"),"Name of author,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Author's organization"),
"Author's organization,", global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000;", global_counter; // date
// Directory entry section. Each entry 20 8-char fields on two lines.
// Fields with default values
entype := 0; // 1 and 11
paramdata := 1; // 2
structure := 0; // 3
linefont := 0; // 4
level := 0; // 5
view := 0; // 6
transmat := 0; // 7
label := 0; // 8
status := "00000000"; // 9; actually 4 two-digit numbers
directory_counter := 0; // 10 and 20
lineweight := 0; // 12
colornum := 0; // 13
paramcount := 0; // 14
form := 0; // 15
reserved := " 0"; // 16 and 17
entlabel := "entity"; // 18
entsubscr := 0; // 19
// Color definitions for those Evolver colors not supplied in IGES
entype := 314;
paramcount := 1;
status := "00000200";
approxcolor := 7; // incompetent systems default to cyan
entlabel := "COLOR";
form := 0;
for ( cinx := 1 ; cinx <= 8 ; cinx += 1 )
{ directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,
approxcolor,
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
paramdata += 1;
};
// Facets as "rational b-spline" types
entype := 128;
status := "00000000";
paramcount := 7; // lines of parameters
form := 8;
entlabel := " FACET";
define facet attribute fpdata integer;
define facet attribute fdir integer;
foreach facet ff do
{ ff.fpdata := paramdata;
entsubscr := ff.id;
directory_counter += 1; ff.fdir := directory_counter;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,
iges_colors[ff.color],
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
paramdata += paramcount;
};
// Parameter data section
parameter_counter := 1;
// Color definitions
dirnum := 1; // corresponding directory line
printf "%-64s%8dP%7d\n","314,100.,50.,0.;",dirnum,parameter_counter; // brown
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,60.,60.,60.;",dirnum,parameter_counter; // l. gray
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,30.,30.,30.;",dirnum,parameter_counter; // d. gray
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,30,80,100;",dirnum,parameter_counter; // l. blue
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,50,100,50;",dirnum,parameter_counter; // l. grn
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,50,100,100;",dirnum,parameter_counter; // l. cyan
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,100,50,50;",dirnum,parameter_counter; // l. red
parameter_counter += 1; dirnum += 2;
printf "%-64s%8dP%7d\n","314,100,50,100;",dirnum,parameter_counter; // l. mag.
// Facets
entype := 128;
k_1 := 1; // knots-1
k_2 := 1; //
m_1 := 1; // degree
m_2 := 1; //
prop1 := 0; // not closed in first paramter
prop2 := 0; // not closed in second parameter
prop3 := 1; // polynomial instead of rational
prop4 := 0; // nonperiodic in first parameter
prop5 := 0; // nonperiodic in second parameter
minu := 0;
maxu := 1;
minv := 0;
maxv := 1;
foreach facet ff do
{ parameter_counter += 1;
if ff.fpdata != parameter_counter then
errprintf
"ERROR: bad facet parameter line number, facet %d. Is %d, should be %d.\n",
ff.id,parameter_counter,ff.fpdata;
message := sprintf "%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,",entype,k_1,k_2,m_1,m_2,
prop1,prop2,prop3,prop4,prop5;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := "0.0,0.0,1.0,1.0,0.0,0.0,1.0,1.0,1.0,1.0,1.0,1.0,";
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := sprintf "%9.7f,%9.7f,%9.7f,",
ff.vertex[1].x,ff.vertex[1].y,ff.vertex[1].z;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := sprintf "%9.7f,%9.7f,%9.7f,",
ff.vertex[2].x,ff.vertex[2].y,ff.vertex[2].z;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := sprintf "%9.7f,%9.7f,%9.7f,",
ff.vertex[3].x,ff.vertex[3].y,ff.vertex[3].z;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := sprintf "%9.7f,%9.7f,%9.7f,",
ff.vertex[3].x,ff.vertex[3].y,ff.vertex[3].z;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := "0.0,1.0,0.0,1.0;"; //minu,maxu,minv,maxv;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
};
// Terminate section
printf "S%07dG%07dD%07dP%07d%40sT0000001\n",start_counter,global_counter,
directory_counter,parameter_counter," ";
}
evolver-2.30c.dfsg/fe/rewrap.cmd 0000755 0001753 0001753 00000004024 11410765113 017010 0 ustar hazelsct hazelsct // rewrap.cmd
// Commands to rewrap torus vertices and edges to get them nicely
// within unit cell. This version does 3D; for 2D see rewrap2.cmd.
// Moves vertices at most one period at a time, so you may have to
// repeat if things are very bad to start with.
// Uses torus wrap representation and wrap_vertex builtin command.
// Usage: rewrap
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
rewrap := {
if space_dimension != 3 then
{ errprintf"rewrap is for space dimension 3; for 2D use rewrap2.cmd.\n";
return;
};
define body attribute old_volume real; // so can adjust volconst
set body old_volume volume;
foreach vertex vv where vv.x*inverse_periods[1][1]+vv.y*inverse_periods[1][2]
+ vv.z*inverse_periods[1][3] < 0 do wrap_vertex(vv.id,1);
foreach vertex vv where vv.x*inverse_periods[1][1]+vv.y*inverse_periods[1][2]
+ vv.z*inverse_periods[1][3] >= 1 do wrap_vertex(vv.id,31);
foreach vertex vv where vv.x*inverse_periods[2][1]+vv.y*inverse_periods[2][2]
+ vv.z*inverse_periods[2][3] < 0 do wrap_vertex(vv.id,64);
foreach vertex vv where vv.x*inverse_periods[2][1]+vv.y*inverse_periods[2][2]
+ vv.z*inverse_periods[2][3] >= 1 do wrap_vertex(vv.id,1984);
foreach vertex vv where vv.x*inverse_periods[3][1]+vv.y*inverse_periods[3][2]
+ vv.z*inverse_periods[3][3] < 0 do wrap_vertex(vv.id,4096);
foreach vertex vv where vv.x*inverse_periods[3][1]+vv.y*inverse_periods[3][2]
+ vv.z*inverse_periods[3][3] >= 1 do wrap_vertex(vv.id,126976);
recalc;
// Adjust volconst
local torvol;
torvol := abs((torus_periods[1][1]*torus_periods[2][2]
- torus_periods[1][2]*torus_periods[2][1])*torus_periods[3][3]
+ (torus_periods[1][2]*torus_periods[2][3]
- torus_periods[1][3]*torus_periods[2][2])*torus_periods[3][1]
+ (torus_periods[1][3]*torus_periods[2][1]
- torus_periods[1][1]*torus_periods[2][3])*torus_periods[3][2]);
set body volconst floor((old_volume - volume - volconst)/torvol+.5)*torvol;
}
evolver-2.30c.dfsg/fe/simplex3.fe 0000644 0001753 0001753 00000000765 11410765113 017110 0 ustar hazelsct hazelsct // simplex3.fe
// Evolver data for bubble in 4-space. Initially simplex.
// Evolves into 3-sphere in 4-space.
SIMPLEX_REPRESENTATION
SPACE_DIMENSION 4
SURFACE_DIMENSION 3
vertices
1 0 0 0 0
2 1 0 0 0
3 0 1 0 0
4 0 0 1 0
5 0 0 0 1
faces /* given as oriented vertex list */
1 2 3 4 5
2 3 4 5 1
3 4 5 1 2
4 5 1 2 3
5 1 2 3 4
bodies
1 1 2 3 4 5 volume .04
read
// Typical evolution
gogo := { r; g 5; U; g 10; r; g 10; r; g 20; r; g 20; }
evolver-2.30c.dfsg/fe/quadmeet.cmd 0000755 0001753 0001753 00000014754 11410765113 017330 0 ustar hazelsct hazelsct // quadmeet.cmd
// For detecting intersection of quadratic facets in 3D
// Not suitable for torus model.
// Needs quadbbox.cmd to be loaded first.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: quadmeet
// Results: Prints id numbers of intersecting facets.
tiny := 1e-20 // criterion for dist^2 = 0
quadmeet := {
local xa1,xa2,xa3,xa4,xa5,xa6;
local ya1,ya2,ya3,ya4,ya5,ya6;
local za1,za2,za3,za4,za5,za6;
local xb1,xb2,xb3,xb4,xb5,xb6;
local yb1,yb2,yb3,yb4,yb5,yb6;
local zb1,zb2,zb3,zb4,zb5,zb6;
local eps,ua,va,ub,vb,xa,ya,za,xb,yb,zb,dx,dy,dz,dd;
local xau,xav,yau,yav,zau,zav;
local xbu,xbv,ybu,ybv,zbu,zbv;
local uagrad,vagrad,ubgrad,vbgrad,tt;
fboxes; // find facet bounding boxes
// test all facet pairs
foreach facet fa do
{ foreach facet fb where fb.id > fa.id do
{ // first, check bounding boxes
if ( fb.fbox[1] >= fa.fbox[2] or
fb.fbox[2] <= fa.fbox[1] or
fb.fbox[3] >= fa.fbox[4] or
fb.fbox[4] <= fa.fbox[3] or
fb.fbox[5] >= fa.fbox[6] or
fb.fbox[6] <= fa.fbox[5] ) then continue;
// extract coordinates
xa1 := fa.edge[1].vertex[1].x;
xa2 := fa.edge[1].vertex[3].x;
xa3 := fa.edge[1].vertex[2].x;
xa4 := fa.edge[3].vertex[3].x;
xa5 := fa.edge[2].vertex[3].x;
xa6 := fa.edge[2].vertex[2].x;
ya1 := fa.edge[1].vertex[1].y;
ya2 := fa.edge[1].vertex[3].y;
ya3 := fa.edge[1].vertex[2].y;
ya4 := fa.edge[3].vertex[3].y;
ya5 := fa.edge[2].vertex[3].y;
ya6 := fa.edge[2].vertex[2].y;
za1 := fa.edge[1].vertex[1].z;
za2 := fa.edge[1].vertex[3].z;
za3 := fa.edge[1].vertex[2].z;
za4 := fa.edge[3].vertex[3].z;
za5 := fa.edge[2].vertex[3].z;
za6 := fa.edge[2].vertex[2].z;
xb1 := fb.edge[1].vertex[1].x;
xb2 := fb.edge[1].vertex[3].x;
xb3 := fb.edge[1].vertex[2].x;
xb4 := fb.edge[3].vertex[3].x;
xb5 := fb.edge[2].vertex[3].x;
xb6 := fb.edge[2].vertex[2].x;
yb1 := fb.edge[1].vertex[1].y;
yb2 := fb.edge[1].vertex[3].y;
yb3 := fb.edge[1].vertex[2].y;
yb4 := fb.edge[3].vertex[3].y;
yb5 := fb.edge[2].vertex[3].y;
yb6 := fb.edge[2].vertex[2].y;
zb1 := fb.edge[1].vertex[1].z;
zb2 := fb.edge[1].vertex[3].z;
zb3 := fb.edge[1].vertex[2].z;
zb4 := fb.edge[3].vertex[3].z;
zb5 := fb.edge[2].vertex[3].z;
zb6 := fb.edge[2].vertex[2].z;
// Find minimum distance by Newton's Method
eps := .2; // edge guard
ua := .7; va := .6; ub := .71; vb := .67;
while ( eps > 1e-6 ) do
{
xa := 0.5*(ua+va-1)*(ua+va-2)*xa1 + ua*(2-ua-va)*xa2
+ 0.5*ua*(ua-1)*xa3 + va*(2-ua-va)*xa4
+ ua*va*xa5 + 0.5*va*(va-1)*xa6;
ya := 0.5*(ua+va-1)*(ua+va-2)*ya1 + ua*(2-ua-va)*ya2
+ 0.5*ua*(ua-1)*ya3 + va*(2-ua-va)*ya4
+ ua*va*ya5 + 0.5*va*(va-1)*ya6;
za := 0.5*(ua+va-1)*(ua+va-2)*za1 + ua*(2-ua-va)*za2
+ 0.5*ua*(ua-1)*za3 + va*(2-ua-va)*za4
+ ua*va*za5 + 0.5*va*(va-1)*za6;
xb := 0.5*(ub+vb-1)*(ub+vb-2)*xb1 + ub*(2-ub-vb)*xb2
+ 0.5*ub*(ub-1)*xb3 + vb*(2-ub-vb)*xb4
+ ub*vb*xb5 + 0.5*vb*(vb-1)*xb6;
yb := 0.5*(ub+vb-1)*(ub+vb-2)*yb1 + ub*(2-ub-vb)*yb2
+ 0.5*ub*(ub-1)*yb3 + vb*(2-ub-vb)*yb4
+ ub*vb*yb5 + 0.5*vb*(vb-1)*yb6;
zb := 0.5*(ub+vb-1)*(ub+vb-2)*zb1 + ub*(2-ub-vb)*zb2
+ 0.5*ub*(ub-1)*zb3 + vb*(2-ub-vb)*zb4
+ ub*vb*zb5 + 0.5*vb*(vb-1)*zb6;
dx := xa-xb; dy := ya-yb; dz := za - zb;
dd := dx*dx + dy*dy + dz*dz;
if ( dd < tiny ) then break;
xau := (ua + va - 1.5)*xa1 + (2-2*ua-va)*xa2 + (ua-0.5)*xa3
- va*xa4 + va*xa5;
xav := (ua + va - 1.5)*xa1 - ua*xa2 +(2-ua-2*va)*xa4 + ua*xa5
+ (va - 0.5)*xa6;
yau := (ua + va - 1.5)*ya1 + (2-2*ua-va)*ya2 + (ua-0.5)*ya3
- va*ya4 + va*ya5;
yav := (ua + va - 1.5)*ya1 - ua*ya2 +(2-ua-2*va)*ya4 + ua*ya5
+ (va - 0.5)*ya6;
zau := (ua + va - 1.5)*za1 + (2-2*ua-va)*za2 + (ua-0.5)*za3
- va*za4 + va*za5;
zav := (ua + va - 1.5)*za1 - ua*za2 +(2-ua-2*va)*za4 + ua*za5
+ (va - 0.5)*za6;
xbu := (ub + vb - 1.5)*xb1 + (2-2*ub-vb)*xb2 + (ub-0.5)*xb3
- vb*xb4 + vb*xb5;
xbv := (ub + vb - 1.5)*xb1 - ub*xb2 +(2-ub-2*vb)*xb4 + ub*xb5
+ (vb - 0.5)*xb6;
ybu := (ub + vb - 1.5)*yb1 + (2-2*ub-vb)*yb2 + (ub-0.5)*yb3
- vb*yb4 + vb*yb5;
ybv := (ub + vb - 1.5)*yb1 - ub*yb2 +(2-ub-2*vb)*yb4 + ub*yb5
+ (vb - 0.5)*yb6;
zbu := (ub + vb - 1.5)*zb1 + (2-2*ub-vb)*zb2 + (ub-0.5)*zb3
- vb*zb4 + vb*zb5;
zbv := (ub + vb - 1.5)*zb1 - ub*zb2 +(2-ub-2*vb)*zb4 + ub*zb5
+ (vb - 0.5)*zb6;
uagrad := 2*dx*xau + 2*dy*yau + 2*dz*zau;
vagrad := 2*dx*xav + 2*dy*yav + 2*dz*zav;
ubgrad := -(2*dx*xbu + 2*dy*ybu + 2*dz*zbu);
vbgrad := -(2*dx*xbv + 2*dy*ybv + 2*dz*zbv);
// find multiple of gradient; factor of 2 due to dist^2
tt := 2*dd/(uagrad*uagrad+vagrad*vagrad+ubgrad*ubgrad+vbgrad*vbgrad);
// clamp to triangle boundaries if necessary
// actually, clamp short of bdry so don't have to worry
// about being on boundary.
if ( ua - tt*uagrad < eps ) then tt := (-eps+ua)/uagrad;
if ( va - tt*vagrad < eps ) then tt := (-eps+va)/vagrad;
if ( ua - tt*uagrad + va - tt*vagrad > 2 - eps )
then tt := (-2 + eps + ua + va)/(uagrad + vagrad);
if ( ub - tt*ubgrad < eps ) then tt := (-eps+ub)/ubgrad;
if ( vb - tt*vbgrad < eps ) then tt := (-eps+vb)/vbgrad;
if ( ub - tt*ubgrad + vb - tt*vbgrad > 2 - eps )
then tt := -(2 - eps - ub - vb)/(ubgrad + vbgrad);
ua := ua - tt*uagrad;
va := va - tt*vagrad;
ub := ub - tt*ubgrad;
vb := vb - tt*vbgrad;
eps := eps/5;
};
if ( dd < tiny )
then printf "Facets %d and %d intersect at (%g,%g,%g).\n",xa,ya,za;
}
}
}
evolver-2.30c.dfsg/fe/dxf.cmd 0000755 0001753 0001753 00000002623 11410765113 016274 0 ustar hazelsct hazelsct // dfx.cmd
// Evolver command to produce AutoCad DXF files
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// References:
// http://en.wikipedia.org/wiki/AutoCAD_DXF
// http://images.autodesk.com/adsk/files/acad_dxf.pdf
// Usage:
// dxf >>> "filename.dxf"
define dxf_colors integer[16];
dxf_colors[1] := 5 // blue
dxf_colors[2] := 3 // green
dxf_colors[3] := 4 // cyan
dxf_colors[4] := 10 // red
dxf_colors[5] := 6 // magenta
dxf_colors[6] := 1 // brown
dxf_colors[7] := 9 // lightgray
dxf_colors[8] := 8 // darkgray
dxf_colors[9] := 8 // lightblue
dxf_colors[10] := 3 // lightgreen
dxf_colors[11] := 4 // lightcyan
dxf_colors[12] := 14 // lightred
dxf_colors[13] := 6 // lightmagenta
dxf_colors[14] := 2 // yellow
dxf_colors[15] := 7 // white
dxf := {
printf " 0\nSECTION\n 2\nENTITIES\n";
foreach facet ff do
{ printf " 0\n3DFACE\n 8\n0main\n";
printf " 10\n%8.6f\n 20\n%8.6f\n 30\n%8.6f\n",ff.vertex[1].x,
ff.vertex[1].y,ff.vertex[1].z;
printf " 11\n%8.6f\n 21\n%8.6f\n 31\n%8.6f\n",ff.vertex[2].x,
ff.vertex[2].y,ff.vertex[2].z;
printf " 12\n%8.6f\n 22\n%8.6f\n 32\n%8.6f\n",ff.vertex[3].x,
ff.vertex[3].y,ff.vertex[3].z;
printf " 13\n%8.6f\n 23\n%8.6f\n 33\n%8.6f\n",ff.vertex[3].x,
ff.vertex[3].y,ff.vertex[3].z;
// try color
printf " 62\n%3d\n",dxf_colors[ff.color];
};
printf " 0\nENDSEC\n 0\nEOF\n";
}
evolver-2.30c.dfsg/fe/quadm.fe 0000644 0001753 0001753 00000001256 11410765113 016447 0 ustar hazelsct hazelsct // quadm.fe
// quadrilateral boundary wire
// test of metric
INTEGRAL_ORDER 7
METRIC
/*
1+4*x1^2 4*x1*x2 2*x1
4*x1*x2 1+4*x2^2 2*x2
2*x1 2*x2 1
*/
1 0 0
0 1 0
0 0 1
constraint 1
formula: x1 = 0
constraint 2
formula: x1 = 1
constraint 3
formula: x2 = 0
constraint 4
formula: x2 = 1
constraint 5
formula: x1^2 + x2^2 + x3 = 0
vertices
1 0 0 0 fixed
2 1 0 -1 fixed
3 1 1 -2 fixed
4 0 1 -1 fixed
edges
1 1 2 fixed constraints 3,5
2 2 3 fixed constraints 2,5
3 3 4 fixed constraints 4,5
4 4 1 fixed constraints 1,5
5 2 4
faces
1 1 5 4
2 2 3 -5
read
// Typical evolution
gogo := { r; g 12; U; r; g 12; r; g 12; r; g 20; }
evolver-2.30c.dfsg/fe/crystal.fe 0000644 0001753 0001753 00000001702 11410765113 017015 0 ustar hazelsct hazelsct // crystal.fe
// Evolver data for cube of prescribed volume with
// crystalline surface energy. Evolves into an octahedron.
Wulff "octa.wlf" // Wulff vectors for octahedral crystal
vertices
1 0.0 0.0 0.0
2 1.0 0.0 0.0
3 1.0 1.0 0.0
4 0.0 1.0 0.0
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
9 0.0 0.0 0.5
10 1.0 0.0 0.5
11 1.0 1.0 0.5
12 0.0 1.0 0.5
edges /* given by endpoints and attribute */
1 1 2
2 2 3
3 3 4
4 4 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 9
10 2 10
11 3 11
12 4 12
13 9 5
14 10 6
15 11 7
16 12 8
17 9 10
18 10 11
19 11 12
20 12 9
faces /* given by oriented edge loop */
1 1 10 -17 -9
2 2 11 -18 -10
3 3 12 -19 -11
4 4 9 -20 -12
5 5 6 7 8
6 -4 -3 -2 -1
7 17 14 -5 -13
8 18 15 -6 -14
9 19 16 -7 -15
10 20 13 -8 -16
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 6 7 8 9 10 volume 1
read
// Sample evolution
gogo := { g 10; }
evolver-2.30c.dfsg/fe/rib.cmd 0000755 0001753 0001753 00000006447 11410765113 016277 0 ustar hazelsct hazelsct // rib.cmd
// Surface Evolver command to write RenderMan RIB file for surface
// Usage: rib >>> "filename.rib"
// This version does facets only, on a light blue background.
// Viewpoint is the same as 's' command. Orthogonal projection.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
rib := {
printf"##RenderMan RIB-Structure 1.0\n";
printf "version 3.03\n";
printf "\n";
printf "Option \"searchpath\" \"shader\" [\".:../shaders:&\"]\n";
printf "Display \"%s.tif\" \"file\" \"rgba\"\n",datafilename;
printf "Format 512 512 -1\n";
printf "PixelSamples 1 1\n";
printf "Orientation \"rh\"\n";
printf "Clipping 0.1 10.0\n";
printf "\n";
printf "WorldBegin\n";
printf "\n";
printf "Surface \"constant\"\n"; /* blue background */
printf "Color [ 0.3 0.8 1.0 ]\n";
printf "Polygon \"P\" [ 1 1 9 -1 1 9 -1 -1 9 1 -1 9]\n";
printf "\n";
printf "Translate 0 0 5 \n";
printf "Rotate 240 1 1 1 \n";
printf "Scale -1 1 1 \n";
printf "Scale .66667 .66667 .66667 \n";
printf "ConcatTransform [ %f %f %f %f\n",
view_matrix[1][1],view_matrix[2][1],view_matrix[3][1],view_matrix[4][1];
printf " %f %f %f %f\n",
view_matrix[1][2],view_matrix[2][2],view_matrix[3][2],view_matrix[4][2];
printf " %f %f %f %f\n",
view_matrix[1][3],view_matrix[2][3],view_matrix[3][3],view_matrix[4][3];
printf " %f %f %f %f ]\n",
view_matrix[1][4],view_matrix[2][4],view_matrix[3][4],view_matrix[4][4];
printf "LightSource \"ambientlight\" 1 \"intensity\" 0.30\n";
printf "LightSource \"distantlight\" 1 \"from\" [1 0 1] \"to\" [0 0 0] \"intensity\" 0.7\n";
printf "\n";
printf "AttributeBegin\n";
printf " Surface \"constant\"\n";
foreach facet ff do {
if ( ff.color == CLEAR ) then continue;
if ( ff.color == WHITE ) then printf " Color [ 1.0 1.0 1.0 ]\n"
else if ( ff.color == WHITE ) then printf " Color [ 1.0 1.0 1.0 ]\n"
else if ( ff.color == BLACK ) then printf " Color [ 0.0 0.0 0.0 ]\n"
else if ( ff.color == BLUE ) then printf " Color [ 0.0 0.0 1. ]\n"
else if ( ff.color == GREEN ) then printf " Color [ 0.0 1. 0.0 ]\n"
else if ( ff.color == CYAN ) then printf " Color [ 0.0 1. 1. ]\n"
else if ( ff.color == RED ) then printf " Color [ 1. 0.0 0.0 ]\n"
else if ( ff.color == MAGENTA ) then printf " Color [ 1. 0.0 1. ]\n"
else if ( ff.color == BROWN ) then printf " Color [ 1. 0.5 0. ]\n"
else if ( ff.color == LIGHTGRAY ) then printf " Color [ .6 .6 .6 ]\n"
else if ( ff.color == DARKGRAY ) then printf " Color [ .3 .3 .3 ]\n"
else if ( ff.color == LIGHTBLUE ) then printf " Color [ .5 .5 1. ]\n"
else if ( ff.color == LIGHTGREEN ) then printf " Color [ .5 1. .5 ]\n"
else if ( ff.color == LIGHTCYAN ) then printf " Color [ .5 1. 1. ]\n"
else if ( ff.color == LIGHTRED ) then printf " Color [ 1. .5 .5 ]\n"
else if ( ff.color == LIGHTMAGENTA ) then printf " Color [ 1. .5 1. ]\n"
else if ( ff.color == YELLOW ) then printf " Color [ 1. 1. .0 ]\n";
printf " Polygon \"P\" [ %f %f %f %f %f %f %f %f %f ]\n",
ff.vertex[1].x,ff.vertex[1].y,ff.vertex[1].z,
ff.vertex[2].x,ff.vertex[2].y,ff.vertex[2].z,
ff.vertex[3].x,ff.vertex[3].y,ff.vertex[3].z;
};
printf "AttributeEnd\n";
printf "\n";
printf "WorldEnd\n";
}
evolver-2.30c.dfsg/fe/intersec.cmd 0000755 0001753 0001753 00000004130 11410765113 017322 0 ustar hazelsct hazelsct // intersec.cmd
// Evolver command to detect intersection of linear edges and facets.
// For each facet, finds if any edge intersects in interior.
// Usage: read "intersec.cmd"
// detect
// Output: prints ids of facets and edges that intersect.
// Notes: In quadratic model, treats edges and facets as simply linear.
// Will not work in Lagrange model.
eps := 1e-10 // tolerance for being equal to zero
detect := {
local ax,ay,az,bx,by,bz,cx,cy,cz,acx,bcx,px,py,pz,qx,qy,qz,qpx,qcx;
local denom,lambda,mu,sigma;
local acy,acz,bcy,bcz,qpy,qpz,qcy,qcz;
if lagrange then
{ printf "intersect.cmd will not work in Lagrange model.\n";return;};
foreach facet ff do
{ ax := ff.vertex[1].x;
ay := ff.vertex[1].y;
az := ff.vertex[1].z;
bx := ff.vertex[2].x;
by := ff.vertex[2].y;
bz := ff.vertex[2].z;
cx := ff.vertex[3].x;
cy := ff.vertex[3].y;
cz := ff.vertex[3].z;
acx := ax-cx; acy := ay-cy; acz := az- cz;
bcx := bx-cx; bcy := by-cy; bcz := bz- cz;
foreach edge ee do
{ px := ee.vertex[1].x;
py := ee.vertex[1].y;
pz := ee.vertex[1].z;
qx := ee.vertex[2].x;
qy := ee.vertex[2].y;
qz := ee.vertex[2].z;
qpx := qx-px; qpy := qy-py; qpz := qz-pz;
qcx := qx-cx; qcy := qy-cy; qcz := qz-cz;
denom := qpx*(acy*bcz-acz*bcy) - qpy*(acx*bcz-acz*bcx)
+ qpz*(acx*bcy-acy*bcx);
if ( abs(denom) < eps ) then continue;
lambda := (qpx*(qcy*bcz-qcz*bcy) - qpy*(qcx*bcz-qcz*bcx)
+ qpz*(qcx*bcy-qcy*bcx))/denom;
if ( lambda <= eps ) then continue;
mu := (qpx*(acy*qcz-acz*qcy) - qpy*(acx*qcz-acz*qcx)
+ qpz*(acx*qcy-acy*qcx))/denom;
if ( mu <= eps ) then continue;
if ( lambda + mu > 1-eps ) then continue;
sigma := (qcx*(acy*bcz-acz*bcy) - qcy*(acx*bcz-acz*bcx)
+ qcz*(acx*bcy-acy*bcx))/denom;
if ( (sigma <= eps) or (sigma > 1-eps) ) then continue;
// now have intersection
printf "Facet %g and edge %g intersect.\n",ff.id,ee.id;
}
}
}
evolver-2.30c.dfsg/fe/povray.cmd 0000755 0001753 0001753 00000010663 11410765113 017036 0 ustar hazelsct hazelsct // povray.cmd
// Surface Evolver command for producing POV-Ray input file.
// Usage:
// Use the "show edge where ..." command to declare which
// edges are to be depicted as thin cylinders.
// Set "edge_radius" to desired radius of edge cylinders.
// Run "povray" and redirect to desired file, e.g.
// Enter command: povray >>> "something.pov"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
edge_radius := 0.003; // adjust this for desired radius of edge cylinders
povray := {
printf "// %s in POV-Ray format.\n\n",datafilename;
printf "light_source { <0,0,300> color rgb <1,1,1> }\n";
printf "light_source { <100,0,0> color rgb <1,1,1> }\n";
printf "camera { location <12,0,0> sky <0,0,1> // right handed \n";
printf " up <0,0,1> right <1.3,0,0> look_at <0,0,0> angle 15 }\n";
printf "background { color <0.3,0.8,1.0> } // light blue\n\n";
printf "// Textures corresponding to Evolver colors\n\n";
printf "#declare t_black = texture { pigment { rgb <0.0,0.0,0.0> }}\n";
printf "#declare t_blue = texture { pigment { rgb <0.0,0.0,1.,> }}\n";
printf "#declare t_green = texture { pigment { rgb <0.0,1.,0.0,> }}\n";
printf "#declare t_cyan = texture { pigment { rgb <0.0,1.,1.,> }}\n";
printf "#declare t_red = texture { pigment { rgb <1.,0.0,0.0,> }}\n";
printf "#declare t_magenta = texture { pigment { rgb <1.,0.0,1.,> }}\n";
printf "#declare t_brown = texture { pigment { rgb <1.,0.5,0.,> }}\n";
printf "#declare t_lightgray = texture { pigment { rgb <.6,.6,.6,> }}\n";
printf "#declare t_darkgray = texture { pigment { rgb <.3,.3,.3,> }}\n";
printf "#declare t_lightblue = texture { pigment { rgb <.3,.8,1.,> }}\n";
printf "#declare t_lightgreen = texture { pigment { rgb <.5,1.,.5,> }}\n";
printf "#declare t_lightcyan = texture { pigment { rgb <.5,1.,1.,> }}\n";
printf "#declare t_lightred = texture { pigment { rgb <1.,.5,.5,> }}\n";
printf "#declare t_lightmagenta = texture { pigment { rgb <1.,.5,1.,> }}\n";
printf "#declare t_yellow = texture { pigment { rgb <1.,1.,.0,> }}\n";
printf "#declare t_white = texture { pigment { rgb <1.,1.,1.,> }}\n";
printf "\n//One overall object.\n";
printf "union {\n";
printf "// All facets in one big mesh object for efficiency.\n";
printf " mesh { \n";
foreach facet ff do {
printf " triangle { <%f,%f,%f>,<%f,%f,%f>,<%f,%f,%f> texture {",
ff.vertex[1].x,ff.vertex[1].y,ff.vertex[1].z,
ff.vertex[2].x,ff.vertex[2].y,ff.vertex[2].z,
ff.vertex[3].x,ff.vertex[3].y,ff.vertex[3].z;
if ( ff.color == white ) then printf " t_white "
else if ( ff.color == black ) then printf " t_black "
else if ( ff.color == blue) then printf " t_blue "
else if ( ff.color == green ) then printf " t_green "
else if ( ff.color == cyan ) then printf " t_cyan "
else if ( ff.color == red ) then printf " t_red "
else if ( ff.color == magenta ) then printf " t_magenta "
else if ( ff.color == brown ) then printf " t_brown "
else if ( ff.color == lightgray ) then printf " t_lightgray "
else if ( ff.color == darkgray ) then printf " t_darkgray "
else if ( ff.color == lightblue ) then printf " t_lightblue "
else if ( ff.color == lightgreen ) then printf " t_lightgreen "
else if ( ff.color == lightcyan ) then printf " t_lightcyan "
else if ( ff.color == lightred ) then printf " t_lightred "
else if ( ff.color == lightmagenta ) then printf " t_lightmagenta "
else if ( ff.color == yellow ) then printf " t_yellow ";
printf " } }\n";
};
printf " } // end of mesh object\n";
// Do desired edges
printf "#declare edge_radius = %f;\n",edge_radius;
foreach edge ee where ee.show do
{ printf "cylinder { <%f,%f,%f>,<%f,%f,%f> edge_radius texture { t_black } }\n",
ee.vertex[1].x,ee.vertex[1].y,ee.vertex[1].z,
ee.vertex[2].x,ee.vertex[2].y,ee.vertex[2].z;
};
// Windup
printf "// overall viewing transformation\n";
printf " matrix < %f,%f,%f,\n",
view_matrix[1][1],view_matrix[2][1],view_matrix[3][1];
printf " %f,%f,%f,\n",
view_matrix[1][2],view_matrix[2][2],view_matrix[3][2];
printf " %f,%f,%f,\n",
view_matrix[1][3],view_matrix[2][3],view_matrix[3][3];
printf " %f,%f,%f>\n",
view_matrix[1][4],view_matrix[2][4],view_matrix[3][4];
printf " } // end of all objects\n";
}
evolver-2.30c.dfsg/fe/xray.cmd 0000755 0001753 0001753 00000011144 11410765113 016474 0 ustar hazelsct hazelsct // xray.cmd
// Produces xray image of a 3D wet foam. Calculates liquid content on
// grid of probe lines. Plateau borders are detected as bounded by
// facets with less than 2/3 of the maximum facet tension.
// Outputs a PostScript file to stdout with a grid of grayscale pixels.
// Usage: set xgridsize and ygridsize to the desired resolution,
// i.e. pixels across and down and give the command
// xray >>> "filename.ps"
// The xray command will calculate the bounding box of the surface itself.
// Works in torus or non-torus mode. In torus mode, everything will
// automatically be wrapped back to the unit cell, so you don't have
// to worry about that.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
xgridsize := 100 // xgridsize x ygridsize grid
ygridsize := 100
xray := {
local xx,yy,jitterx,jittery,minx,miny,maxx,maxy,tension_cutoff;
local dx,dy,ax,ay,az,bx,by,bz,cx,cy,cz,hix,hiy,lox,loy,maxi,maxj;
local mini,minj,fsign,xyarea,ii,jj,area1,area2,area3,maxr,xpts,ypts;
define results real[xgridsize][ygridsize];
for ( xx := 1 ; xx <= xgridsize ; xx += 1 )
for ( yy := 1 ; yy <= ygridsize ; yy += 1 )
results[xx][yy] := 0.0; // clean out old results
// random offsets to prevent edge effects */
jitterx := 0.5213414312341;
jittery := 0.4934129768877;
/* box to map results to */
if torus then
{ // assumes orthogonal fundamental region
minx := 0;
miny := 0;
maxx := torus_periods[1][1];
maxy := torus_periods[2][2];
tension_cutoff := max(facet,tension)*2/3; // do only Plateau borders
}
else
{ minx := min(vertex,x);
maxx := max(vertex,x);
miny := min(vertex,y);
maxy := max(vertex,y);
tension_cutoff := 100000; // do all facets
};
dx := (maxx-minx)/xgridsize;
dy := (maxy-miny)/ygridsize;
foreach facet ff where tension < tension_cutoff do
{ ax := ff.vertex[1].x;
ay := ff.vertex[1].y;
az := ff.vertex[1].z;
bx := ax + ff.edge[1].x; // let Evolver take care of unwrapping
by := ay + ff.edge[1].y;
bz := az + ff.edge[1].z;
cx := bx + ff.edge[2].x; // let Evolver take care of unwrapping
cy := by + ff.edge[2].y;
cz := bz + ff.edge[2].z;
// get bounding box to find possible grid points
hix := (ax > bx) ? (ax > cx ? ax : cx) : (bx > cx ? bx : cx);
hiy := (ay > by) ? (ay > cy ? ay : cy) : (by > cy ? by : cy);
lox := (ax < bx) ? (ax < cx ? ax : cx) : (bx < cx ? bx : cx);
loy := (ay < by) ? (ay < cy ? ay : cy) : (by < cy ? by : cy);
// compact to integers
maxi := floor(hix/dx-jitterx);
maxj := floor(hiy/dy-jittery);
mini := ceil(lox/dx-jitterx);
minj := ceil(loy/dy-jittery);
// loop among possible values
fsign := ff.z > 0 ? 1 : -1;
xyarea := 2*abs(ff.z);
for ( ii := mini ; ii <= maxi ; ii += 1 )
for ( jj := minj ; jj <= maxj ; jj += 1 )
{ // test inclusion
xx := ii*dx + dx*jitterx; yy := jj*dy + dy*jittery;
area1 := fsign*((ax-xx)*(by-yy) - (bx-xx)*(ay-yy));
area2 := fsign*((bx-xx)*(cy-yy) - (cx-xx)*(by-yy));
area3 := fsign*((cx-xx)*(ay-yy) - (ax-xx)*(cy-yy));
if ( (area1 > 0) and (area2 > 0) and (area3 > 0) ) then
{ results[(ii imod xgridsize)+1][(jj imod ygridsize)+1] +=
fsign*(area1*cz + area2*az + area3*bz)/xyarea;
}
}
};
if ( torus ) then
{ // correct results for wrap in z
for ( ii := 1 ; ii <= xgridsize ; ii += 1 )
for ( jj := 1 ; jj <= ygridsize ; jj += 1 )
results[ii][jj] := results[ii][jj] mod torus_periods[3][3];
};
// map to range 0,1
maxr := 0;
for ( ii := 1 ; ii <= xgridsize ; ii += 1 )
for ( jj := 1 ; jj <= ygridsize ; jj += 1 )
if results[ii][jj] > maxr then maxr := results[ii][jj];
if maxr > 0 then
for ( ii := 1 ; ii <= xgridsize ; ii += 1 )
for ( jj := 1 ; jj <= ygridsize ; jj += 1 )
results[ii][jj] /= maxr;
/* output results in postscript format, making low density white */
xpts := 500; ypts := 500; // point size of image
// using kludges to get %% stuff to print right on Windows and Unix
printf "%!"; printf"PS-Adobe-3.0 EPSF-3.0\n";
printf "%%"; printf"BoundingBox: 0 0 %d %d\n",xpts,ypts;
printf "%%"; printf"Creator: Surface Evolver xray.cmd\n";
printf "%%"; printf"EndComments\n\n";
printf "%f %f scale\n",xpts/xgridsize,ypts/ygridsize;
printf "/px { newpath setgray moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto closepath fill} def\n";
for ( ii := 0 ; ii < xgridsize ; ii += 1 )
for ( jj := 0 ; jj < ygridsize ; jj += 1 )
{ printf "%f %f %f px\n",ii,jj,(1-results[ii+1][jj+1]);
};
printf "\nshowpage\n";
printf "\n%%"; printf"EOF\n";
}
evolver-2.30c.dfsg/fe/wetfoam2.cmd 0000755 0001753 0001753 00000062746 11410765113 017253 0 ustar hazelsct hazelsct // wetfoam2.cmd
// Evolver command to convert dry foam to wet foam.
// Dry foam assumptions:
// In torus domain (so no awkward boundary conditions)
// Only one high valence edge per facet (will refine if finds more )
// Facet tension assumed to be uniformly 1.
// Usage: Set "spread" to relative size of border (default 0.2), then
// run wetfoam with output redirected to desired file, e.g.
// Enter command: wetfoam >>> "wetfile.fe"
// The resulting file has Plateau border body, whose number is recorded
// in the variable border_body.
// This file replaces wetfoam.cmd, which is now obsolete.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
/* Parameter for initial size of Plateau borders */
/* Note this is relative to the size of facets, not absolute. */
spread := .2
// Other global variables used internally here
ccount := 0
voffset := 0
wrapnum := 0;
border_body := 0;
init_attributes := {
// some useful attributes, all as dimensioned so can be shrunk to zero size
// when done with them.
define vertex attribute hivalence integer[1]; // number of high-valence edges
define facet attribute corners integer[3]; // which "corner" each vertex
// belongs to
define facet attribute newedge integer[1]; // pulled-out edge
define facet attribute corneredge1 integer[3];// new edge forward from corner
define facet attribute corneredge2 integer[3];// new edge backward from corner
define facet attribute didflag1 integer[3];// whether put vertex face here
define facet attribute didflag2 integer[3];// whether put vertex face here
define facet attribute diagedge integer[1]; // diagonal across rectangle
}
shrink_attributes := {
// make storage small so to not pollute memory of original or new file.
define vertex attribute hivalence integer[0];
define facet attribute corners integer[0];
define facet attribute newedge integer[0];
define facet attribute corneredge1 integer[0];
define facet attribute corneredge2 integer[0];
define facet attribute didflag1 integer[0];
define facet attribute didflag2 integer[0];
define facet attribute diagedge integer[0];
// and a few arrays while we are at it
define cornerx real[0];
define cornery real[0];
define cornerz real[0];
define cornern integer[0];
define borderbody integer[0];
}
/* tests and preliminaries */
vertest := { foreach vertex vv do
vv.hivalence[1] := sum(vv.edge where valence >= 3,1);
}
facettest := { local triple;
foreach facet ff do
{ triple := sum(ff.edge where valence >= 3, 1);
if ( triple >= 2 ) then
{ refine ff;
}
}
}
wettests := { vertest; facettest; }
/* enumerate and consolidate facet corners */
/* corner number of 0 means not adjacent to hi-valence vertex */
do_corners := {
local inx;
/* enumerate */
ccount := 1;
foreach facet ff do
{
inx := 1;
foreach ff.vertex vv do
{ if vv.hivalence[1] > 0 then
{ ff.corners[inx] := ccount;
ccount += 1;
};
inx += 1;
};
};
/* consolidate */
local changes;
do
{ changes := 0;
foreach edge ee do
{ if ee.valence != 2 then continue;
local ffid; local fffid; local knx;
ffid := ee.facet[1].id;
fffid := ee.facet[2].id;
inx := 1;
foreach facet[ffid].vertex vv do
{ if vv.id != ee.vertex[1].id && vv.id != ee.vertex[2].id then
{ inx += 1; continue; };
knx := 1;
foreach facet[fffid].vertex vvv do
{ if vv.id == vvv.id then
{ if facet[ffid].corners[inx] == facet[fffid].corners[knx] then
break;
if facet[ffid].corners[inx] < facet[fffid].corners[knx] then
facet[fffid].corners[knx] := facet[ffid].corners[inx]
else facet[ffid].corners[inx] := facet[fffid].corners[knx];
changes += 1;
break;
};
knx += 1;
};
inx += 1;
}
}
} while changes;
/* array to hold info on corner vertices */
define cornerx real[ccount];
define cornery real[ccount];
define cornerz real[ccount];
define cornern integer[ccount]; // number of facets in corner
inx := 1; while inx <= ccount do
{ cornern[inx] := 0; cornerx[inx] := 0; cornery[inx] := 0;
cornerz[inx] := 0; inx += 1;
};
foreach facet ff do
{ inx := 1;
local ffid;
ffid := ff.id; /* want positive orientation */
while inx <= 3 do
{ if ff.corners[inx] != 0 then
{ cornern[ff.corners[inx]] += 1;
cornerx[ff.corners[inx]] +=
spread*facet[ffid].edge[inx].x + 2*facet[ffid].vertex[inx].x
- spread*facet[ffid].edge[inx==1 ? 3 : inx-1].x;
cornery[ff.corners[inx]] +=
spread*facet[ffid].edge[inx].y + 2*facet[ffid].vertex[inx].y
- spread*facet[ffid].edge[inx==1 ? 3 : inx-1].y;
cornerz[ff.corners[inx]] +=
spread*facet[ffid].edge[inx].z + 2*facet[ffid].vertex[inx].z
- spread*facet[ffid].edge[inx==1 ? 3 : inx-1].z;
};
inx += 1;
};
};
local kk;
kk := 1;
while kk <= ccount do
{ if cornern[kk] > 0 then
{ cornerx[kk] /= 2*cornern[kk];
cornery[kk] /= 2*cornern[kk];
cornerz[kk] /= 2*cornern[kk];
};
kk += 1;
};
} /* end do_corners */
/* print vertex list */
wetverts := {
voffset := max(vertex,id)+1; /* start of new vertices */
printf "\nvertices\n";
foreach vertex vv do
if ( vv.hivalence[1] < 1 ) then
printf "%d %g %g %g\n",vv.id, vv.x,vv.y,vv.z;
local kk;
kk := 1;
while kk <= ccount do
{ if cornern[kk] > 0 then
{ printf "%d %g %g %g\n",kk+voffset,
cornerx[kk],cornery[kk],cornerz[kk];
};
kk += 1;
}
} /* end wetverts */
/* convert numerical torus wrap to string and print; called by wetedges */
/* incoming argument: wrapnum */
wrapconvert := { local ww;
ww := floor(1e-6 + (wrapnum % 64));
if ( ww == 0 ) then printf " *"
else if ( ww == 1 ) then printf " +"
else printf " -";
ww := floor(1e-6 + (floor(1e-6+wrapnum/64) % 64) );
if ( ww == 0 ) then printf " *"
else if ( ww == 1 ) then printf " +"
else printf " -";
ww := floor(1e-6 + (floor(1e-6+wrapnum/4096) % 64) );
if ( ww == 0 ) then printf " *"
else if ( ww == 1 ) then printf " +"
else printf " -";
}
/* print edge list */
wetedges := { local ecounter;
local eeid; local first_corner; local corner;
local prevff; local previnx; local firstff;
local firstinx; local prevcorner;
local ffid; local inx;
local ffid2; local eeid2;
ecounter := max(edge,id)+1; /* start of new edges */
printf "\nedges\n";
/* first, old edges that we keep */
foreach edge ee where valence == 2 do
{ printf "%d ", ee.id;
wrapnum := ee.wrap;
foreach ee.vertex vv do
{ if ( vv.hivalence[1] > 0 ) then
{ /* find proper pull-out vertex */
local ffid;
ffid := ee.facet[1].id;
inx := 1;
while inx <= 3 do
{ if facet[ffid].vertex[inx].id == vv.id then
{ printf "%d ",facet[ffid].corners[inx]+voffset;
break;
};
inx += 1;
}
}
else printf "%d ",vv.id;
};
if ( torus ) then wrapconvert;
printf "\n";
};
foreach edge ee where valence >= 3 do
{ local tail1; local tail2; local tail3;
local head1; local head2; local head3;
local vv1; local inx;
local headv; local tailv; local ffid;
local vv2;
tail1 := 0; tail2 := 0; tail3 := 0;
head1 := 0; head2 := 0; head3 := 0;
wrapnum := ee.wrap;
/* assemble data about new vertices */
vv1 := ee.vertex[1].id; vv2 := ee.vertex[2].id;
foreach ee.facet ff do
{ /* new edge between facet corners */
ffid := ff.id; /* want positive orientation of facet */
inx := 1;
foreach facet[ffid].vertex vv do
{ if vv.id == vv1 then tailv := ff.corners[inx]+voffset;
if vv.id == vv2 then headv := ff.corners[inx]+voffset;
inx += 1;
};
ff.newedge[1] := ecounter;
ff.diagedge[1] := ecounter+3;
printf "%d %d %d ",ecounter,tailv,headv;
if torus then wrapconvert;
printf "/* from edge %d */ ",ee.id;
printf "\n";
tail1 := tail2; tail2 := tail3; tail3 := tailv;
head1 := head2; head2 := head3; head3 := headv;
ecounter += 1;
};
printf "%d %d %d ",ecounter,tail1,head2;
if torus then wrapconvert;
printf "\n";
ecounter += 1;
printf "%d %d %d ",ecounter,tail2,head3;
if torus then wrapconvert;
printf "\n";
ecounter += 1;
printf "%d %d %d ",ecounter,tail3,head1;
if torus then wrapconvert;
printf "\n";
ecounter += 1;
};
/* interior points of hi-valence edges */
foreach vertex vv where vv.hivalence[1] == 2 do
{ /* find the high-valence edges first */
local ffid;
eeid := 0;
foreach vv.edge ee do
{ if ee.valence > 2 then
{ eeid2 := eeid; eeid := ee.id; }
};
first_corner := 0; corner := 0; prevff:=0; previnx:=0;
firstff := 0; firstinx := 0;
foreach edge[eeid].facet ff do
{ /* find proper corner */
prevcorner := corner;
ffid := ff.id;
inx := 1;
while inx <= 3 do
{ if facet[ffid].vertex[inx].id == vv.id then
{ corner := facet[ffid].corners[inx];
break;
};
inx += 1;
};
if ( first_corner == 0 ) then
{ first_corner := corner; prevff := ffid;
firstff := ffid; firstinx := inx;
previnx := inx;
continue;
};
/* edge from previous corner */
if torus then
printf "%d %d %d * * *\n",ecounter,prevcorner+voffset,
corner+voffset
else
printf "%d %d %d\n",ecounter,prevcorner+voffset,
corner+voffset;
facet[prevff].corneredge1[previnx] := ecounter;
facet[ffid].corneredge2[inx] := ecounter;
ecounter += 1;
prevff := ffid; previnx := inx;
};
if torus then
printf "%d %d %d * * *\n",ecounter,corner+voffset,
first_corner+voffset
else
printf "%d %d %d \n",ecounter,corner+voffset,
first_corner+voffset;
facet[prevff].corneredge1[previnx] := ecounter;
facet[firstff].corneredge2[firstinx] := ecounter;
ecounter += 1;
/* set corneredges on facets around the other edge */
local signum; local finx; local finx2; local inx2;
if (edge[eeid].vertex[1].id == edge[eeid2].vertex[2].id) or
(edge[eeid].vertex[2].id == edge[eeid2].vertex[1].id) then
signum := 1 // both in same direction
else signum := -1;
finx2 := 1;
foreach edge[eeid2].facet fff do
{ ffid2 := fff.id;
inx2 := 1;
while inx2 <= 3 do
{ if facet[ffid2].vertex[inx2].id == vv.id then
{ finx := 1;
foreach edge[eeid].facet ff do
{ ffid := ff.id;
inx := 1;
while inx <= 3 do
{ if facet[ffid].corners[inx] !=
facet[ffid2].corners[inx2] then
{ inx += 1; continue; };
if signum == 1 then
{ facet[ffid2].corneredge1[inx2] :=
facet[ffid].corneredge1[inx];
facet[ffid2].corneredge2[inx2] :=
facet[ffid].corneredge2[inx];
}
else // opposite directions
{ facet[ffid2].corneredge1[inx2] :=
-facet[ffid].corneredge2[inx];
facet[ffid2].corneredge2[inx2] :=
-facet[ffid].corneredge1[inx];
};
break 3;
};
inx += 1;
};
finx += 1;
};
inx2 += 1;
};
finx2 += 1;
};
}; /* end hivalence edge interior vertices */
/* ends of hi-valence edges */
foreach edge ee where valence >= 3 do
{ foreach ee.vertex vv where vv.hivalence[1] >= 3 do
{
first_corner := 0; corner := 0; prevff:=0; previnx:=0;
firstff := 0; firstinx := 0;
foreach ee.facet ff do
{ /* find proper corner */
prevcorner := corner;
ffid := ff.id;
inx := 1;
while inx <= 3 do
{ if facet[ffid].vertex[inx].id == vv.id then
{ corner := facet[ffid].corners[inx];
break;
};
inx += 1;
};
if ( first_corner == 0 ) then
{ first_corner := corner; prevff := ffid;
firstff := ffid; firstinx := inx;
previnx := inx;
continue;
};
/* edge from previous corner */
if torus then
printf "%d %d %d * * * oldedge %d\n",ecounter,
prevcorner+voffset, corner+voffset, ee.id
else
printf "%d %d %d oldedge %d\n",ecounter,
prevcorner+voffset, corner+voffset, ee.id;
facet[prevff].corneredge1[previnx] := ecounter;
facet[ffid].corneredge2[inx] := ecounter;
ecounter += 1;
prevff := ffid; previnx := inx;
};
if torus then
printf "%d %d %d * * * oldedge %d\n",ecounter,
corner+voffset, first_corner+voffset, ee.id
else
printf "%d %d %d oldedge %d\n",ecounter,
corner+voffset, first_corner+voffset, ee.id;
facet[prevff].corneredge1[previnx] := ecounter;
facet[firstff].corneredge2[firstinx] := ecounter;
ecounter += 1;
}
};
} /* end wetedges */
/* auxiliary routine to do one pulled-out face around a hi-valence vertex.
Input is ffid, signed id of starting facet,
vvid, id of vertex in question.
*/
ffid := 0; // just to declare
vvid := 0; // just to declare
fcounter := 0; // just to declare
define borderbody integer[1] // just to declare
do_one_vertex_face :=
{ local startffid; local did_fnum; local inx;
local eeid; local cinx; local cedge; local finx;
local evalence;
startffid := ffid;
did_fnum := 0;
do
{
/* find edge with head at vertex */
inx := 1;
foreach facet[ffid].edge ee do
{ if ee.vertex[2].id == vvid then
{ eeid := ee.oid; break; };
inx += 1;
};
if edge[eeid].valence >= 3 then
{
/* calculate proper corneredge */
if ffid > 0 then
cinx := inx == 3 ? 1 : inx+1
else if inx == 1 then cinx := 1
else cinx := 5-inx;
if eeid > 0 then
{ if facet[ffid].didflag1[cinx] then return ;
cedge := facet[ffid].corneredge1[cinx];
facet[ffid].didflag1[cinx] := 1;
}
else
{ if facet[ffid].didflag2[cinx] then return;
cedge := -facet[ffid].corneredge2[cinx];
facet[ffid].didflag2[cinx] := 1;
};
if did_fnum == 0 then
{ printf "%d ",fcounter;
borderbody[fcounter] := facet[ffid].backbody;
fcounter += 1;
};
did_fnum := 1;
printf "%d ",cedge;
};
/* find next facet around edge */
finx := 1; evalence := edge[eeid].valence;
foreach edge[eeid].facet fff do
{ if fff.oid == ffid then break;
finx += 1;
};
ffid := -edge[eeid].facet[finx==evalence ? 1 : finx+1].oid;
/* add edge between corners, if necessary */
} while ffid != startffid;
printf " tension 0.5 ftype vertexfacet // by old vertex %d\n",vvid;
} /* end do_one_vertex_face */
/* print face list, less triangles at nodes */
wetfaces := {
fstart := max(facet,id)+1;
fcounter := fstart;
define borderbody integer[fcounter + 40*sum(vertex,hivalence[1]>2)
+ 2*sum(edge where valence >= 3, valence)];
printf "\nfaces\n";
/* old facets, replacing triple edges with new */
foreach facet ff do
{ printf "%d ",ff.id;
foreach ff.edge ee do
{ if ( ee.valence == 2 ) then printf "%d ",ee.oid
else
printf "%d ",(ee.oid<0?-(ff.newedge[1]):ff.newedge[1])
};
printf " oldbodies %d %d ",ff.frontbody,ff.backbody;
printf " ftype oldfacet\n";
};
/* tube faces around triple lines */
foreach edge ee where valence >= 3 do
{ local evalence; local finx;
evalence := ee.valence;
finx := 1;
while finx <= evalence do
{ local ea; local diag; local inx; local eb; local ed;
local ec;
ea := ee.facet[finx].newedge[1];
ec := ee.facet[finx==evalence?1:finx+1].newedge[1];
diag := ee.facet[finx].diagedge[1];
inx := 1;
ffid := ee.facet[finx].id;
while inx <= 3 do
{ if facet[ffid].vertex[inx].id == ee.vertex[1].id then
eb := facet[ffid].corneredge1[inx];
if facet[ffid].vertex[inx].id == ee.vertex[2].id then
ed := facet[ffid].corneredge1[inx];
inx += 1;
};
printf "%d %d %d %d tension 0.5 ftype tubefacet\n",
fcounter,-ea,diag,-ed;
borderbody[fcounter] := ee.facet[finx].backbody;
fcounter += 1;
printf "%d %d %d %d tension 0.5 ftype tubefacet\n",
fcounter,eb,ec,-diag;
borderbody[fcounter] := ee.facet[finx].backbody;
fcounter += 1;
finx += 1;
}
};
/* vertex faces */
printf "//vertex faces:\n";
foreach facet ff do
{ ff.didflag1[1] := 0;
ff.didflag1[2] := 0;
ff.didflag1[3] := 0;
ff.didflag2[1] := 0;
ff.didflag2[2] := 0;
ff.didflag2[3] := 0;
};
foreach vertex vv where hivalence[1] >= 3 do
{ /* try starting at each facet */
vvid := vv.id; // for parameter passing
foreach vv.facet ff do
{
ffid := ff.oid;
do_one_vertex_face;
ffid := -ff.oid;
do_one_vertex_face;
} /* end foreach facet facet */
} /* end foreach vertex */
} /* end wetfaces */
/* print body list */
/* new facets will be added to bodies at load time */
wetbodies := { printf "\nbodies \n";
local ss,nn,mm,border_volume;
ss := spread*avg(edge where valence==2,length);
border_volume := sum(edge where valence==3,length)*
ss*ss*0.8;
foreach body bod do
{ printf "%d ",bod.id,bod.target;
nn := 0;
foreach bod.facet ff do
{ printf "%d ",ff.oid;
nn += 1;
if ( nn == 10 ) then
{ printf "\\\n "; nn := 0;}
};
for ( mm := 1 ; mm < fcounter ; mm += 1 )
{ if borderbody[mm] == bod.id then
{ printf "%d ",-mm;
nn += 1;
if ( nn == 10 ) then
{ printf "\\\n "; nn := 0;}
};
};
printf " volume %g \n",bod.target;
};
/* border body can be given its facets */
border_body := max(body,id)+1;
printf "%d ",border_body;
local fnum;
for ( fnum := fstart ; fnum < fcounter ; fnum := fnum )
{ for ( nn := 1 ; (nn <= 10) and (fnum < fcounter) ; nn += 1 )
{ printf "%d ",fnum; fnum += 1; };
printf "\\\n";
};
printf " volume %g",border_volume;
printf "\n";
} /* end wetbodies */
/* commands to finish creating facets and bodies at load time */
read_section := {
printf "\nread\n\n";
printf "recalc\n";
printf "set body target volume // so volumes don't exceed torus volume\n";
printf "border_body := %d\n",border_body;
}
wetfoam := {
// applicability tests
if space_dimension != 3 then
{ errprintf "wetfoam only works in space dimension 3.\n"; return; };
if surface_dimension != 2 then
{ errprintf "wetfoam only works for surface dimension 2.\n";
return;
};
// if !torus then
// { errprintf "wetfoam only works for torus domain.\n"; return; };
if lagrange_order != 1 then
{ errprintf "wetfoam only works for linear model.\n"; return; };
// minimize arrays to avoid datafile pollution
define cornerx real[1];
define cornery real[1];
define cornerz real[1];
define cornern integer[1]; // number of facets in corner
shrink_attributes;
list topinfo;
init_attributes;
wettests;
printf "\ndefine edge attribute oldedge integer\n\n";
printf "\ndefine facet attribute oldbodies integer[2]\n\n";
printf "\ndefine facet attribute ftype integer\n";
printf "parameter oldfacet = 1 // original facet\n";
printf "parameter tubefacet = 2 // new facet along tube\n";
printf "parameter vertexfacet = 3 // new facet around vertex\n\n";
do_corners;
wetverts;
wetedges;
wetfaces;
wetbodies;
read_section;
shrink_attributes;
}
// To user: run wetfoam with output redirected to desired file, i.e.
// Enter command: wetfoam >>> "wetfile.fe"
evolver-2.30c.dfsg/fe/cube.fe 0000644 0001753 0001753 00000002312 11410765113 016250 0 ustar hazelsct hazelsct // cube.fe
// Evolver data for cube of prescribed volume.
vertices
1 0.0 0.0 0.0
2 1.0 0.0 0.0
3 1.0 1.0 0.0
4 0.0 1.0 0.0
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
edges /* given by endpoints and attribute */
1 1 2
2 2 3
3 3 4
4 4 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 5
10 2 6
11 3 7
12 4 8
faces /* given by oriented edge loop */
1 1 10 -5 -9
2 2 11 -6 -10
3 3 12 -7 -11
4 4 9 -8 -12
5 5 6 7 8
6 -4 -3 -2 -1
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 6 volume 1
read
// Typical evolution to sphere
gogo := { g 5; r; g 5; hessian; r; g 5; hessian; }
// Evolution to very high accuracy, using higher-order Lagrange elements.
// To be run on original datafile.
gogo2 := { g 5; r; g 5; hessian; r; g 5; hessian;
lagrange 2; g 5; hessian;
lagrange 4; g 5; hessian;
lagrange 6; g 5; hessian;
ideal_rad := (3*body[1].volume/4/pi)^(1/3);
printf "Area error: %g\n",total_area - 4*pi*ideal_rad^2;
printf "Vertex radius spread: %g\n",
max(vertex,sqrt((x-.5)^2+(y-.5)^2+(z-.5)^2))
- min(vertex,sqrt((x-.5)^2+(y-.5)^2+(z-.5)^2));
}
evolver-2.30c.dfsg/fe/sphere.fe 0000644 0001753 0001753 00000005121 11410765113 016621 0 ustar hazelsct hazelsct // sphere.fe
// Spherical tank partially filled with liquid with contact angle.
SYMMETRIC_CONTENT // natural for a sphere
parameter rad = 1.00 // sphere radius
parameter angle = 45 // contact angle, in degrees
// cosine of contact angle
#define WALLT cos(angle*pi/180)
// density of body
#define RHO 1.0
// Various expressions used in constraints
#define wstuff (rad^2*z/(x^2 + y^2)/sqrt(x^2+y^2+z^2))
#define gstuff (G*RHO/8*rad^4*z^4/(x^2 + y^2)*(x^2+y^2+z^2)^2)
#define gapstuff (G*RHO*rad^4/8*z^2/(x^2+y^2+z^2)^2)
constraint 1 convex // the sphere, as wall for liquid
formula: sqrt(x^2 + y^2 + z^2) = rad
energy:
e1: WALLT*wstuff*y - gstuff*y + G*RHO/8*y*z^2 - gapstuff*y
e2: -WALLT*wstuff*x + gstuff*x - G*RHO/8*x*z^2 + gapstuff*x
e3: 0
content:
c1: -rad*wstuff*y/3
c2: rad*wstuff*x/3
c3: 0
constraint 2 // the sphere, for display only
formula: sqrt(x^2 + y^2 + z^2) = rad
vertices:
1 rad 0 0 constraint 1
2 0 rad 0 constraint 1
3 -rad 0 0 constraint 1
4 0 -rad 0 constraint 1
5 0 0 rad constraint 2 FIXED // to show back hemisphere
6 0 0 -rad constraint 2 FIXED
7 0 rad 0 constraint 2 FIXED
8 -rad 0 0 constraint 2 FIXED
9 0 -rad 0 constraint 2 FIXED
edges:
1 1 2 constraint 1
2 2 3 constraint 1
3 3 4 constraint 1
4 4 1 constraint 1
5 5 9 constraint 2 FIXED // to show back hemisphere
6 9 6 constraint 2 FIXED
7 6 7 constraint 2 FIXED
8 7 5 constraint 2 FIXED
9 5 8 constraint 2 FIXED
10 9 8 constraint 2 FIXED
11 6 8 constraint 2 FIXED
12 7 8 constraint 2 FIXED
faces:
1 1 2 3 4
2 5 10 -9 constraint 2 density 0 FIXED // to show back hemisphere
3 -10 6 11 constraint 2 density 0 FIXED
4 -11 7 12 constraint 2 density 0 FIXED
5 8 9 -12 constraint 2 density 0 FIXED
bodies: // start with sphere half full
1 1 volume 2*pi*rad^3/3 volconst 2*pi*rad^3/3 density RHO
read
// Typical short evolution
gogo := { g 5; r; g 5; r; g 5; r; g 10; conj_grad; g 20; }
// Command to print out coordinates of points along cross-section
// of the surface. This starts at vertex 3 and follows edges that
// point in the positive x direction.
section := {
thisv := 3;
nextv := thisv;
do
{ printf "%9.6f %9.6f %9.6f\n",vertex[thisv].x,vertex[thisv].y,
vertex[thisv].z;
foreach vertex[thisv].edge ee do
{ if ee.x > 10*abs(ee.y) then
{ nextv := ee.vertex[2].id;
break;
}
};
if nextv == thisv then break; // done
thisv := nextv;
} while 1;
}
evolver-2.30c.dfsg/fe/compdump.cmd 0000755 0001753 0001753 00000000605 11410765113 017335 0 ustar hazelsct hazelsct // compdump.cmd
// command for dumping datafile directly to compressed form
//
dumpcmd := sprintf "compress >%s.dmp.Z",datafilename
dodump := { list topinfo;
print "\nvertices\n"; list vertices;
print "\nedges\n"; list edges;
print "\nfaces\n"; list facets;
print "\nbodies\n"; list bodies;
list bottominfo }
compdump := { print dumpcmd; dodump | dumpcmd }
evolver-2.30c.dfsg/fe/bonnet_movie.cmd 0000755 0001753 0001753 00000011424 11410765113 020176 0 ustar hazelsct hazelsct // bonnet_movie.cmd
// Makes in-memory movie of Bonnet rotation of minimal surface,
// one frame per degree for 360 degrees.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: Evolve initial minimal surface, remove all level-set constraints
// and boundaries, get nice view in graphics window.
// Run "show_movie" to see screen display of Bonnet rotation.
// Run "postscript_movie" to create sequence of PostScript files.
read "adjoint.cmd"
midvertex := 5 // vertex to keep at origin
frame_delay := 0.03 // seconds between frames
// Store coordinates for complete Bonnet rotation
define vertex attribute bonnet real[360][3]
make_movie := {
local midx,midy,midz;
quiet on;
for ( bangle := 0 ; bangle < 359.5 ; bangle += 1 )
{ adjoint;
midx := vertex[midvertex].x;
midy := vertex[midvertex].y;
midz := vertex[midvertex].z;
foreach vertex vv do
{ vv.bonnet[bangle+1][1] := vv.x-midx;
vv.bonnet[bangle+1][2] := vv.y-midy;
vv.bonnet[bangle+1][3] := vv.z-midz;
};
flip;
};
quiet off;
}
procedure set_bonnet(integer angle)
{
foreach vertex vv do
{ vv.x := vv.bonnet[angle+1][1];
vv.y := vv.bonnet[angle+1][2];
vv.z := vv.bonnet[angle+1][3];
};
recalc;
}
show_movie := {
local next_time;
next_time := clock;
for ( angle := 0; angle < 359.5 ; angle += 1 )
{ while clock < next_time do {};
next_time += frame_delay;
set_bonnet(angle);
}
}
// write postscript file for each frame
postscript_movie := {
full_bounding_box on;
for ( angle := 0; angle < 359.5 ; angle += 1 )
{
set_bonnet(angle);
postscript sprintf"%s.%03d",datafilename,angle;
}
}
// continuous loop
movie := { for (;;) show_movie; }
// Write split-vertex adjoint datafile. To be done after conconj;
// uses enewx values to compute vertices.
define facet attribute split_bonnet real[3][360][3]
write_split_movie := {
printf "// split-vertex discrete adjoint of %s, rotation angle %f.\n",
datafilename,bangle;
printf "\ndefine vertex attribute bonnet real[360][3]\n\n";
printf "\nvertices\n";
foreach facet ff do
{ printf "%d %15.10f %15.10f %15.10f bonnet ",3*ff.id-2,
ff.edge[1].enewx[1]+ff.edge[2].enewx[1]-ff.edge[3].enewx[1],
ff.edge[1].enewx[2]+ff.edge[2].enewx[2]-ff.edge[3].enewx[2],
ff.edge[1].enewx[3]+ff.edge[2].enewx[3]-ff.edge[3].enewx[3];
print ff.split_bonnet[1];
printf "\n";
printf "%d %15.10f %15.10f %15.10f bonnet ",3*ff.id-1,
-ff.edge[1].enewx[1]+ff.edge[2].enewx[1]+ff.edge[3].enewx[1],
-ff.edge[1].enewx[2]+ff.edge[2].enewx[2]+ff.edge[3].enewx[2],
-ff.edge[1].enewx[3]+ff.edge[2].enewx[3]+ff.edge[3].enewx[3];
print ff.split_bonnet[2];
printf "\n";
printf "%d %15.10f %15.10f %15.10f bonnet ",3*ff.id,
ff.edge[1].enewx[1]-ff.edge[2].enewx[1]+ff.edge[3].enewx[1],
ff.edge[1].enewx[2]-ff.edge[2].enewx[2]+ff.edge[3].enewx[2],
ff.edge[1].enewx[3]-ff.edge[2].enewx[3]+ff.edge[3].enewx[3];
print ff.split_bonnet[3];
printf "\n";
};
printf "\nedges\n";
foreach facet ff do
{ printf "%d %d %d\n",3*ff.id-2,3*ff.id-2,3*ff.id-1;
printf "%d %d %d\n",3*ff.id-1,3*ff.id-1,3*ff.id;
printf "%d %d %d\n",3*ff.id,3*ff.id,3*ff.id-2;
};
printf "\nfaces\n";
foreach facet ff do
printf "%d %d %d %d\n",ff.id,3*ff.id-2,3*ff.id-1,3*ff.id;
printf "\nread\n";
printf "read \"bonnet_movie.cmd\"\n";
}
make_split_movie := {
local midx,midy,midz;
quiet on;
for ( bangle := 0 ; bangle < 359.5 ; bangle += 1 )
{ adjoint;
midx := vertex[midvertex].x;
midy := vertex[midvertex].y;
midz := vertex[midvertex].z;
foreach edge ee do
{ ee.enewx[1] -= midx;
ee.enewx[2] -= midy;
ee.enewx[3] -= midz;
};
foreach facet ff do
{
ff.split_bonnet[1][bangle+1][1] :=
ff.edge[1].enewx[1]+ff.edge[2].enewx[1]-ff.edge[3].enewx[1];
ff.split_bonnet[1][bangle+1][2] :=
ff.edge[1].enewx[2]+ff.edge[2].enewx[2]-ff.edge[3].enewx[2];
ff.split_bonnet[1][bangle+1][3] :=
ff.edge[1].enewx[3]+ff.edge[2].enewx[3]-ff.edge[3].enewx[3];
ff.split_bonnet[2][bangle+1][1] :=
-ff.edge[1].enewx[1]+ff.edge[2].enewx[1]+ff.edge[3].enewx[1];
ff.split_bonnet[2][bangle+1][2] :=
-ff.edge[1].enewx[2]+ff.edge[2].enewx[2]+ff.edge[3].enewx[2];
ff.split_bonnet[2][bangle+1][3] :=
-ff.edge[1].enewx[3]+ff.edge[2].enewx[3]+ff.edge[3].enewx[3];
ff.split_bonnet[3][bangle+1][1] :=
ff.edge[1].enewx[1]-ff.edge[2].enewx[1]+ff.edge[3].enewx[1];
ff.split_bonnet[3][bangle+1][2] :=
ff.edge[1].enewx[2]-ff.edge[2].enewx[2]+ff.edge[3].enewx[2];
ff.split_bonnet[3][bangle+1][3] :=
ff.edge[1].enewx[3]-ff.edge[2].enewx[3]+ff.edge[3].enewx[3];
};
flip;
};
quiet off;
}
evolver-2.30c.dfsg/fe/stl.cmd 0000755 0001753 0001753 00000001260 11410765113 016311 0 ustar hazelsct hazelsct // stl.cmd
// Surface Evolver command to produce STL format text file from surface.
// Evolver command line usage:
// read "stl.cmd"
// stl >>> "filename.stl"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
stl := {
local mag,inx;
printf "solid\n";
foreach facet ff do
{ mag := sqrt(ff.x^2+ff.y^2+ff.z^2);
printf "facet normal %f %f %f\n",ff.x/mag,ff.y/mag,ff.z/mag;
printf " outer loop\n";
for ( inx := 1 ; inx <= 3 ; inx += 1 )
printf " vertex %f %f %f\n",ff.vertex[inx].x,ff.vertex[inx].y,
ff.vertex[inx].z;
printf " endloop\n";
printf " endfacet\n";
};
printf "endsolid\n";
}
evolver-2.30c.dfsg/fe/tankex.fe 0000644 0001753 0001753 00000005233 11410765113 016631 0 ustar hazelsct hazelsct // tankex.fe
// Equilibrium shape of liquid in flat-ended cylindrical tank.
// Tank has axis along y-axis and flat bottom in x-z plane. This
// is so gravity acting vertically draws liquid toward wall.
// Straight edges cannot conform exactly to curved walls.
// We need to give them an area so that area cannot shrink by straght edges
// pulling away from the walls. The gaps are also accounted for
// in volume and gravitational energy.
SYMMETRIC_CONTENT // for volume calculations
// Contact angles, initially for 45 degrees.
PARAMETER ENDT = 0.707 /* surface tension of uncovered base */
PARAMETER WALLT = 0.707 /* surface tension of uncovered side wall */
// Gravity components
PARAMETER GY = 0
PARAMETER GZ = -1
SPRING_CONSTANT 1 // for most accurate gap areas for constraint 2
#define TR 1.00 /* tank radius */
#define RHO 1.00 /* fuel density */
constraint 1 // flat base
function: y = 0
energy: // for contact energy line integral
e1: -ENDT*z
e2: 0
e3: 0
#define wstuff (WALLT*TR*y/(x^2 + z^2)) // common wall area term
#define vstuff (TR^2/3*y/(x^2 + z^2)) // common wall volume term
#define gstuff (GY*TR^2*y^2/4/(x^2 + z^2) + GZ*TR^3*y*z/3/(x^2+z^2)**1.5)
// common gap gravity term
constraint 2 CONVEX // cylindrical wall
function: x^2 + z^2 = TR^2
energy: // for contact energy and gravity
e1: -wstuff*z + RHO*GY*y^2*z/4 + RHO*GZ*y*z^2/3 - RHO*gstuff*z
e2: 0
e3: wstuff*x - RHO*GY*y^2*x/4 - RHO*GZ*y*z*x/3 + RHO*gstuff*x
content: // so volumes calculated correctly
c1: vstuff*z - z*y/6 + vstuff*z/2
c2: 0
c3: -vstuff*x + x*y/6 - vstuff*x/2
// named quantity for arbitrary direction gravity on facets
quantity arb_grav energy method facet_vector_integral global
vector_integrand:
q1: 0
q2: -RHO*GY*y^2/2 - RHO*GZ*y*z
q3: 0
// Now the specification of the initial shape
vertices
1 0.5 0.0 0.5 constraint 1
2 0.5 0.0 -0.5 constraint 1
3 -0.5 0.0 -0.5 constraint 1
4 -0.5 0.0 0.5 constraint 1
5 1.0 0.5 0.0 constraint 2
6 0.0 0.5 -1.0 constraint 2
7 -1.0 0.5 0.0 constraint 2
8 0.0 0.5 1.0 constraint 2
edges
1 2 1 constraint 1
2 1 4 constraint 1
3 4 3 constraint 1
4 3 2 constraint 1
5 5 6 constraint 2
6 6 7 constraint 2
7 7 8 constraint 2
8 8 5 constraint 2
9 1 8
10 1 5
11 2 5
12 2 6
13 3 6
14 3 7
15 4 7
16 4 8
faces
1 13 6 -14
2 3 14 -15
3 15 7 -16
4 2 16 -9
5 9 8 -10
6 1 10 -11
7 11 5 -12
8 4 12 -13
bodies
1 1 2 3 4 5 6 7 8 volume 0.6 density 0 /* no default gravity */
evolver-2.30c.dfsg/fe/fourier.cmd 0000755 0001753 0001753 00000003232 11410765113 017163 0 ustar hazelsct hazelsct // fourier.cmd
// Evolver command to print Fourier components for closed curve
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: f_component(order)
procedure f_component (integer f_order)
// f_order is the order of Fourier components.
{
local e_id,first_e,v_id,newe_id;
x_sin_coeff := 0.0;
y_sin_coeff := 0.0;
z_sin_coeff := 0.0;
x_cos_coeff := 0.0;
y_cos_coeff := 0.0;
z_cos_coeff := 0.0;
ecount := 0;
// get starting edge, since can't assume edge[1] exists
foreach edge do e_id := id;
first_e := e_id;
v_id := edge[e_id].vertex[1].id;
// follow connected edges
do {
local ss,cc,newv_id;
ss := sin(f_order*ecount*2*pi/edge_count)*2/edge_count;
x_sin_coeff := x_sin_coeff + vertex[v_id].x*ss;
y_sin_coeff := y_sin_coeff + vertex[v_id].y*ss;
z_sin_coeff := z_sin_coeff + vertex[v_id].z*ss;
cc := cos(f_order*ecount*2*pi/edge_count)*2/edge_count;
x_cos_coeff := x_cos_coeff + vertex[v_id].x*cc;
y_cos_coeff := y_cos_coeff + vertex[v_id].y*cc;
z_cos_coeff := z_cos_coeff + vertex[v_id].z*cc;
foreach edge[e_id].vertex vv do
{ if ( vv.id != v_id ) then
{ newv_id := vv.id;
foreach vv.edge ee do
if ee.id != e_id then newe_id := ee.id
}
};
e_id := newe_id; v_id := newv_id;
ecount := ecount + 1;
} while ( (e_id != first_e) and (ecount <= edge_count) );
printf "Order %g x y z \n",f_order;
printf "sin: %20.15f %20.15f %20.15f\n",x_sin_coeff,y_sin_coeff,z_sin_coeff;
printf "cos: %20.15f %20.15f %20.15f\n",x_cos_coeff,y_cos_coeff,z_cos_coeff;
}
evolver-2.30c.dfsg/fe/addload_example.fe 0000644 0001753 0001753 00000005735 11410765113 020451 0 ustar hazelsct hazelsct // addload_example.fe
// Demonstration of using the addload command to load multiple
// copies of the same file. Basic surface is that of mound.fe,
// a liquid drop on a plane.
// Each separate mound will have its own contact angle, implemented
// by having a contact angle attribute for each edge.
// The "setup" script below invokes addload multiple times on this same
// datafile, moviing each instance to its appropriate location.
// Note that addload does not execute the "read" section of a datafile,
// so such "setup" scripts are ru only once.
// Programmeer: Ken Brakke, brakke@susqu.edu
define edge attribute angle real // interior angle between plane and surface, degrees
gravity_constant 0 // start with gravity off
#define WALLT (-cos(angle*pi/180)) // virtual tension of facet on plane
constraint 1 /* the table top */
formula: x3 = 0
energy: // for contact angle
e1: -(WALLT*y)
e2: 0
e3: 0
vertices
1 0.0 0.0 0.0 constraint 1 /* 4 vertices on plane */
2 1.0 0.0 0.0 constraint 1
3 1.0 1.0 0.0 constraint 1
4 0.0 1.0 0.0 constraint 1
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
9 2.0 2.0 0.0 fixed /* for table top */
10 2.0 -1.0 0.0 fixed
11 -1.0 -1.0 0.0 fixed
12 -1.0 2.0 0.0 fixed
edges /* given by endpoints and attribute */
1 1 2 constraint 1 /* 4 edges on plane */
2 2 3 constraint 1
3 3 4 constraint 1
4 4 1 constraint 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 5
10 2 6
11 3 7
12 4 8
13 9 10 no_refine fixed /* for table top */
14 10 11 no_refine fixed
15 11 12 no_refine fixed
16 12 9 no_refine fixed
faces /* given by oriented edge loop */
1 1 10 -5 -9
2 2 11 -6 -10
3 3 12 -7 -11
4 4 9 -8 -12
5 5 6 7 8
7 13 14 15 16 no_refine density 0 fixed /* table top for display */
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 volume 1 density 1
read
setup := {
// Read in 3 x 3 arrangement of drops. The first has already been
// read in, so we need to read in 8 more copies of this datafile.
// We use a vertex attribute to distinguish between old and new
// elements; for more elaborate massaging of new input you could
// use more attributes on more types of elements.
define vertex attribute load_marker integer;
for ( row := 0 ; row < 3 ; row += 1 )
for ( col := 0 ; col < 3 ; col += 1 )
{ if ( row > 0 or col > 0 ) then addload datafilename;
// Move and mark vertices
foreach vertex vv where load_marker == 0 do
{ vv.x += 2*row;
vv.y += 2*col;
vv.load_marker := 3*row+col+1; // different loads get different marks
};
};
// Now assign contact angles to contact line edges
foreach edge ee where on_constraint 1 do
ee.angle := 90 + (ee.vertex[1].load_marker - 5)*10;
} // end setup
setup
// From here on, we have the usual evolution commands
re := {refine edges where on_constraint 1 }
// Typical evolution
gogo := { re; g 5; r; g 5; r; g 5; hessian; hessian; }
evolver-2.30c.dfsg/fe/catbody.fe 0000644 0001753 0001753 00000005011 11410765113 016756 0 ustar hazelsct hazelsct // catbody.fe
// Evolver data for catenoid with fixed inner volume between plane ends.
PARAMETER RMAX = 1.0
PARAMETER ZMAX = 0.55
boundary 1 parameters 1 // upper ring
x1: RMAX * cos(p1)
x2: RMAX * sin(p1)
x3: ZMAX
boundary 2 parameters 1 // lower ring
x1: RMAX * cos(p1)
x2: RMAX * sin(p1)
x3: -ZMAX
vertices // given in terms of boundary parameter
1 0.00 boundary 1 fixed
2 pi/3 boundary 1 fixed
3 2*pi/3 boundary 1 fixed
4 pi boundary 1 fixed
5 4*pi/3 boundary 1 fixed
6 5*pi/3 boundary 1 fixed
7 0.00 boundary 2 fixed
8 pi/3 boundary 2 fixed
9 2*pi/3 boundary 2 fixed
10 pi boundary 2 fixed
11 4*pi/3 boundary 2 fixed
12 5*pi/3 boundary 2 fixed
edges
1 1 2 boundary 1 fixed
2 2 3 boundary 1 fixed
3 3 4 boundary 1 fixed
4 4 5 boundary 1 fixed
5 5 6 boundary 1 fixed
6 6 1 boundary 1 fixed
7 7 8 boundary 2 fixed
8 8 9 boundary 2 fixed
9 9 10 boundary 2 fixed
10 10 11 boundary 2 fixed
11 11 12 boundary 2 fixed
12 12 7 boundary 2 fixed
13 1 7
14 2 8
15 3 9
16 4 10
17 5 11
18 6 12
faces
1 13 7 -14 -1
2 14 8 -15 -2
3 15 9 -16 -3
4 16 10 -17 -4
5 17 11 -18 -5
6 18 12 -13 -6
bodies
1 1 2 3 4 5 6 volconst 2*pi*rmax^2*zmax volume 1.1
read
// Typical evolution
gogo := { u; r; g 5; r; g 5; r; g 5; hessian; hessian }
// Adjusting volume to find zero pressure, i.e. the unstable
// equilibrium catenoid. Run after refining to taste.
// Note that no 'g' steps are used in iteration after changing
// the volume. This is because the triangulation is not optimal,
// and 'g' lets the vertices slither sideways, but 'hessian'
// moves vertices only perpendicular to the surface (in the default
// hessian_normal mode). The magnitude of volume changes is limited
// since experimentation showed that too large moves can cause
// blowups.
adjust := {
oldpressure := body[1].pressure;
oldtarget := body[1].target;
dvol := .01; // starting step size
body[1].target += dvol;
hessian; hessian; hessian;
slope := (body[1].pressure - oldpressure)/dvol;
for ( inx := 1 ; inx <= 20; inx += 1 )
{ dvol := -body[1].pressure/slope;
if abs(dvol) > .01 then dvol := (dvol < 0) ? -.01 : .01;
oldpressure := body[1].pressure;
body[1].target += dvol;
hessian; hessian; hessian;
printf "Pressure %g dvol %g slope %f\n",body[1].pressure,dvol,slope;
if abs(dvol) > .001 then
slope := (body[1].pressure - oldpressure)/dvol;
};
}
evolver-2.30c.dfsg/fe/saveview.cmd 0000755 0001753 0001753 00000002436 11410765113 017346 0 ustar hazelsct hazelsct // saveview.cmd
// Evolver command for saving current view matrix in proper form
// for reading in.
// Typical usage: saveview >>> "viewfile.cmd"
// Then to restore view: read "viewfile.cmd"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
saveview := {
printf "oldautodisplay := (autodisplay);\n";
printf "autodisplay off\n";
printf "view_matrix[1][1] := %f\n",view_matrix[1][1];
printf "view_matrix[1][2] := %f\n",view_matrix[1][2];
printf "view_matrix[1][3] := %f\n",view_matrix[1][3];
printf "view_matrix[1][4] := %f\n",view_matrix[1][4];
printf "view_matrix[2][1] := %f\n",view_matrix[2][1];
printf "view_matrix[2][2] := %f\n",view_matrix[2][2];
printf "view_matrix[2][3] := %f\n",view_matrix[2][3];
printf "view_matrix[2][4] := %f\n",view_matrix[2][4];
printf "view_matrix[3][1] := %f\n",view_matrix[3][1];
printf "view_matrix[3][2] := %f\n",view_matrix[3][2];
printf "view_matrix[3][3] := %f\n",view_matrix[3][3];
printf "view_matrix[3][4] := %f\n",view_matrix[3][4];
printf "view_matrix[4][1] := %f\n",view_matrix[4][1];
printf "view_matrix[4][2] := %f\n",view_matrix[4][2];
printf "view_matrix[4][3] := %f\n",view_matrix[4][3];
printf "view_matrix[4][4] := %f\n",view_matrix[4][4];
printf "if oldautodisplay then autodisplay on\n";
}
evolver-2.30c.dfsg/fe/band.cmd 0000755 0001753 0001753 00000012145 11410765113 016417 0 ustar hazelsct hazelsct // band.cmd
// Surface Evolver command to create triangulated band bordering
// deisgnated edges and vertices. Purpose is to make extremely
// accurate PostScript files without notching on thick edges.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// WARNING: This command modifies the surface by creating a lot of
// tiny facets. You should use only on a disposable copy of your surface.
// Usage: set bandcolor and bandwidth to desired values; bandwidth is
// the width of the band in surface coordinates on one
// side of an edge.
// set the edge attribute inband to nonzero for those edges
// to have band drawn along them.
// run makeband
// When creating PostScript file, use the NN response to P 3 "Show grid lines?"
// IMPORTANT NOTE: The algorithm has trouble where inband edges meet
// at an angle, since each vertex has a single band distance attribute
// and the vertex may be a neighbor to two different bands. This results
// in ragged bands near corners. A cure is to do banding in stages,
// doing one "original" edge at a time.
// Not wise to run more than once along a given edge. Numerical
// variations due to new vertices lead to a lot more unnecessary
// refinements.
define edge attribute inband integer // 1 if band center, 0 if not
define vertex attribute banddist real // distance from band center.
define facet attribute bandused integer // so use each facet at most once
bandcolor := black // Set this to desired color before makeband.
bandwidth := 0.010 // Set this to desired half-width before makeband.
makeband := {
local maxbanddist,changed,eps;
maxbanddist := 100000*bandwidth;
set vertex banddist maxbanddist;
foreach edge ee where inband do set ee.vertex banddist 0;
foreach edge ee where (ee.inband==0) and (ee.vertex[1].banddist==0)
and (ee.vertex[2].banddist==0)
do { refine ee; ee.vertex[2].banddist := maxbanddist; } ;
set facet bandused 0;
// Calculate vertex distances from band center
do
{ changed := 0;
foreach facet ff do
{ local s1,s2,s3,d1,d2,d3;
local newd1,newd2,newd3;
if ff.bandused then continue;
s1 := ff.edge[1].length;
s2 := ff.edge[2].length;
s3 := ff.edge[3].length;
d1 := ff.vertex[1].banddist;
d2 := ff.vertex[2].banddist;
d3 := ff.vertex[3].banddist;
if ( (d2 < d1 or d3 < d1) and
( ( (d2 < bandwidth) && (d3 < maxbanddist) )
or ( (d2 < maxbanddist) && (d3 < bandwidth) ) ) ) then
{ newd1 := d3 + s3*sin(asin((d2-d3)/s2)+acos((-s1^2+s2^2+s3^2)/2/s2/s3));
if ( newd1 > 0 and newd1 < d1 ) then
{ ff.vertex[1].banddist := newd1; changed += 1;
ff.bandused := 1; continue;
};
};
if ( (d1 < d2 or d3 < d2 ) and
( ( (d1 < bandwidth) && (d3 < maxbanddist) )
or ( (d1 < maxbanddist) && (d3 < bandwidth) ) ) ) then
{ newd2 := d1 + s1*sin(asin((d3-d1)/s3)+acos((-s2^2+s3^2+s1^2)/2/s3/s1));
if ( newd2 > 0 and newd2 < d2 ) then
{ ff.vertex[2].banddist := newd2; changed += 1;
ff.bandused := 1; continue;
};
};
if ( (d1 < d3 or d2 < d3 ) and
( ( (d1 < bandwidth) && (d2 < maxbanddist) )
or ( (d1 < maxbanddist) && (d2 < bandwidth) ) ) ) then
{ newd3 := d2 + s2*sin(asin((d1-d2)/s1)+acos((-s3^2+s1^2+s2^2)/2/s1/s2));
if ( newd3 > 0 and newd3 < d3 ) then
{ ff.vertex[3].banddist := newd3; changed += 1;
ff.bandused := 1; continue;
};
};
};
} while ( changed > 0 );
printf "\n";
// Subdivide edges spanning band boundary
eps := 1e-4*bandwidth; // numerical margin for error
foreach edge ee do
{ local d1,d2;
local new_x,new_y,new_z;
local lambda;
d1 := ee.vertex[1].banddist;
d2 := ee.vertex[2].banddist;
if ( ((d1<=bandwidth+eps)&&(d2<=bandwidth+eps)) ||
((d1>=bandwidth-eps)&&(d2>=bandwidth-eps)))
then continue;
lambda := (bandwidth - d2)/(d1 - d2);
if ( lambda < .00001 or lambda > .99999 ) then continue;
new_x := lambda*ee.vertex[1].x + (1-lambda)*ee.vertex[2].x;
new_y := lambda*ee.vertex[1].y + (1-lambda)*ee.vertex[2].y;
new_z := lambda*ee.vertex[1].z + (1-lambda)*ee.vertex[2].z;
refine ee;
ee.vertex[2].x := new_x;
ee.vertex[2].y := new_y;
ee.vertex[2].z := new_z;
ee.vertex[2].banddist := bandwidth;
};
// Color band triangles
foreach facet ff do
{ if avg(ff.vertex,banddist) < bandwidth then set ff color bandcolor; };
}
// to do edges on different constraints one constraint at a time.
cband := {
local connum;
for ( connum := 1 ; connum <= high_constraint ; connum += 1 )
{ if valid_constraint(connum) then
{ set edge inband on_constraint connum;
makeband;
}
};
}
// makeband usage:
// set bandwidth to desired half-width (in surface coordinates)
// set edge inband to 1 along band center, 0 elsewhere
// set bandcolor to desired color
// run makeband
// In making postscript, answer N to gridlines, and y to colors.
evolver-2.30c.dfsg/fe/strdup.cmd 0000755 0001753 0001753 00000002657 11410765113 017043 0 ustar hazelsct hazelsct // strdup.cmd
// Evolver command to write a datafile that is an n-fold
// covering of a string. Meant to generate multiple coverings
// of elastic figure 8's.
// Usage: set dupnum to desired multiple and run "strdup".
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
dupnum := 2 // covering order
strdup := {
local sheet,vbase,connectflag,swapedge,ebase;
list topinfo;
printf "\nvertices\n";
sheet := 0;
while ( sheet < dupnum ) do
{ vbase := sheet*vertex_count;
foreach vertex do
printf "%g %g %g\n",id+vbase,x,y;
sheet := sheet + 1;
};
printf "\nedges\n";
connectflag := 0;
sheet := 0;
swapedge := -1;
while ( sheet < dupnum ) do
{ ebase := sheet*edge_count;
vbase := sheet*vertex_count;
foreach edge ee do
{ if connectflag and (swapedge != ee.id) then
printf "%g %g %g\n",
ee.id+ebase,ee.vertex[1].id+vbase,ee.vertex[2].id+vbase
else
{ printf "%g %g %g\n",
ee.id+ebase,ee.vertex[1].id+vbase,
ee.vertex[2].id+((sheet+1)imod dupnum)*vertex_count;
connectflag := 1;
swapedge := ee.id;
}
};
sheet := sheet + 1;
};
printf "\nread\n";
list procedures;
} // end strdup
evolver-2.30c.dfsg/fe/README-cmd.txt 0000644 0001753 0001753 00000006254 11410765113 017266 0 ustar hazelsct hazelsct A selection of Evolver commands for your edification. Consult remarks at
the top of each file for further information and instructions on use.
Use with caution; no attempt has been made to bulletproof these.
Note: These scripts do not necessarily take advantage of all the latest
Evolver features, and if I were writing them from scratch now they might
turn out quite different.
adjoint.cmd
ansurf.cmd Produces input file for ANSYS.
band.cmd Make extremely accurate thick borders for graphics.
bonnet_movie.cmd Show Bonnet rotation of minimal surface.
cmccousin.cmd Create constant mean curvature "cousin" surface.
dirichlet_to_disk.cmd Makes conformal map to disk by minimizing Dirichlet energy.
dxf.cmd Produce AutoCad DXF file.
equi.cmd To color edges subject to equiangulation.
equi2.cmd To color edges subject to equiangulation.
fourier.cmd Calculate Fourier components for closed curve
gaussequi.cmd Equiangulation using Gauss map for swap criterion.
gaussmap.cmd Converts each vertex coordinate to unit normal.
gaussref.cmd Refining using Gauss map as criterion.
iges.cmd Create file in IGES text format.
iges128.cmd Create IGES file using B-spline entity (type 128).
iges136.cmd Create IGES file using finite element entity (type 136).
intersec.cmd Detect intersection of linear edges and facets.
jvx.cmd Creates JVX format file for JavaView.
multiplicate.cmd Create datafile with multiple copies of surface.
neville.cmd Neville's algorithm for interpolating b-splines in 1D and 2D.
off.cmd Prints OFF format file.
order.cmd Numbers string vertices consecutively.
orderdmp.cmd Number string vertices consecutively and create an ordered dump file.
orderlis.cmd Number string vertices consecutively and list them
polyfilm.cmd Produce Polycut format file
povray.cmd Produces POV-Ray input file.
povrays.cmd POV-Ray file with smooth shading.
quadbbox.cmd Finds bounding boxes for quadratic facets in 3D
quadint2.cmd For detecting intersection of quadratic facets in 3D
quadmeet.cmd For detecting intersection of quadratic facets in 3D
reorder.cmd Example of using "reorder_storage" command.
rewrap.cmd Adjusting wraps of edges in 3D torus model.
rewrap2.cmd Adjusting wraps of edges in 2D torus model.
rib.cmd Creates Renderman RIB file.
rotate.cmd Rotate unfixed vertices by angle about z axis.
saveview.cmd Saves view matrix in easily reloadable form.
slice.cmd Calculate length of intersection of plane with surface.
slice2.cmd Calculates length of intersection of plane with one body.
slicer.cmd Create physical intersection of surface and plane.
stl.cmd Creates file in STL stereolithography format.
strdup.cmd Writes a datafile that is an n-fold covering of a string.
tuber.cmd Creates tubes around certain edges.
unshear.cmd Morphs 2D torus fundamental region to rectangle.
vrml.cmd Makes VRML file for surface.
wavefront.cmd Creates Wavefront format file.
wetfoam2.cmd Creates Plateau borders on a dry foam.
x3d.cmd Creates X3D format file.
xray.cmd Creates PostScript file with x-ray image.
zebra.cmd Colors string edges alternately black and white
evolver-2.30c.dfsg/fe/iges.cmd 0000755 0001753 0001753 00000017536 11410765113 016453 0 ustar hazelsct hazelsct // iges.cmd
// Surface Evolver script to write IGES file for surface, using IGES
// finite element entity (type 136), which handles linear, quadratic,
// and cubic triangles (among many other types not of interest).
// Finite element type not official "geometry"???? Rhino says can't
// find any independent geometry, and http://www.iges5x.org/taxonomy/ has
// FEM types included under "non-geometry taxonomy'.
// Also not listed in Table 3 on p. 38 of IGES-6 documentation.
// So we try using parametric patches, type 114.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// usage: iges >>> "filename.igs"
// Set up color translation array
define iges_colors integer [16];
//iges_colors[black] := 1
iges_colors[red] := 2
iges_colors[green] := 3
iges_colors[blue] := 4
iges_colors[yellow] := 5
iges_colors[magenta] := 6
iges_colors[cyan] := 7
iges_colors[white] := 8
iges_colors[brown] := 2 // red
iges_colors[lightgray] := 8 // white
iges_colors[darkgray] := 1 // black
iges_colors[lightblue] := 4 // blue
iges_colors[lightcyan] := 7 // cyan
iges_colors[lightred] := 2 // red
iges_colors[lightmagenta] := 7
iges := {
local start_counter,global_counter,message,xmax,ymax,zmax;
local maxsize,entype,paramdata,structure,linefont,level,view;
local transmat,label,status,directory_counter,lineweight;
local colornum,paramcount,form,reserved,entlabel,entsubscr;
local parameter_counter,ctype,ptype,mvalue,nvalue,minu,maxu;
local minv,maxv,co00,co10,co01,co11,line,subcount;
// Flag section
// Don't need this since not doing binary or compressed format.
// Start section
start_counter := 0;
start_counter += 1;
printf "%-72sS%07d\n","IGES version of Surface Evolver surface",start_counter;
start_counter += 1;
printf " %-69sS%07d\n",datafilename,start_counter;
start_counter += 1;
printf "%-72sS%07d\n","Created using iges.cmd Evolver script.",
start_counter;
// Global section
global_counter := 0;
global_counter += 1;
printf "%-72sG%07d\n","1H,,1H;,",global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
message := sprintf "%s,",datafilename;
printf "%02dH%-69sG%07d\n",sizeof(datafilename),message,global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","32,75,6,75,15,,1.0,1,2HIN,32768,0.0394,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000,", global_counter; // date
xmax := max(vertex,abs(x));
ymax := max(vertex,abs(y));
zmax := max(vertex,abs(z));
maxsize := (xmax > ymax) ? xmax : ymax;
maxsize := (zmax > maxsize) ? zmax : maxsize;
message := sprintf "%g,%g,",maxsize/10000000,maxsize;
global_counter += 1;
printf "%-72sG%07d\n",message, global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Name of author"),"Name of author,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Author's organization"),
"Author's organization,", global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000;", global_counter; // date
// Directory entry section. Each entry 20 8-char fields on two lines.
// Fields with default values
entype := 0; // 1 and 11
paramdata := 1; // 2
structure := 0; // 3
linefont := 0; // 4
level := 0; // 5
view := 0; // 6
transmat := 0; // 7
label := 0; // 8
status := "00000000"; // 9; actually 4 two-digit numbers
directory_counter := 0; // 10 and 20
lineweight := 0; // 12
colornum := 0; // 13
paramcount := 0; // 14
form := 0; // 15
reserved := " "; // 16 and 17
entlabel := "entity"; // 18
entsubscr := 0; // 19
// Facets as "parametric surface" types
entype := 114;
status := "00010001";
paramcount := 1;
entlabel := " FACET";
define facet attribute fpdata integer;
define facet attribute fdir integer;
foreach facet ff do
{ ff.fpdata := paramdata;
entsubscr := ff.id;
directory_counter += 1; ff.fdir := directory_counter;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,
iges_colors[ff.color],
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
paramdata += 7;
};
// Geometry element
entype := 402;
status := "00000301";
paramcount := ceil(facet_count/10);
form := 7;
entlabel := " SURFACE";
entsubscr := 1;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,colornum,
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
// Parameter data section
parameter_counter := 0;
// Facets
entype := 114;
ctype := 1; // linear
ptype := 0; // unspecified
mvalue := 1; // number of u segments
nvalue := 1; // number of v segments
minu := 0;
maxu := 1;
minv := 0;
maxv := 1;
foreach facet ff do
{ parameter_counter += 1;
if ff.fpdata != parameter_counter then
errprintf
"ERROR: bad facet parameter line number, facet %d. Is %d, should be %d.\n",
ff.id,parameter_counter,ff.fpdata;
message := sprintf "%d,%d,%d,%d,%d,%g,%g,%g,%g,",entype,ctype,ptype,
mvalue,nvalue,minu,maxu,minv,maxv;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
co00 := ff.vertex[1].x;
co10 := ff.vertex[2].x-ff.vertex[1].x;
co01 := ff.vertex[3].x-ff.vertex[1].x;
co11 := ff.vertex[1].x-ff.vertex[2].x;
message := sprintf "%10.7f,%10.7f,0,0,%10.7f,%10.7f,0,0,",
co00,co10,co01,co11;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := "0,0,0,0,0,0,0,0,";
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
co00 := ff.vertex[1].y;
co10 := ff.vertex[2].y-ff.vertex[1].y;
co01 := ff.vertex[3].y-ff.vertex[1].y;
co11 := ff.vertex[1].y-ff.vertex[2].y;
message := sprintf "%10.7f,%10.7f,0,0,%10.7f,%10.7f,0,0,",
co00,co10,co01,co11;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := "0,0,0,0,0,0,0,0,";
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
co00 := ff.vertex[1].z;
co10 := ff.vertex[2].z-ff.vertex[1].z;
co01 := ff.vertex[3].z-ff.vertex[1].z;
co11 := ff.vertex[1].z-ff.vertex[2].z;
message := sprintf "%10.7f,%10.7f,0,0,%10.7f,%10.7f,0,0,",
co00,co10,co01,co11;
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
message := "0,0,0,0,0,0,0,0,";
parameter_counter += 1;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
};
// Geometry element
line := sprintf "402,%d,",facet_count;
subcount := 0;
foreach facet ff do
{ if subcount == 10 then
{
parameter_counter += 1;
printf "%-64s%8dP%7d\n",line,directory_counter-1,parameter_counter;
line := "" ;
subcount := 0;
};
line := sprintf"%s%d,",line,ff.fdir;
subcount += 1;
};
line := sprintf "%s0,0;",line; // sample files ended with 2 extra 0's
parameter_counter += 1;
printf "%-64s%8dP%7d\n",line,directory_counter-1,parameter_counter;
// Terminate section
printf "S%07dG%07dD%07dP%07d%40sT0000001\n",start_counter,global_counter,
directory_counter,parameter_counter," ";
}
evolver-2.30c.dfsg/fe/rewrap2.cmd 0000755 0001753 0001753 00000002400 11410765113 017066 0 ustar hazelsct hazelsct // rewrap2.cmd
// Commands to rewrap torus vertices and edges to get them nicely
// within unit cell. 2D version. For 3D version, see rewrap.cmd.
// Moves vertices at most one period at a time, so you may have to
// repeat if things are very bad to start with.
// Uses torus wrap representation and wrap_vertex builtin command.
// Usage: rewrap2
rewrap2 := {
if space_dimension != 2 then
{ errprintf"rewrap2 is for space dimension 2; for 3D use rewrap3.cmd.\n";
return;
};
define body attribute old_volume real; // so can adjust volconst
set body old_volume volume;
foreach vertex vv where vv.x*inverse_periods[1][1]+vv.y*inverse_periods[1][2]
< 0 do wrap_vertex(vv.id,1);
foreach vertex vv where vv.x*inverse_periods[1][1]+vv.y*inverse_periods[1][2]
>= 1 do wrap_vertex(vv.id,31);
foreach vertex vv where vv.x*inverse_periods[2][1]+vv.y*inverse_periods[2][2]
< 0 do wrap_vertex(vv.id,64);
foreach vertex vv where vv.x*inverse_periods[2][1]+vv.y*inverse_periods[2][2]
>= 1 do wrap_vertex(vv.id,1984);
recalc;
local torvol;
torvol := abs(torus_periods[1][1]*torus_periods[2][2]
- torus_periods[1][2]*torus_periods[2][1]);
set body volconst floor((old_volume - volume - volconst)/torvol+.5)*torvol;
}
evolver-2.30c.dfsg/fe/orderlis.cmd 0000755 0001753 0001753 00000002022 11410765113 017327 0 ustar hazelsct hazelsct // orderlist.cmd
// Evolver command to number string vertices consecutively
// by means of extra attribute 'number'.
// And list them to stdout. Can be redirected to file.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: orderlist
define vertex attribute number integer
orderlist := {
local ecount,e_id,first_e,v_id,newv_id,newe_id;
ecount := 0; // for safety
// get starting edge, since can't assume edge[1] exists
foreach edge do { e_id := id; break; };
first_e := e_id;
v_id := edge[e_id].vertex[1].id;
// follow connected edges
do
{ set vertex[v_id] number ecount+1;
printf "%g %g %g\n",vertex[v_id].x,vertex[v_id].y,vertex[v_id].z;
foreach edge[e_id].vertex vv do
{ if ( vv.id != v_id ) then
{ newv_id := vv.id;
foreach vv.edge ee do
if ee.id != e_id then newe_id := ee.id
}
};
e_id := newe_id; v_id := newv_id;
ecount := ecount + 1;
} while ( (e_id != first_e) and (ecount <= edge_count) )
}
evolver-2.30c.dfsg/fe/neville.cmd 0000755 0001753 0001753 00000014052 11410765113 017150 0 ustar hazelsct hazelsct // neville.cmd
// Neville's algorithm for computing Bspline values
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Contents:
// neville1 - interpolation and derivatives in one dimension
// neville2 - interpolation and derivatives in two dimensions.
// Neville algorithm for interpolating along one dimension.
// Usage of neville1:
// neville1_data should be set up by caller, redimensioning if necessary
// Indexed by point number along curve and data dimension.
define neville1_data real[0][0]; // not modified by neville1
// Returned from neville1. Index is data dimension.
define neville1_value real[0]; // interpolated values
define neville1_deriv real[0]; // interpolated deriv wrt u
procedure neville1 (
real neville1_order, // order of interpolation polynomial
real neville1_dim, // range dimension
real neville1_u // interpolation spot, between 0 and 1
)
{
local neville1_array; local neville1_darray;
define neville1_array real[neville1_order+1][neville1_dim];
define neville1_darray real[neville1_order+1][neville1_dim];
define neville1_value real[neville1_dim]; // interpolated values
define neville1_deriv real[neville1_dim]; // interpolated deriv wrt u
local inx;local dinx;
inx := 1;
while ( inx <= neville1_order+1 ) do
{
dinx := 1;
while ( dinx <= neville1_dim ) do
{ neville1_array[inx][dinx] := neville1_data[inx][dinx];
neville1_darray[inx][dinx] := 0;
dinx += 1;
};
inx += 1;
};
// scale npoint to integer based value
local nnpoint;
nnpoint := neville1_u*neville1_order;
local linx;
linx := 1;
while ( linx <= neville1_order ) do
{ inx := 1;
while ( inx + linx <= neville1_order + 1 ) do
{ dinx := 1;
while ( dinx <= neville1_dim ) do
{ // do derivatives first, since dependent on current value
neville1_darray[inx][dinx] :=
((inx-1+linx - nnpoint)*neville1_darray[inx][dinx]
+ (nnpoint - (inx-1))*neville1_darray[inx+1][dinx])/linx +
(-neville1_array[inx][dinx] + neville1_array[inx+1][dinx])/linx;
neville1_array[inx][dinx] :=
((inx-1+linx - nnpoint)*neville1_array[inx][dinx]
+ (nnpoint - (inx-1))*neville1_array[inx+1][dinx])/linx;
dinx += 1;
};
inx += 1;
};
linx += 1;
};
dinx := 1;
while ( dinx <= neville1_dim ) do
{ neville1_value[dinx] := neville1_array[1][dinx];
neville1_deriv[dinx] := neville1_darray[1][dinx]*neville1_order;
dinx += 1;
};
}
// Neville algorithm for interpolating in 2D
// Usage of neville2:
// Initialize neville2_data, neville2_u arrays.
// Call neville2.
// Input data, indexed by (i,j) node coordinate and data dimension.
define neville2_data real[0][0][0];
define neville2_u real[2]; // incoming; should sum to at most 1
neville2_u[1] := 1/3;
neville2_u[2] := 1/3;
// Return values, indexed by data dimension.
define neville2_value real[0] // return values of position
define neville2_deriv real[0][2] // return values of partials
procedure neville2 (
real neville2_order, // of polynomial
real neville2_dim // dimension of values
)
{
local neville2_array; local neville2_darray; local unpoint;
define neville2_array
real[neville2_order+1][neville2_order+1][neville2_dim];
define neville2_darray
real[neville2_order+1][neville2_order+1][neville2_dim][2];
define uupoint real[2]; // scaled target coordinates
define neville2_value real[neville2_dim]; // return values of position
define neville2_deriv real[neville2_dim][2]; // return values of partials
// initialize data; kludge due to fact that indexing on vertices
// only does the three corners.
local inx; local jnx; local dinx;
inx := 1;
while ( inx <= neville2_order+1 ) do
{ jnx := 1;
while ( inx + jnx <= neville2_order+2 ) do
{ dinx := 1;
while ( dinx <= neville2_dim ) do
{ neville2_array[inx][jnx][dinx] := neville2_data[inx][jnx][dinx];
neville2_darray[inx][jnx][dinx][1] := 0;
neville2_darray[inx][jnx][dinx][2] := 0;
dinx += 1;
};
jnx += 1;
};
inx += 1;
};
// scale npoint to integer based value
uupoint[1] := neville2_u[1]*neville2_order;
uupoint[2] := neville2_u[2]*neville2_order;
local linx;
linx := 1;
while ( linx <= neville2_order ) do
{ inx := 1;
while ( inx + linx <= neville2_order + 1 ) do
{ jnx := 1;
while ( inx + jnx + linx <= neville2_order + 2 ) do
{ dinx := 1;
while ( dinx <= neville2_dim ) do
{ // do derivatives first, since dependent on current value
neville2_darray[inx][jnx][dinx][1] :=
((inx+jnx-2+linx-uupoint[1]-uupoint[2])
*neville2_darray[inx][jnx][dinx][1]
+ (uupoint[1]-(inx-1))*neville2_darray[inx+1][jnx][dinx][1]
+ (uupoint[2]-(jnx-1))*neville2_darray[inx][jnx+1][dinx][1])/linx
+ (-neville2_array[inx][jnx][dinx]
+ neville2_array[inx+1][jnx][dinx] )/linx;
neville2_darray[inx][jnx][dinx][2] :=
((inx+jnx-2+linx-uupoint[1]-uupoint[2])
*neville2_darray[inx][jnx][dinx][2]
+ (uupoint[1]-(inx-1))*neville2_darray[inx+1][jnx][dinx][2]
+ (uupoint[2]-(jnx-1))*neville2_darray[inx][jnx+1][dinx][2])/linx
+ (-neville2_array[inx][jnx][dinx]
+ neville2_array[inx][jnx+1][dinx] )/linx;
neville2_array[inx][jnx][dinx] :=
((inx+jnx-2+linx-uupoint[1]-uupoint[2])*neville2_array[inx][jnx][dinx]
+ (uupoint[1] - (inx-1))*neville2_array[inx+1][jnx][dinx]
+ (uupoint[2] - (jnx-1))*neville2_array[inx][jnx+1][dinx])/linx;
dinx += 1;
};
jnx += 1;
};
inx += 1;
};
linx += 1;
};
dinx := 1;
while ( dinx <= neville2_dim ) do
{ neville2_value[dinx] := neville2_array[1][1][dinx];
neville2_deriv[dinx][1] := neville2_darray[1][1][dinx][1]*neville2_order;
neville2_deriv[dinx][2] := neville2_darray[1][1][dinx][2]*neville2_order;
dinx += 1;
};
}
evolver-2.30c.dfsg/fe/slicer.cmd 0000755 0001753 0001753 00000015666 11410765113 017007 0 ustar hazelsct hazelsct // slicer.cmd --- create intersection of surface with plane
// plane eq: a*x + b*y + c*z = d
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Commands included:
// drawslice - make new edges across facets along plane.
// slicer - make slice and dissolve all facets, edges, and vertices
// on negative side of the plane. Calls drawslice.
// slice_list - print coordinates of vertices along a slice.
// "slicer" usage:
// Set slice_a,slice_b,slice_c,slice_d coefficients so
// slice_a*x + slice_b*y + slice_c*z >= slice_d
// is the side you want, and do "slicer".
// output: truncated surface on positive side of plane
// Try not to slice exactly through vertices!!
// Default plane is slice_a := 0, slice_b := 0, slice_c := 1, slice_d := .1
// To mark the vertices and edges created by the current slicing,
// there are a vertex attribute v_timestamp and an edge attribute
// e_timestamp that are set to slice_timestamp, which is incremented
// each time slicer is called.
// Works in torus by rewrapping wrapped edges that would be cut
// so unwrapped part is on positive side of cut plane.
// Slice_list:
// Listing of vertices along the slice, beginning at user-designated vertex.
// If the slice has multiple components, you will have to run separately
// for each component.
// Usage: set startv to the first vertex on the slice and call slice_list
// Output is to stdout, so will usually be redirected, e.g.
// slice_list >>> "slice.dat"
//Set these coefficients for the slicing plane
slice_a := 0;
slice_b := 0;
slice_c := 1;
slice_d := .1;
// Attributes for marking vertices and edges on slice with timestamp
slice_timestamp := 0
define vertex attribute v_timestamp integer
define edge attribute e_timestamp integer
// First put in new edges along slicing plane
drawslice := {
local lambda;
local denom;
local xx1;
local yy1;
local zz1;
local xx2;
local yy2;
local zz2;
slice_timestamp += 1; // marker for this slice
foreach edge ee do
{
xx1 := ee.vertex[1].x;
yy1 := ee.vertex[1].y;
zz1 := ee.vertex[1].z;
xx2 := xx1 + ee.x; // using edge vector in case of torus wrap
yy2 := yy1 + ee.y;
zz2 := zz1 + ee.z;
denom := slice_a*(xx1-xx2)+slice_b*(yy1-yy2)+slice_c*(zz1-zz2);
if ( denom != 0.0 ) then
{
lambda := (slice_d-slice_a*xx2-slice_b*yy2-slice_c*zz2)/denom;
if ( (lambda >= 0) and (lambda <= 1) ) then
{
if torus then
if ee.wrap then
{ if denom > 0 then // tail on positive side
wrap_vertex(ee.vertex[2].id,ee.wrap)
else // head on positive side
wrap_vertex(ee.vertex[1].id,wrap_inverse(ee.wrap));
};
xb := lambda*xx1+(1-lambda)*xx2;
yb := lambda*yy1+(1-lambda)*yy2;
zb := lambda*zz1+(1-lambda)*zz2;
refine ee;
ee.vertex[2].v_timestamp := slice_timestamp;
ee.vertex[2].x := xb;
ee.vertex[2].y := yb;
ee.vertex[2].z := zb;
}
else if torus and ee.wrap then
{ // try wrapping from head
xx2 := ee.vertex[2].x;
yy2 := ee.vertex[2].y;
zz2 := ee.vertex[2].z;
xx1 := xx2 - ee.x; // using edge vector in case of torus wrap
yy1 := yy2 - ee.y;
zz1 := zz2 - ee.z;
denom := slice_a*(xx1-xx2)+slice_b*(yy1-yy2)+slice_c*(zz1-zz2);
if ( denom != 0.0 ) then
{
lambda := (slice_d-slice_a*xx2-slice_b*yy2-slice_c*zz2)/denom;
if ( (lambda >= 0) and (lambda <= 1) ) then
{
if torus then
if ee.wrap then
{ if denom > 0 then // tail on positive side
wrap_vertex(ee.vertex[2].id,ee.wrap)
else // head on positive side
wrap_vertex(ee.vertex[1].id,wrap_inverse(ee.wrap));
};
xb := lambda*xx1+(1-lambda)*xx2;
yb := lambda*yy1+(1-lambda)*yy2;
zb := lambda*zz1+(1-lambda)*zz2;
refine ee;
ee.vertex[2].v_timestamp := slice_timestamp;
ee.vertex[2].x := xb;
ee.vertex[2].y := yb;
ee.vertex[2].z := zb;
}
}
}
} ;
} ;
// mark edges created by slicing
set edge ee e_timestamp min(ee.vertex,v_timestamp);
}
slicer := {
drawslice;
former_autodisplay := (autodisplay);
autodisplay off; // prevent display while dissolving
foreach facet ff where // again, careful of torus wraps
slice_a*(ff.vertex[1].x+ff.edge[1].x/3-ff.edge[3].x/3) +
slice_b*(ff.vertex[1].y+ff.edge[1].y/3-ff.edge[3].y/3) +
slice_c*(ff.vertex[1].z+ff.edge[1].z/3-ff.edge[3].z/3) < slice_d do
{ unset ff frontbody;
unset ff backbody;
dissolve ff;
};
dissolve bodies bbb where sum(bbb.facets,1) == 0;
dissolve edges; // just does bare edges
dissolve vertices; // just does bare vertices
if former_autodisplay then autodisplay on;
}
color_slice := {
foreach facet ff where // again, careful of torus wraps
slice_a*(ff.vertex[1].x+ff.edge[1].x/3-ff.edge[3].x/3) +
slice_b*(ff.vertex[1].y+ff.edge[1].y/3-ff.edge[3].y/3) +
slice_c*(ff.vertex[1].z+ff.edge[1].z/3-ff.edge[3].z/3) < slice_d do
set ff color magenta;
}
// Listing of vertices along the slice, beginning at user-designated vertex.
// If the slice has multiple components, you will have to run separately
// for each component.
// Usage: set startv to the first vertex on the slice and call slice_list
// Output is to stdout, so will usually be redirected, e.g.
// slice_list >>> "slice.dat"
startv := 1
slice_list := {
if vertex[startv].v_timestamp != slice_timestamp then
{ errprintf "slice_list: starting vertex startv is %d, not on latest slice.\n",
startv;
return;
};
thisv := startv;
thisedge := 0;
do
{ // print current vertex coordinates
printf "%20.15f %20.15f %20.15f\n",vertex[thisv].x,vertex[thisv].y,
vertex[thisv].z;
nextedge := 0;
foreach vertex[thisv].edge ee where ee.e_timestamp == slice_timestamp
do { if ee.oid != -thisedge then { nextedge := ee.oid; break; }};
if nextedge == 0 then break; /* done */
thisv := edge[nextedge].vertex[2].id;
thisedge := nextedge;
} while thisv != startv; // done
}
// "slicer" usage:
// Set slice_a,slice_b,slice_c,slice_d coefficients so
// slice_a*x + slice_b*y + slice_c*z >= slice_d
// is the side you want, and do "slicer".
// Default plane is slice_a := 0, slice_b := 0, slice_c := 1, slice_d := .1
evolver-2.30c.dfsg/fe/relaxed.fe 0000644 0001753 0001753 00000001303 11410765113 016755 0 ustar hazelsct hazelsct // relaxed.fe
// Test of relaxed_elastic energy
space_dimension 5 // 2 extra for unstrained reference coordinates
quantity stretchy energy method relaxed_elastic global
quantity stretchy1 info_only method relaxed_elastic1 global
quantity stretchy2 info_only method relaxed_elastic2 global
define facet attribute poisson_ratio real
define vertex attribute ref_coord real[2]
constraint 1 formula: x4 = ref_coord[1]
constraint 2 formula: x5 = ref_coord[2]
vertices
1 0 0 0 0 0 constraint 1,2 ref_coord 0 0
2 1 0 0 1 0 constraint 1,2 ref_coord 1 0
3 0 1 0 1 1 constraint 1,2 ref_coord 0 1
edges
1 1 2
2 2 3
3 3 1
faces
1 1 2 3
read
set facet poisson_ratio 0.8
set facet tension 0.0
evolver-2.30c.dfsg/fe/column.fe 0000644 0001753 0001753 00000007043 11410765113 016635 0 ustar hazelsct hazelsct // column.fe
// Example of calculating forces exerted by a
// column of liquid solder in shape of skewed catenoid.
// All units cgs
parameter RAD = 0.05 // ring radius
parameter ZH = 0.08 // total height
parameter SHIFT = 0.025 // shift
#define SG 8 // specific gravity of solder
#define TENS 460 // surface tension of solder
#define GR 980 // acceleration of gravity
gravity_constant GR
BOUNDARY 1 PARAMETERS 1
X1: RAD*cos(P1)
X2: RAD*sin(P1) + SHIFT
X3: ZH
CONTENT // used to compensate for missing top facets
c1: 0
c2: ZH*x
c3: 0
ENERGY // used to compensate for gravitational energy under top facets
e1: 0
e2: GR*ZH^2/2*x
e3: 0
BOUNDARY 2 PARAMETERS 1
X1: RAD*cos(P1)
X2: RAD*sin(P1)
X3: 0
vertices // given in terms of boundary parameter
1 0.00 boundary 1 fixed
2 pi/3 boundary 1 fixed
3 2*pi/3 boundary 1 fixed
4 pi boundary 1 fixed
5 4*pi/3 boundary 1 fixed
6 5*pi/3 boundary 1 fixed
7 0.00 boundary 2 fixed
8 pi/3 boundary 2 fixed
9 2*pi/3 boundary 2 fixed
10 pi boundary 2 fixed
11 4*pi/3 boundary 2 fixed
12 5*pi/3 boundary 2 fixed
edges
1 1 2 boundary 1 fixed
2 2 3 boundary 1 fixed
3 3 4 boundary 1 fixed
4 4 5 boundary 1 fixed
5 5 6 boundary 1 fixed
6 6 1 boundary 1 fixed
7 7 8 boundary 2 fixed
8 8 9 boundary 2 fixed
9 9 10 boundary 2 fixed
10 10 11 boundary 2 fixed
11 11 12 boundary 2 fixed
12 12 7 boundary 2 fixed
13 1 7
14 2 8
15 3 9
16 4 10
17 5 11
18 6 12
faces
1 -1 13 7 -14 density TENS
2 -2 14 8 -15 density TENS
3 -3 15 9 -16 density TENS
4 -4 16 10 -17 density TENS
5 -5 17 11 -18 density TENS
6 -6 18 12 -13 density TENS
bodies
1 1 2 3 4 5 6 volume 0.00045 density SG
read
// horizontal force on upper pad by central differences
dy := .0001
do_yforce := { oldshift := shift; shift := shift + dy;
set vertex y y+dy*z/zh; // uniform shear
recalc;
energy1 := total_energy -
body[1].pressure*(body[1].volume - body[1].target);
oldshift := shift; shift := shift - 2*dy;
set vertex y y-2*dy*z/zh; // uniform shear
recalc;
energy2 := total_energy -
body[1].pressure*(body[1].volume - body[1].target);
yforce := -(energy1-energy2)/2/dy;
printf "restoring force: %20.15f\n",yforce;
// restore everything
oldshift := shift; shift := shift + dy;
set vertex y y+dy*z/zh; // uniform shear
recalc;
}
// vertical force on upper pad by central differences.
dz := .0001
do_zforce := { oldzh := zh; zh := zh + dz;
set vertex z z+dz*z/oldzh; recalc; // uniform stretch
energy1 := total_energy -
body[1].pressure*(body[1].volume - body[1].target);
oldzh := zh; zh := zh - 2*dz;
set vertex z z-2*dz*z/oldzh; recalc; // uniform stretch
energy2 := total_energy -
body[1].pressure*(body[1].volume - body[1].target);
zforce := -(energy1-energy2)/2/dz;
printf "vertical force: %20.15f\n",zforce;
// restore everything
oldzh := zh; zh := zh + dz;
set vertex z z+dz*z/oldzh; recalc; // uniform stretch
}
// Sample evolution and force calculation
gogo := { u; g 5; r; g 5 ; r; g 5; hessian; hessian;
do_yforce; do_zforce;
}
evolver-2.30c.dfsg/fe/popstr.fe 0000644 0001753 0001753 00000000414 11410765113 016662 0 ustar hazelsct hazelsct // popstr.fe
// evolver string vertex popping test
STRING
vertices
1 0.0 0.0 0.0 fixed
2 1.0 0.0 0.0 fixed
3 1.0 0.0 1.0 fixed
4 0.0 0.0 1.0 fixed
5 0.5 0.0 0.5
edges
1 1 5
2 2 5
3 3 5
4 4 5
read
// Typical evolution
gogo := { o; g 5 }
evolver-2.30c.dfsg/fe/povrays.cmd 0000755 0001753 0001753 00000013547 11410765113 017225 0 ustar hazelsct hazelsct // povrays.cmd
// Surface Evolver command for producing POV-Ray input file.
// Output is to stdout, so redirect to desired file.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Like povray.cmd, but with vertex normals for a smooth surface.
// A normal at a vertex of a facet is the average of all adjacent
// facet normals within a certain angle of the original facet normal
// Usage:
// Use the "show edge where ..." command to declare which
// edges are to be depicted as thin cylinders.
// Set "edge_radius" to desired radius of edge cylinders.
// Set "critcos" to critical cosine of angle for facets
// regarded as smoothly joined.
// Run "povray" and redirect to desired file, e.g.
// Enter command: povray >>> "something.pov"
// Run "povrays" with output redirected to a file, e.g.
// Enter command: povrays >>> "something.pov"
edge_radius := 0.003; // adjust this for desired radius of edge cylinders
critcos := 0.8; // criterion for vertex normal averaging.
povrays := {
local ffx,ffy,ffz,ffnorm,vernum,nx,ny,nz,fffx,fffy,fffz,fffnorm;
local costheta,nnorm;
printf "// %s in POV-Ray format.\n\n",datafilename;
printf "light_source { <0,0,300> color rgb <1,1,1> }\n";
printf "light_source { <100,0,0> color rgb <1,1,1> }\n";
printf "camera { location <12,0,0> sky <0,0,1> // right handed \n";
printf " up <0,0,1> right <1.3,0,0> look_at <0,0,0> angle 15 }\n";
printf "background { color <0.3,0.8,1.0> } // light blue\n\n";
printf "// Textures corresponding to Evolver colors\n\n";
printf "#declare t_black = texture { pigment { rgb <0.0,0.0,0.0> }}\n";
printf "#declare t_blue = texture { pigment { rgb <0.0,0.0,1.,> }}\n";
printf "#declare t_green = texture { pigment { rgb <0.0,1.,0.0,> }}\n";
printf "#declare t_cyan = texture { pigment { rgb <0.0,1.,1.,> }}\n";
printf "#declare t_red = texture { pigment { rgb <1.,0.0,0.0,> }}\n";
printf "#declare t_magenta = texture { pigment { rgb <1.,0.0,1.,> }}\n";
printf "#declare t_brown = texture { pigment { rgb <1.,0.5,0.,> }}\n";
printf "#declare t_lightgray = texture { pigment { rgb <.6,.6,.6,> }}\n";
printf "#declare t_darkgray = texture { pigment { rgb <.3,.3,.3,> }}\n";
printf "#declare t_lightblue = texture { pigment { rgb <.3,.8,1.,> }}\n";
printf "#declare t_lightgreen = texture { pigment { rgb <.5,1.,.5,> }}\n";
printf "#declare t_lightcyan = texture { pigment { rgb <.5,1.,1.,> }}\n";
printf "#declare t_lightred = texture { pigment { rgb <1.,.5,.5,> }}\n";
printf "#declare t_lightmagenta = texture { pigment { rgb <1.,.5,1.,> }}\n";
printf "#declare t_yellow = texture { pigment { rgb <1.,1.,.0,> }}\n";
printf "#declare t_white = texture { pigment { rgb <1.,1.,1.,> }}\n";
printf "\n//One overall object.\n";
printf "union {\n";
printf "// All facets in one big mesh object for efficiency.\n";
printf " mesh { \n";
foreach facet ff do {
printf " smooth_triangle { ";
ffx := ff.x; ffy := ff.y; ffz := ff.z;
ffnorm := sqrt(ffx^2 + ffy^2 + ffz^2);
vernum := 1;
while ( vernum <= 3 ) do
{ nx := 0; ny := 0; nz := 0;
foreach ff.vertex[vernum].facet fff do
{ fffx := fff.x; fffy := fff.y; fffz := fff.z;
fffnorm := sqrt(fffx^2 + fffy^2 + fffz^2);
costheta := (fffx*ffx+fffy*ffy+fffz*ffz)/ffnorm/fffnorm;
if ( costheta > critcos ) then
{ nx := nx + fffx/fffnorm;
ny := ny + fffy/fffnorm;
nz := nz + fffz/fffnorm;
}
else if ( costheta < -critcos ) then // in case nonorientable
{ nx := nx - fffx/fffnorm;
ny := ny - fffy/fffnorm;
nz := nz - fffz/fffnorm;
}
};
nnorm := sqrt(nx^2+ny^2+nz^2);
if vernum > 1 then printf ",";
printf "<%f,%f,%f>,<%f,%f,%f>",
ff.vertex[vernum].x,ff.vertex[vernum].y,ff.vertex[vernum].z,
nx/nnorm,ny/nnorm,nz/nnorm;
vernum := vernum + 1;
};
printf " texture {";
if ( ff.color == white ) then printf " t_white "
else if ( ff.color == black ) then printf " t_black "
else if ( ff.color == blue) then printf " t_blue "
else if ( ff.color == green ) then printf " t_green "
else if ( ff.color == cyan ) then printf " t_cyan "
else if ( ff.color == red ) then printf " t_red "
else if ( ff.color == magenta ) then printf " t_magenta "
else if ( ff.color == brown ) then printf " t_brown "
else if ( ff.color == lightgray ) then printf " t_lightgray "
else if ( ff.color == darkgray ) then printf " t_darkgray "
else if ( ff.color == lightblue ) then printf " t_lightblue "
else if ( ff.color == lightgreen ) then printf " t_lightgreen "
else if ( ff.color == lightcyan ) then printf " t_lightcyan "
else if ( ff.color == lightred ) then printf " t_lightred "
else if ( ff.color == lightmagenta ) then printf " t_lightmagenta "
else if ( ff.color == yellow ) then printf " t_yellow ";
printf " } }\n";
};
printf " } // end of mesh object\n";
// Do desired edges
printf "#declare edge_radius = %f;\n",edge_radius;
foreach edge ee where ee.show do
{ printf "cylinder { <%f,%f,%f>,<%f,%f,%f> edge_radius texture { t_black } }\n",
ee.vertex[1].x,ee.vertex[1].y,ee.vertex[1].z,
ee.vertex[2].x,ee.vertex[2].y,ee.vertex[2].z;
};
// Windup
printf "// overall viewing transformation\n";
printf " matrix < %f,%f,%f,\n",
view_matrix[1][1],view_matrix[2][1],view_matrix[3][1];
printf " %f,%f,%f,\n",
view_matrix[1][2],view_matrix[2][2],view_matrix[3][2];
printf " %f,%f,%f,\n",
view_matrix[1][3],view_matrix[2][3],view_matrix[3][3];
printf " %f,%f,%f>\n",
view_matrix[1][4],view_matrix[2][4],view_matrix[3][4];
printf " } // end of all objects\n";
}
evolver-2.30c.dfsg/fe/cmccousin.cmd 0000755 0001753 0001753 00000034312 11410765113 017476 0 ustar hazelsct hazelsct // CMCcousin.cmd
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// A constant mean curvature surface in R^3 has a "cousin" minimal
// surface in S^3, which is isometric to it and has tangent planes
// rotated by 90 degrees. In S^3, the translation is done through
// the quaternion group.
// This representation uses the 4th coordinate as the quaternion
// scalar component, for better mapping between R^3 and S^3 at quaternion unit.
// Datafiles should be set up in 4 dimensions, with S^3 implemented as
// level set constraint x^2 + y^2 + z^2 + w^2 = 1
// Works best if starting edge starte is toward the center of the surface
// rather than on the outside.
// Procedures contained in this file:
// s3_to_r3: Converts minimal surface in S^3 to CMC 1 surface in R^3.
// Remove all constraints and boundaries before invoking.
// r3_to_s3: Converts CMC 1 surface in R^3 to minimal surface in S^3.
// Remove all constraints and boundaries before invoking.
// procedure centralize(integer v_id): translates S^3 so given vertex
// is at (0,0,0,1).
// For converting to adjoint
define vertex attribute newx real [4];
define edge attribute eflag integer;
define edge attribute enewx real [4];
// Angle of Bonnet rotation, degrees
bangle := 90
// unit normal of S^3 facet
define s3points real[3][4] // input
define s3normal real[4] // for return
calc_s3_normal := {
// triple product in R^4
s3normal[1] := s3points[1][2]*(s3points[2][3]*s3points[3][4]
- s3points[2][4]*s3points[3][3])
+ s3points[1][3]*(s3points[2][4]*s3points[3][2]
- s3points[2][2]*s3points[3][4])
+ s3points[1][4]*(s3points[2][2]*s3points[3][3]
- s3points[2][3]*s3points[3][2]);
s3normal[2] := -(s3points[1][1]*(s3points[2][3]*s3points[3][4]
- s3points[2][4]*s3points[3][3])
+ s3points[1][3]*(s3points[2][4]*s3points[3][1]
- s3points[2][1]*s3points[3][4])
+ s3points[1][4]*(s3points[2][1]*s3points[3][3]
- s3points[2][3]*s3points[3][1]));
s3normal[3] := s3points[1][1]*(s3points[2][2]*s3points[3][4]
- s3points[2][4]*s3points[3][2])
+ s3points[1][2]*(s3points[2][4]*s3points[3][1]
- s3points[2][1]*s3points[3][4])
+ s3points[1][4]*(s3points[2][1]*s3points[3][2]
- s3points[2][2]*s3points[3][1]);
s3normal[4] := -(s3points[1][1]*(s3points[2][2]*s3points[3][3]
- s3points[2][3]*s3points[3][2])
+ s3points[1][2]*(s3points[2][3]*s3points[3][1]
- s3points[2][1]*s3points[3][3])
+ s3points[1][3]*(s3points[2][1]*s3points[3][2]
- s3points[2][2]*s3points[3][1]));
mag := sqrt(s3normal[1]^2 + s3normal[2]^2 + s3normal[3]^2 + s3normal[4]^2);
for ( inx := 1 ; inx < 4 ; inx += 1 )
s3normal[inx] /= mag;
}
// Swaps conjugate sets of coordinates.
flip := {
foreach vertex vv do
{ tmp := vv.x; vv.x := vv.newx[1]; vv.newx[1] := tmp;
tmp := vv.y; vv.y := vv.newx[2]; vv.newx[2] := tmp;
tmp := vv.z; vv.z := vv.newx[3]; vv.newx[3] := tmp;
tmp := vv.w; vv.w := vv.newx[4]; vv.newx[4] := tmp;
}
}
starte := 0 // user should set starte to set origin of adjoint.
define rn real[3][4];
define emid real[3][4];
calc_s3_to_r3 := {
set edge eflag 0;
if starte == 0 then
foreach edge ee do { starte := ee.id; break; }; // just to get starter
edge[starte].enewx[1] := 0;
edge[starte].enewx[2] := 0;
edge[starte].enewx[3] := 0;
edge[starte].eflag := 1;
bs := sin(bangle*pi/180);
bc := cos(bangle*pi/180);
ecount := 1;
endflag := 0;
loopcount := 1;
while ( !endflag ) do
{ endflag := 1;
foreach facet ff do
{ enum := 1;
while ( enum <= 5 ) do
{ thise := (enum imod 3) + 1;
nexte := ((enum+1) imod 3) + 1;
othere := ((enum+2) imod 3) + 1;
if ( ff.edge[thise].eflag>=loopcount and !ff.edge[nexte].eflag ) then
{ // transform this facet
// normal in S3
for ( inx := 1 ; inx <= 4 ; inx += 1 )
for ( vnx := 1 ; vnx <= 3 ; vnx += 1 )
s3points[vnx][inx] := ff.vertex[vnx].x[inx];
calc_s3_normal;
// edge midpoints in S3
for ( enx := 1 ; enx <= 3 ; enx += 1 )
{ for ( inx := 1 ; inx <= 4 ; inx += 1 )
emid[enx][inx] := avg(ff.edge[enx].vertex,x[inx]);
mag := sqrt(emid[enx][1]^2 + emid[enx][2]^2 + emid[enx][3]^2
+ emid[enx][4]^2);
for ( inx := 1 ; inx <= 4 ; inx += 1 )
emid[enx][inx] /= mag;
// Use inverse quaternion of each edge midpoint to convert
// common normal to R3 normal
rn[enx][1] := emid[enx][4]*s3normal[1] - s3normal[4]*emid[enx][1]
- (emid[enx][2]*s3normal[3] - emid[enx][3]*s3normal[2]);
rn[enx][2] := emid[enx][4]*s3normal[2] - s3normal[4]*emid[enx][2]
- (emid[enx][3]*s3normal[1] - emid[enx][1]*s3normal[3]);
rn[enx][3] := emid[enx][4]*s3normal[3] - s3normal[4]*emid[enx][3]
- (emid[enx][1]*s3normal[2] - emid[enx][2]*s3normal[1]);
};
for ( inx := 1 ; inx <= 3 ; inx += 1 )
ff.edge[nexte].enewx[inx] :=
ff.edge[thise].enewx[inx] + rn[nexte][inx] - rn[thise][inx];
ff.edge[nexte].eflag := loopcount+1;
endflag := 0;
ecount += 1;
};
enum += 1;
}; // end while
};
if !quiet then printf "%g edges done.\n",ecount;
loopcount += 1;
};
set vertex newx[1] 0;
set vertex newx[2] 0;
set vertex newx[3] 0;
foreach facet ff do
{ // extend center facet to original vertex; can't simply average
// midedge vertices around an original vertex since that doesn't
// work for vertices on the boundary.
vva := 1; while ( vva <= 3 ) do
{ vvb := vva==3 ? 1 : vva+1;
vvc := vva==1 ? 3 : vva-1;
kk := 1; while ( kk <= 3 ) do
{
ff.vertex[vva].newx[kk] += ff.edge[vva].enewx[kk]
- ff.edge[vvb].enewx[kk] + ff.edge[vvc].enewx[kk];
kk += 1;
};
vva += 1;
}
};
foreach vertex vv do
{
nbrs := sum(vv.facet, 1);
if ( nbrs != 0 ) then
{ vv.newx[1] /= nbrs;
vv.newx[2] /= nbrs;
vv.newx[3] /= nbrs;
vv.newx[4] := 0;
};
};
} // end calc_s3_to_r3
// try using average normal at edge midpoints
calc_s3_to_r3_a := {
define facet attribute snormal real[4];
define nmid real[4][4];
set edge eflag 0;
if starte == 0 then
foreach edge ee do { starte := ee.id; break; }; // just to get starter
edge[starte].enewx[1] := 0;
edge[starte].enewx[2] := 0;
edge[starte].enewx[3] := 0;
edge[starte].eflag := 1;
foreach facet ff do
{ for ( inx := 1 ; inx <= 4 ; inx += 1 )
for ( vnx := 1 ; vnx <= 3 ; vnx += 1 )
s3points[vnx][inx] := ff.vertex[vnx].x[inx];
calc_s3_normal;
for ( inx := 1 ; inx <= 4 ; inx += 1 )
ff.snormal[inx] := s3normal[inx];
};
bs := sin(bangle*pi/180);
bc := cos(bangle*pi/180);
ecount := 1;
endflag := 0;
loopcount := 1;
while ( !endflag ) do
{ endflag := 1;
foreach facet ff do
{ enum := 1;
while ( enum <= 5 ) do
{ thise := (enum imod 3) + 1;
nexte := ((enum+1) imod 3) + 1;
othere := ((enum+2) imod 3) + 1;
if ( ff.edge[thise].eflag>=loopcount and !ff.edge[nexte].eflag ) then
{ // transform this facet
// edge midpoints in S3
for ( enx := 1 ; enx <= 3 ; enx += 1 )
{ for ( inx := 1 ; inx <= 4 ; inx += 1 )
{ emid[enx][inx] := avg(ff.edge[enx].vertex,x[inx]);
nmid[enx][inx] := avg(ff.edge[enx].facet,snormal[inx]);
};
mag := sqrt(emid[enx][1]^2 + emid[enx][2]^2 + emid[enx][3]^2
+ emid[enx][4]^2);
nmag := sqrt(nmid[enx][1]^2 + nmid[enx][2]^2 + nmid[enx][3]^2
+ nmid[enx][4]^2);
for ( inx := 1 ; inx <= 4 ; inx += 1 )
{ emid[enx][inx] /= mag;
nmid[enx][inx] /= nmag;
};
// Use inverse quaternion of each edge midpoint to convert
// common normal to R3 normal
rn[enx][1] := emid[enx][4]*nmid[enx][1] - nmid[enx][4]*emid[enx][1]
- (emid[enx][2]*nmid[enx][3] - emid[enx][3]*nmid[enx][2]);
rn[enx][2] := emid[enx][4]*nmid[enx][2] - nmid[enx][4]*emid[enx][2]
- (emid[enx][3]*nmid[enx][1] - emid[enx][1]*nmid[enx][3]);
rn[enx][3] := emid[enx][4]*nmid[enx][3] - nmid[enx][4]*emid[enx][3]
- (emid[enx][1]*nmid[enx][2] - emid[enx][2]*nmid[enx][1]);
};
for ( inx := 1 ; inx <= 3 ; inx += 1 )
ff.edge[nexte].enewx[inx] :=
ff.edge[thise].enewx[inx] + rn[nexte][inx] - rn[thise][inx];
ff.edge[nexte].eflag := loopcount+1;
endflag := 0;
ecount += 1;
};
enum += 1;
}; // end while
};
if !quiet then printf "%g edges done.\n",ecount;
loopcount += 1;
};
set vertex newx[1] 0;
set vertex newx[2] 0;
set vertex newx[3] 0;
foreach facet ff do
{ // extend center facet to original vertex; can't simply average
// midedge vertices around an original vertex since that doesn't
// work for vertices on the boundary.
vva := 1; while ( vva <= 3 ) do
{ vvb := vva==3 ? 1 : vva+1;
vvc := vva==1 ? 3 : vva-1;
kk := 1; while ( kk <= 3 ) do
{
ff.vertex[vva].newx[kk] += ff.edge[vva].enewx[kk]
- ff.edge[vvb].enewx[kk] + ff.edge[vvc].enewx[kk];
kk += 1;
};
vva += 1;
}
};
foreach vertex vv do
{
nbrs := sum(vv.facet, 1);
if ( nbrs != 0 ) then
{ vv.newx[1] /= nbrs;
vv.newx[2] /= nbrs;
vv.newx[3] /= nbrs;
vv.newx[4] := 0;
};
};
} // end calc_s3_to_r3
calc_r3_to_s3 := {
set edge eflag 0;
if starte == 0 then
foreach edge ee do { starte := ee.id; break; }; // just to get starter
edge[starte].enewx[1] := 0;
edge[starte].enewx[2] := 0;
edge[starte].enewx[3] := 0;
edge[starte].enewx[4] := 1;
edge[starte].eflag := 1;
bs := sin(bangle*pi/180);
bc := cos(bangle*pi/180);
ecount := 1;
endflag := 0;
loopcount := 1;
while ( !endflag ) do
{ endflag := 1;
foreach facet ff do
{ enum := 1;
while ( enum <= 5 ) do
{ thise := (enum imod 3) + 1;
nexte := ((enum+1) imod 3) + 1;
othere := ((enum+2) imod 3) + 1;
if ( ff.edge[thise].eflag>=loopcount and !ff.edge[nexte].eflag ) then
{ // facet unit normal
nx := ff.x;
ny := ff.y;
nz := ff.z;
norm := sqrt(nx^2+ny^2+nz^2);
nx := nx/norm; ny := ny/norm; nz := nz/norm;
// vector from thise to nexte
vx := -ff.edge[othere].x/2;
vy := -ff.edge[othere].y/2;
vz := -ff.edge[othere].z/2;
// rotate 90 degrees about normal (using cross product)
qx := -(ny*vz - nz*vy);
qy := -(nz*vx - nx*vz);
qz := -(nx*vy - ny*vx);
qw := sqrt(1 - (qx^2 + qy^2 + qz^2));
// quaternion multiplication by position of thise midpoint
tx := ff.edge[thise].enewx[1];
ty := ff.edge[thise].enewx[2];
tz := ff.edge[thise].enewx[3];
tw := ff.edge[thise].enewx[4];
ff.edge[nexte].enewx[1] := tw*qx + qw*tx + (ty*qz - tz*qy);
ff.edge[nexte].enewx[2] := tw*qy + qw*ty + (tz*qx - tx*qz);
ff.edge[nexte].enewx[3] := tw*qz + qw*tz + (tx*qy - ty*qx);
ff.edge[nexte].enewx[4] := tw*qw - (tx*qx + ty*qy + tz*qz);
ff.edge[nexte].eflag := loopcount+1;
endflag := 0;
ecount += 1;
};
enum += 1;
}; // end while
};
if !quiet then printf "%g edges done.\n",ecount;
loopcount += 1;
};
set vertex newx[1] 0;
set vertex newx[2] 0;
set vertex newx[3] 0;
set vertex newx[4] 0;
foreach facet ff do
{ // extend center facet to original vertex; can't simply average
// midedge vertices around an original vertex since that doesn't
// work for vertices on the boundary.
for ( vva := 1; vva <= 3 ; vva += 1 )
{ vvb := vva==3 ? 1 : vva+1;
vvc := vva==1 ? 3 : vva-1;
for ( kk := 1; kk <= 4 ; kk += 1 )
{
ff.vertex[vva].newx[kk] += ff.edge[vva].enewx[kk]
- ff.edge[vvb].enewx[kk] + ff.edge[vvc].enewx[kk];
};
};
};
foreach vertex vv do
{
nbrs := sum(vv.facet, 1);
if ( nbrs != 0 ) then
{ vv.newx[1] /= nbrs;
vv.newx[2] /= nbrs;
vv.newx[3] /= nbrs;
vv.newx[4] /= nbrs;
};
};
} // end calc_r3_to_s3
s3_to_r3 := {
foreach vertex vv do
if vv.__v_constraint_list[1] != 0 then
{ errprintf "s3_to_r3 error: vertex %d is still on a constraint.\n",
vv.id;
return;
};
autodisplay_state := (autodisplay);
autodisplay off;
calc_s3_to_r3;
flip;
if ( autodisplay_state ) then autodisplay;
}
r3_to_s3 := {
foreach vertex vv do
if vv.__v_constraint_list[1] != 0 then
{ errprintf "s3_to_r3 error: vertex %d is still on a constraint.\n",
vv.id;
return;
};
autodisplay_state := (autodisplay);
autodisplay off;
calc_r3_to_s3;
flip;
if ( autodisplay_state ) then autodisplay;
}
// Utility function for translating surface in sphere to get
// desired vertex at identity element (0,0,0,1).
procedure centralize ( integer v_id ) {
ax := vertex[v_id].x;
ay := vertex[v_id].y;
az := vertex[v_id].z;
aw := vertex[v_id].w;
foreach vertex vv do {
vx := vv.x;
vy := vv.y;
vz := vv.z;
vw := vv.w;
vv.x := aw*vx - vw*ax - (ay*vz - az*vy);
vv.y := aw*vy - vw*ay - (az*vx - ax*vz);
vv.z := aw*vz - vw*az - (ax*vy - ay*vx);
vv.w := aw*vw + ax*vx + ay*vy + az*vz;
};
}
evolver-2.30c.dfsg/fe/order.cmd 0000755 0001753 0001753 00000001634 11410765113 016627 0 ustar hazelsct hazelsct // order.cmd
// Evolver command to number string-model vertices consecutively.
// Result is order number in vertex extra attribute 'number'.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: order
define vertex attribute number integer
order := {
local ecount,e_id,first_e,v_id,newv_id,newe_id;
ecount := 0; // for safety
// get starting edge, since can't assume edge[1] exists
foreach edge do { e_id := id; break; };
first_e := e_id;
v_id := edge[e_id].vertex[1].id;
// follow connected edges
do
{ set vertex[v_id] number ecount+1;
foreach edge[e_id].vertex vv do
{ if ( vv.id != v_id ) then
{ newv_id := vv.id;
foreach vv.edge ee do
if ee.id != e_id then newe_id := ee.id
}
};
e_id := newe_id; v_id := newv_id;
ecount := ecount + 1;
} while ( (e_id != first_e) and (ecount <= edge_count) )
}
evolver-2.30c.dfsg/fe/symtest.fe 0000644 0001753 0001753 00000003036 11410765113 017046 0 ustar hazelsct hazelsct // symtest.fe
// test of quotient space mechanism
// same surface as in twointor.fe
// Two Kelvin tetrakaidecahedra in a torus.
SYMMETRY_GROUP "torus" // same name as in quotient.c
vertices
1 0.50 0.00 0.75
2 0.25 0.00 0.50
3 0.00 0.25 0.50
4 0.75 0.00 0.50
5 0.00 0.50 0.75
6 0.50 0.00 0.25
7 0.00 0.75 0.50
8 0.50 0.25 0.00
9 0.25 0.50 0.00
10 0.00 0.50 0.25
11 0.50 0.75 0.00
12 0.75 0.50 0.00
// wrap codes for group elements using scheme in quotient.c
#define XWRAP 1
#define XWRAPNEG 31
#define YWRAP 64
#define YWRAPNEG 31*64
#define ZWRAP 64*64
#define ZWRAPNEG 31*64*64
edges /* with torus wrap symbols */
1 1 2
2 2 3
3 1 4
4 3 5
5 2 6
6 2 7 wrap YWRAPNEG
7 1 8 wrap ZWRAP
8 4 6
9 5 9 wrap ZWRAP
10 3 10
11 3 4 wrap XWRAPNEG
12 6 8
13 6 11 wrap YWRAPNEG
14 7 4 wrap XWRAPNEG+YWRAP
15 8 12
16 9 8
17 9 11
18 10 7
19 11 1 wrap YWRAP+ZWRAPNEG
20 12 5 wrap XWRAP+ZWRAPNEG
21 5 7
22 11 12
23 10 12 wrap XWRAPNEG
24 9 10
faces
1 1 2 4 9 16 -7
2 -2 5 12 -16 24 -10
3 -4 10 18 -21
4 7 15 20 -4 11 -3
5 -1 3 8 -5
6 6 14 -11 -2
7 5 13 -17 24 18 -6
8 -12 13 19 7
9 -16 17 22 -15
10 -10 11 8 12 15 -23
11 -21 9 17 19 1 6
12 -14 -18 23 -22 -13 -8
13 -24 -9 -20 -23
14 -19 22 20 21 14 -3
bodies
1 -1 -2 -3 -4 -5 9 7 11 -9 10 12 5 14 3 // volume 0.500
2 2 -6 -7 8 -10 -12 -11 -13 1 13 -14 6 4 -8 // volume 0.500
evolver-2.30c.dfsg/fe/OCTA.WLF 0000644 0001753 0001753 00000000146 11410765113 016121 0 ustar hazelsct hazelsct 0 0 1
0 0 -1
0.707 0.707 0
-0.707 0.707 0
0.707 -0.707 0
-0.707 -0.707 0
evolver-2.30c.dfsg/fe/slice.cmd 0000755 0001753 0001753 00000003630 11410765113 016611 0 ustar hazelsct hazelsct // slice.cmd --- Calculate length of intersection of plane with surface.
// Does not modify surface.
// plane eq: aa*x + bb*y + cc*z = dd
// output: prints length of slice, and area inside slice.
// Note all area inside slice is counted as positive!
// Try not to slice exactly through vertices!!
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: Set plane coefficients, then do "slice".
// Results: Intersection length printed out, left in variable lensum.
aa := 0; bb := 0; cc := 1; dd := .1; // set these for desired plane
slice := {
local any,xx1,yy1,zz1,xx2,yy2,zz2;
local denom,lambda,zaa,zbb,darea;
local xa,ya,za,xb,yb,zb;
lensum := 0; areasum := 0;
foreach facet ff do
{ any := 0;
foreach ff.edge ee do
{
xx1 := ee.vertex[1].x;
yy1 := ee.vertex[1].y;
zz1 := ee.vertex[1].z;
xx2 := ee.vertex[2].x;
yy2 := ee.vertex[2].y;
zz2 := ee.vertex[2].z;
denom := aa*(xx1-xx2)+bb*(yy1-yy2)+cc*(zz1-zz2);
if ( denom != 0.0 ) then
{
lambda := (dd-aa*xx2-bb*yy2-cc*zz2)/denom;
if ( (lambda >= 0) and (lambda <= 1) ) then
{
xa := xb; ya := yb; za := zb;
xb := lambda*xx1+(1-lambda)*xx2;
yb := lambda*yy1+(1-lambda)*yy2;
zb := lambda*zz1+(1-lambda)*zz2;
any := any+1;
}
}
} ;
if any == 2 then
{
dx := xa-xb; dy := ya-yb; dz := za - zb;
lensum := lensum + sqrt(dx^2+dy^2+dz^2);
zaa := za - dd/cc; zbb := zb - dd/cc;
darea := sqrt((ya*zbb-yb*zaa)^2+(zaa*xb-zbb*xa)^2+(xa*yb-ya*xb)^2);
areasum := areasum + darea/2;
}
};
printf "Circumference: %18.15g Area: %18.15g\n",lensum,areasum;
} // end slice
evolver-2.30c.dfsg/fe/qmound.fe 0000644 0001753 0001753 00000004127 11410765113 016643 0 ustar hazelsct hazelsct // qmound.fe
// Evolver data for drop of prescribed volume sitting on plane with gravity.
// Contact angle with plane can be varied.
// Volume constraint implemented as quantity constraint
PARAMETER angle = 90 // interior angle between plane and surface, degrees
#define T (-cos(angle*pi/180)) // virtual tension of facet on plane
quantity vol fixed = 1 method facet_vector_integral global // is volume
vector_integrand:
q1: 0
q2: 0
q3: z
constraint 1 /* the table top */
formula: x3 = 0
energy: // for contact angle
e1: -T*y
e2: 0
e3: 0
vertices
1 0.0 0.0 0.0 constraint 1 /* 4 vertices on plane */
2 1.0 0.0 0.0 constraint 1
3 1.0 1.0 0.0 constraint 1
4 0.0 1.0 0.0 constraint 1
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
9 2.0 2.0 0.0 fixed /* for table top */
10 2.0 -1.0 0.0 fixed
11 -1.0 -1.0 0.0 fixed
12 -1.0 2.0 0.0 fixed
edges /* given by endpoints and attribute */
1 1 2 constraint 1 /* 4 edges on plane */
2 2 3 constraint 1
3 3 4 constraint 1
4 4 1 constraint 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 5
10 2 6
11 3 7
12 4 8
13 9 10 fixed /* for table top */
14 10 11 fixed
15 11 12 fixed
16 12 9 fixed
faces /* given by oriented edge loop */
1 1 10 -5 -9
2 2 11 -6 -10
3 3 12 -7 -11
4 4 9 -8 -12
5 5 6 7 8
7 13 14 15 16 density 0 fixed /* table top for display */
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 density 1
read
re := {refine edges where on_constraint 1 }
// Typical evolution
gogo := { re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Evolution with 45 degree contact angle
gogo2 := { angle := 45; re; g 5; V;V; r; g 5; V;V; r; g 5; hessian; hessian; }
// Evolution with 90 contact and high gravity
gogo3 := { angle := 90; G 5; re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Evolution with 90 contact and negative gravity, i.e. pendant drop
gogo4 := { angle := 90; G -2; re; g 5; r; g 5; r; g 5; hessian; hessian; }
// Pendant drop falling off ceiling
gogo5 := { angle := 90; G -5; re; g 10; t .1; unset vertex constraint 1; g 3; }
evolver-2.30c.dfsg/fe/tuber.cmd 0000755 0001753 0001753 00000014153 11410765113 016635 0 ustar hazelsct hazelsct // tuber.cmd
// Surface Evolver command to put tubes around certain edges, for more
// reliable display of chosen edges. Note that this procedure does
// modify the current surface, rather than write a datafile.
// Usage: Define the "intube" edge attribute to be 1 for the edges
// you want tubed, and call "tuber" with appropriate parameters, i.e.
// Enter command: set edge intube 0
// Enter command: set edge intube 1 where on_constraint 1
// Enter command: tuber(0.01,4,1)
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
define edge attribute intube integer // set positive if want tube
procedure tuber (real tube_radius, // radius of tube
integer tube_sides, // how many sides on each tube, >= 3
integer tube_caps // 0 for no caps, 1 for cone caps
)
{
local ax,ay,az,bx,by,bz,mag,elength,tailcapv,headcapv,t_angle,vv1,ww1;
local ee1,start_tailcape,start_headcape,prev_tailcape,prev_headcape;
local vstart,wstart,starte,inx,vv2,ww2,ee2,vend,wend,diag,newf;
local tailcape,headcape;
// Some parameter checking
if tube_sides < 3 then tube_sides := 3;
if tube_radius <= 0 then
{ errprintf "tuber: tube_radius is %f; must be positive.\n",tube_radius;
return;
};
// Now the tubes.
foreach edge ee where intube > 0 do
{
// find two orthogonal directions to edge; if possible,
// one along adjacent facet
if ee.valence > 0 then
{ ax := ee.facet[1].x;
ay := ee.facet[1].y;
az := ee.facet[1].z;
}
else
{ if abs(ee.x) < abs(ee.y) and abs(ee.x) < abs(ee.z) then
{ ax := 1; ay := 0; az := 0;}
else if abs(ee.y) < abs(ee.z) then
{ ax := 0; ay := 1; az := 0; }
else
{ ax := 0; ay := 0; az := 1; };
};
bx := ay*ee.z - az*ee.y;
by := az*ee.x - ax*ee.z;
bz := ax*ee.y - ay*ee.x;
ax := by*ee.z - bz*ee.y;
ay := bz*ee.x - bx*ee.z;
az := bx*ee.y - by*ee.x;
// normalize to radius
mag := sqrt(ax^2+ay^2+az^2);
if mag <= 0 then continue;
ax *= tube_radius/mag;
ay *= tube_radius/mag;
az *= tube_radius/mag;
mag := sqrt(bx^2+by^2+bz^2);
if mag <= 0 then continue;
bx *= tube_radius/mag;
by *= tube_radius/mag;
bz *= tube_radius/mag;
// Tube cap tips, if wanted
if tube_caps then
{ elength := ee.length;
tailcapv := new_vertex(ee.vertex[1].x - ee.x/elength*tube_radius,
ee.vertex[1].y - ee.y/elength*tube_radius,
ee.vertex[1].z - ee.z/elength*tube_radius);
headcapv := new_vertex(ee.vertex[1].x + ee.x + ee.x/elength*tube_radius,
ee.vertex[1].y + ee.y + ee.y/elength*tube_radius,
ee.vertex[1].z + ee.z + ee.z/elength*tube_radius);
fix vertex[tailcapv];
fix vertex[headcapv];
};
// Construct tubes
t_angle := 2*pi/tube_sides;
vv1 := new_vertex(ee.vertex[1].x+ax*cos(0*t_angle)+bx*sin(0*t_angle),
ee.vertex[1].y+ay*cos(0*t_angle)+by*sin(0*t_angle),
ee.vertex[1].z+az*cos(0*t_angle)+bz*sin(0*t_angle));
ww1 := new_vertex(ee.vertex[1].x+ee.x+ax*cos(0*t_angle)+bx*sin(0*t_angle),
ee.vertex[1].y+ee.y+ay*cos(0*t_angle)+by*sin(0*t_angle),
ee.vertex[1].z+ee.z+az*cos(0*t_angle)+bz*sin(0*t_angle));
fix vertex[vv1];
fix vertex[ww1];
ee1 := new_edge(vv1,ww1);
edge[ee1].color := ee.color;
if tube_caps then
{ start_tailcape := new_edge(tailcapv,vv1);
start_headcape := new_edge(ww1,headcapv);
edge[start_tailcape].color := ee.color;
edge[start_headcape].color := ee.color;
prev_tailcape := start_tailcape;
prev_headcape := start_headcape;
};
vstart := vv1; wstart := ww1; starte := ee1;
for ( inx := 1 ; inx <= tube_sides ; inx += 1 )
{
if inx == tube_sides then
{ vv2 := vstart; ww2 := wstart; ee2 := starte; }
else
{ vv2 := new_vertex(ee.vertex[1].x+ax*cos(inx*t_angle)+bx*sin(inx*t_angle),
ee.vertex[1].y+ay*cos(inx*t_angle)+by*sin(inx*t_angle),
ee.vertex[1].z+az*cos(inx*t_angle)+bz*sin(inx*t_angle));
ww2 := new_vertex(ee.vertex[1].x+ee.x+ax*cos(inx*t_angle)+bx*sin(inx*t_angle),
ee.vertex[1].y+ee.y+ay*cos(inx*t_angle)+by*sin(inx*t_angle),
ee.vertex[1].z+ee.z+az*cos(inx*t_angle)+bz*sin(inx*t_angle));
ee2 := new_edge(vv2,ww2);
edge[ee2].color := ee.color;
};
vend := new_edge(vv1,vv2);
wend := new_edge(ww1,ww2);
diag := new_edge(vv2,ww1);
edge[vend].color := ee.color;
edge[wend].color := ee.color;
edge[diag].color := ee.color;
set edge[vend] no_refine;
set edge[wend] no_refine;
set edge[diag] no_refine;
fix edge[vend];
fix edge[wend];
fix edge[diag];
newf := new_facet(vend,diag,-ee1);
set facet[newf] color ee.color;
fix facet[newf];
set facet[newf] no_refine;
set facet[newf] tension 0;
newf := new_facet(ee2,-wend,-diag);
set facet[newf] color ee.color;
fix facet[newf];
set facet[newf] no_refine;
set facet[newf] tension 0;
if tube_caps then
{ if inx == tube_sides then
{ tailcape := start_tailcape;
headcape := start_headcape;
}
else
{ tailcape := new_edge(tailcapv,vv2);
headcape := new_edge(ww2,headcapv);
edge[tailcape].color := ee.color;
edge[headcape].color := ee.color;
};
fix edge[tailcape];
fix edge[headcape];
newf := new_facet(tailcape,-vend,-prev_tailcape);
set facet[newf] color ee.color;
fix facet[newf];
set facet[newf] no_refine;
set facet[newf] tension 0;
newf := new_facet(headcape,-prev_headcape,wend);
set facet[newf] color ee.color;
fix facet[newf];
set facet[newf] no_refine;
set facet[newf] tension 0;
prev_tailcape := tailcape;
prev_headcape := headcape;
};
vv1 := vv2; ww1 := ww2; ee1 := ee2;
}
}
} // end tuber()
evolver-2.30c.dfsg/fe/cat.fe 0000644 0001753 0001753 00000004471 11410765113 016111 0 ustar hazelsct hazelsct // cat.fe
// Evolver data for catenoid.
PARAMETER RMAX = 1.5088795 // minimum radius for height
PARAMETER ZMAX = 1.0
boundary 1 parameters 1 // upper ring
x1: RMAX * cos(p1)
x2: RMAX * sin(p1)
x3: ZMAX
boundary 2 parameters 1 // lower ring
x1: RMAX * cos(p1)
x2: RMAX * sin(p1)
x3: -ZMAX
vertices // given in terms of boundary parameter
1 0.00 boundary 1 fixed
2 pi/3 boundary 1 fixed
3 2*pi/3 boundary 1 fixed
4 pi boundary 1 fixed
5 4*pi/3 boundary 1 fixed
6 5*pi/3 boundary 1 fixed
7 0.00 boundary 2 fixed
8 pi/3 boundary 2 fixed
9 2*pi/3 boundary 2 fixed
10 pi boundary 2 fixed
11 4*pi/3 boundary 2 fixed
12 5*pi/3 boundary 2 fixed
edges
1 1 2 boundary 1 fixed
2 2 3 boundary 1 fixed
3 3 4 boundary 1 fixed
4 4 5 boundary 1 fixed
5 5 6 boundary 1 fixed
6 6 1 boundary 1 fixed
7 7 8 boundary 2 fixed
8 8 9 boundary 2 fixed
9 9 10 boundary 2 fixed
10 10 11 boundary 2 fixed
11 11 12 boundary 2 fixed
12 12 7 boundary 2 fixed
13 1 7
14 2 8
15 3 9
16 4 10
17 5 11
18 6 12
faces
1 1 14 -7 -13
2 2 15 -8 -14
3 3 16 -9 -15
4 4 17 -10 -16
5 5 18 -11 -17
6 6 13 -12 -18
read
// Evolution to collapse and pop neck, as in Manual tutorial
gogo := { r; u; g 120; t .05; o; g 5; }
// Demonstrating saddle point due to triangulation arrangement.
// First setting parameters to stable values.
gogo2 := { rmax := 1; zmax := 0.55; recalc;
g; u; r; g 50; // at this point have nearly a saddle point
g 200; // triangulation twists around to lower energy
}
// Faster version of the above using conjugate gradient
gogo3 := { rmax := 1; zmax := 0.55; recalc;
g; u; r; U; g 25; // at this point have nearly a saddle point
g 35;
}
// High accuracy evolution, using higher-order Lagrange elements.
gogo4 := { u; zmax := 0.55; rmax := cosh(zmax); recalc;
r; g 5; hessian;
r; g 5; hessian;
lagrange 2; g 5; hessian;
lagrange 4; g 5; hessian;
lagrange 6; g 5; hessian;
lagrange 8; g 5; hessian;
true_area := 2*pi*(zmax + 0.5*sinh(2*zmax));
printf"Difference from true area: %g\n",total_area - true_area;
}
evolver-2.30c.dfsg/fe/gaussmap.cmd 0000755 0001753 0001753 00000004434 11410765113 017335 0 ustar hazelsct hazelsct // gaussmap.cmd
// Converts each vertex coordinate to unit normal.
// No vertices should be on constraints or fixed.
// Saves original coordinates so "revert" restores original surface.
// Before running "gaussmap", vertices should be freed from all
// constraints and boundaries.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: gaussmap
define vertex attribute gaussx real[3]
define vertex attribute oldx real[3]
gaussmap := {
foreach vertex vv do
{ local connum;
connum := 1;
do { unset vv constraint connum; connum += 1; }
while ( connum < 30 );
vv.oldx[1] := vv.x[1];
vv.oldx[2] := vv.x[2];
vv.oldx[3] := vv.x[3];
vv.gaussx[1] := vv.vertexnormal[1];
vv.gaussx[2] := vv.vertexnormal[2];
vv.gaussx[3] := vv.vertexnormal[3];
};
set vertex x gaussx[1];
set vertex y gaussx[2];
set vertex z gaussx[3];
}
revert := {
set vertex x oldx[1];
set vertex y oldx[2];
set vertex z oldx[3];
}
// Command to find spherical area of gauss map, Lagrange model
calc_gaussarea := {
local jnx, jnxx;
if quadratic then lagrange 2;
gaussarea := 0;
jnx := 2;
jnxx := 3;
foreach facet ff do
{ local angle_a, angle_b, angle_c;
angle_a := asin(sqrt(
(ff.vertex[1].vertexnormal[1]-ff.vertex[jnx].vertexnormal[1])^2
+(ff.vertex[1].vertexnormal[2]-ff.vertex[jnx].vertexnormal[2])^2
+(ff.vertex[1].vertexnormal[3]-ff.vertex[jnx].vertexnormal[3])^2)/2);
angle_b := asin(sqrt(
(ff.vertex[jnxx].vertexnormal[1]-ff.vertex[jnx].vertexnormal[1])^2
+(ff.vertex[jnxx].vertexnormal[2]-ff.vertex[jnx].vertexnormal[2])^2
+(ff.vertex[jnxx].vertexnormal[3]-ff.vertex[jnx].vertexnormal[3])^2)/2);
angle_c := asin(sqrt(
(ff.vertex[jnxx].vertexnormal[1]-ff.vertex[1].vertexnormal[1])^2
+(ff.vertex[jnxx].vertexnormal[2]-ff.vertex[1].vertexnormal[2])^2
+(ff.vertex[jnxx].vertexnormal[3]-ff.vertex[1].vertexnormal[3])^2)/2);
gaussarea += 4*atan(sqrt(tan((angle_a+angle_b+angle_c)/2)
*tan((angle_a+angle_b-angle_c)/2)
*tan((angle_a-angle_b+angle_c)/2)
*tan((-angle_a+angle_b+angle_c)/2)));
};
printf "Gauss map area: %18.15f or %18.15f*pi\n",gaussarea,gaussarea/pi;
}
evolver-2.30c.dfsg/fe/quad.fe 0000644 0001753 0001753 00000000455 11410765113 016272 0 ustar hazelsct hazelsct // quad.fe
// simple skew quadrilateral
vertices
1 0 0 1 fixed
2 2 0 0 fixed
3 2 2 1 fixed
4 0 2 0 fixed
edges
1 1 2 fixed
2 2 3 fixed
3 3 4 fixed
4 4 1 fixed
faces
1 1 2 3 4
read
// Typical evolution
gogo := { r; g 5; r; g 5; r; g 5; hessian; hessian; }
evolver-2.30c.dfsg/fe/equi.cmd 0000755 0001753 0001753 00000001603 11410765113 016453 0 ustar hazelsct hazelsct // equi.cmd -- to color edges green subject to equiangulation
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: showequi
showequi := {
local ecount, al, nn, cl, dl, el, bl;
ecount := 0;
foreach edge ee do
{ al := ee.length;
nn := 1;
foreach ee.facet ff do
{ foreach ff.edge fe do
{ if ( fe.id != ee.id ) then
{ if ( nn == 1 ) then bl := fe.length
else if ( nn == 2 ) then cl := fe.length
else if ( nn == 3 ) then dl := fe.length
else if ( nn == 4 ) then el := fe.length;
nn := nn + 1;
}
}
};
if ( nn == 5 ) then
if (bl^2+cl^2-al^2)/bl/cl + (dl^2+el^2-al^2)/dl/el < -1e-5 then
{ set ee color green;
ecount := 1 + ecount
}
};
printf "Found %g edges.\n",ecount;
show_expr edges where 1
}
evolver-2.30c.dfsg/fe/slidestr.fe 0000644 0001753 0001753 00000003245 11410765113 017171 0 ustar hazelsct hazelsct // slidestr.fe
// Evolver data for drop of prescribed volume sitting
// on hyperbolic slide with gravity. Illustrates corner
// holding drop against gravity.
// Instructions for simple use:
// refine once
// iterate until drop settles into curve (datafile starts with
// gravity = 1 to pull drop down)
// Use `G' command to reverse gravity. Blob is stable up to
// about G = -.8
//
// You can color the blob edges with
// set edge color white where not fixed
STRING // one-dimensional surface
space_dimension 2
// Constraint of form m*x + x*y = k with m = 0.5, k = 0.1
// Integrals are used for volume, since zero density facets
// don't move, and their stretching around the curve gives
// an inaccurate volume.
PARAMETER STEEP = 0.5
PARAMETER SHARP = 0.1
constraint 1 // the slide, constants are steepness and sharpness
formula: STEEP*x + x*y = SHARP
content:
c1: log(x)*SHARP - STEEP*x // note this is indefinite integral of y
constraint 2 // the slide, for display
formula: STEEP*x + x*y = SHARP
vertices
1 0.0 2.2 constraint 1
2 0.0 0.8 constraint 1
3 0.5 2.2
4 0.5 0.8
5 0.0 2.5 constraint 2 fixed // for slide display
6 0.3 0.2 constraint 2 fixed // for slide display
7 1.5 .0 constraint 2 fixed // for slide display
edges /* given by endpoints and attribute */
1 2 4
2 4 3
3 3 1
4 5 6 fixed constraint 2 // for slide display
5 6 7 fixed constraint 2 // for slide display
faces /* given by oriented edge loop */
1 1 2 3
bodies /* one body, defined by its oriented faces */
1 1 volume 0.7 density 1.0
read
// Typical evolution, doing V's to keep vertices spread.
gogo := { r; {g 10; V;} 40 }
evolver-2.30c.dfsg/fe/jvx.cmd 0000755 0001753 0001753 00000020267 11410765113 016326 0 ustar hazelsct hazelsct // jvx.cmd
// Create jvx file for JavaView
// Usage: jvx >>> "filename.jvx"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
define vertex attribute jvx_number integer; // for implicit vertex order
define facet attribute fjvxnum integer; // for implicit facet order
define facetcolorcount integer[16]; // to see which color facets are present
define edgecolorcount integer[16]; // to see which color edges are present
define rgb integer[16][3]; // color definitions
rgb[1][1] := 0; rgb[1][2] := 0; rgb[1][3] := 0;
rgb[2][1] := 0; rgb[2][2] := 0; rgb[2][3] := 255;
rgb[3][1] := 0; rgb[3][2] := 255; rgb[3][3] := 0;
rgb[4][1] := 0; rgb[4][2] := 255; rgb[4][3] := 255;
rgb[5][1] := 255; rgb[5][2] := 0; rgb[5][3] := 0;
rgb[6][1] := 255; rgb[6][2] := 0; rgb[6][3] := 255;
rgb[7][1] := 255; rgb[7][2] := 127; rgb[7][3] := 0;
rgb[8][1] := 160; rgb[8][2] := 160; rgb[8][3] := 160;
rgb[9][1] := 80; rgb[9][2] := 80; rgb[9][3] := 80;
rgb[10][1] := 80; rgb[10][2] := 200; rgb[10][3] := 255;
rgb[11][1] := 127; rgb[11][2] := 255; rgb[11][3] := 127;
rgb[12][1] := 127; rgb[12][2] := 255; rgb[12][3] := 255;
rgb[13][1] := 255; rgb[13][2] := 127; rgb[13][3] := 127;
rgb[14][1] := 255; rgb[13][2] := 127; rgb[13][3] := 255;
rgb[15][1] := 255; rgb[15][2] := 255; rgb[15][3] := 0;
rgb[16][1] := 255; rgb[16][2] := 255; rgb[16][3] := 255;
jvx := {
// First, bounding box.
maxx := max(vertex,x); minx := min(vertex,x);
maxy := max(vertex,y); miny := min(vertex,y);
maxz := max(vertex,z); minz := min(vertex,z);
printf "\n";
printf "\n";
printf "\n";
// printf "\n",date_and_time;
printf " %s \n",datafilename;
printf "1.0\n";
/*
printf "\n";
printf " \n";
printf " Kenneth\n";
printf " Brakke\n";
printf " \n";
printf " Susquehanna University\n";
printf " \n";
printf " Mathematics Department\n";
printf " Susquehanna University\n";
printf " Selinsgrove, PA 17870\n";
printf " USA\n";
printf " \n";
printf " \n";
printf " brakke@susqu.edu\n";
printf " http://www.susqu.edu/brakke\n";
printf " \n";
printf "\n";
printf "\n";
printf " One-line description of surface.\n";
printf " \n";
printf " Paragraph of description here.\n";
printf " \n";
printf " \n";
printf " minimal surface\n";
printf " \n";
printf " \n";
printf " 49Q20\n";
printf " optional \n";
printf " optional \n";
printf " \n";
printf " Surface Evolver 2.16\n";
printf "\n";
*/
printf "\n";
printf " \n";
printf " \n";
printf " \n",vertex_count;
jvxnum := 0;
foreach vertex vv do
{ printf " %f %f %f
\n",vv.x,vv.y,vv.z;
vv.jvx_number := jvxnum;
jvxnum += 1;
};
printf " \n";
printf " \n";
facetnum := 0;
foreach facet ff where ff.show and color != clear do
{ ff.fjvxnum := facetnum; facetnum += 1; };
colornum := 1;
while colornum <= 16 do { facetcolorcount[colornum] := 0; colornum += 1; };
foreach facet ff where ff.show and color != clear do
facetcolorcount[ff.color+1] += 1;
colornum := 1; numcolors := 0;
while colornum <= 16 do
{ if facetcolorcount[colornum] > 0 then numcolors += 1; colornum += 1; };
if numcolors > 1 then
printf " \n"
else printf " \n";
printf " \n",sum(facets,show);
foreach facet ff where ff.show and color != clear do
{ printf " %d %d %d \n",ff.vertex[1].jvx_number,
ff.vertex[2].jvx_number, ff.vertex[3].jvx_number;
};
if numcolors <= 1 then
{ colornum := 1;
while colornum <= 16 do
{ if facetcolorcount[colornum] > 0 then
printf " %d %d %d \n",rgb[colornum][1],
rgb[colornum][2],rgb[colornum][3];
colornum += 1;
};
};
printf " \n";
if numcolors > 1 then
{
printf " \n";
foreach facet ff where ff.show and color != clear do
{ printf " %d %d %d \n",rgb[ff.color+1][1],
rgb[ff.color+1][2],rgb[ff.color+1][3];
};
printf " \n";
};
printf " \n",sum(facets,show);
foreach facet ff where ff.show and color != clear do
printf " %d %d %d \n",
ff.edge[2].valence == 2 ?
max(ff.edge[2].facet where id != ff.id,fjvxnum) : -1,
ff.edge[3].valence == 2 ?
max(ff.edge[3].facet where id != ff.id,fjvxnum) : -1,
ff.edge[1].valence == 2 ?
max(ff.edge[1].facet where id != ff.id,fjvxnum) : -1;
printf " \n";
// printf " \n",sum(edges,show);
// foreach edge ee where ee.show do
// { printf " %d %d \n",ee.vertex[1].jvx_number,
// ee.vertex[2].jvx_number;
// };
// printf " 0 0 0 \n";
// printf " \n";
printf " \n";
printf " 1.0 \n";
printf " 0 0 0\n";
printf " \n";
printf " \n";
printf " \n";
printf " %f %f %f
\n",minx,miny,minz;
printf " %f %f %f
\n",maxx,maxy,maxz;
printf " \n";
printf " \n";
printf " %f %f %f
\n",(maxx+minx)/2,(maxy+miny)/2,
(maxz+minz)/2;
printf " \n";
printf " \n";
colornum := 1;
while colornum <= 16 do { edgecolorcount[colornum] := 0; colornum += 1; };
foreach edge ee where ee.show do
edgecolorcount[ee.color+1] += 1;
colornum := 1; numcolors := 0;
while colornum <= 16 do
{ if edgecolorcount[colornum] > 0 then numcolors += 1; colornum += 1; };
printf " \n";
printf " \n";
printf " \n",2*sum(edges,show);
foreach edge ee where ee.show do
{ printf " %f %f %f
\n",ee.vertex[1].x,ee.vertex[1].y,ee.vertex[1].z;
printf " %f %f %f
\n",ee.vertex[2].x,ee.vertex[2].y,ee.vertex[2].z;
};
printf " \n";
printf " \n";
if numcolors > 1 then
printf " \n"
else printf " \n";
printf " \n",sum(edges,show);
jvxnum := 0;
foreach edge ee where ee.show do
{ printf " %d %d \n",jvxnum,jvxnum+1;
jvxnum += 2;
};
printf " 2 \n";
if numcolors <= 1 then
{ colornum := 1;
while colornum <= 16 do
{ if edgecolorcount[colornum] > 0 then
printf " %d %d %d \n",rgb[colornum][1],
rgb[colornum][2],rgb[colornum][3];
colornum += 1;
};
};
printf " \n";
if ( numcolors > 1 ) then
{
printf " \n";
foreach edge ee where ee.show do
{ printf " %d %d %d \n", rgb[ee.color+1][1],
rgb[ee.color+1][2],rgb[ee.color+1][3];
};
printf " \n";
};
printf " \n";
printf " \n";
printf " %f %f %f
\n",minx,miny,minz;
printf " %f %f %f
\n",maxx,maxy,maxz;
printf " \n";
printf " \n";
printf " %f %f %f
\n",(maxx+minx)/2,(maxy+miny)/2,
(maxz+minz)/2;
printf " \n";
printf " \n";
printf "\n";
printf "\n";
}
evolver-2.30c.dfsg/fe/gzipdump.cmd 0000755 0001753 0001753 00000002041 11410765113 017344 0 ustar hazelsct hazelsct // gzipdump.cmd
// Evolver command for dumping datafile directly to gzip form
// Needs Evolver version 1.99e or later.
// Usage: gzipdump
// As is, this will dump to a gzipped file with a default name.
// You may change the filename in the command below to your own liking.
// gzipped file may be reloaded directly with shell command like
// /etc/mknod epipe p; ((gunzip epipe;rm epipe)& evolver epipe)
// I suggest defining a csh alias like
// alias gzev '/etc/mknod epipe p;((gzip -d < \!$ >epipe;rm epipe)& evolver \!:1- epipe)'
// so you can just do
// gzev cube.dmp.gz
// The alias even works with options, as in
// gzev -q -p2 cube.dmp.gz
dodump := {
list topinfo;
print "\nvertices\n"; list vertices;
print "\nedges\n"; list edges;
print "\nfaces\n"; list facets;
print "\nbodies\n"; list bodies;
list bottominfo
}
gzipdump := {
filename := sprintf "%s.dmp.gz",datafilename;
dumpcmd := sprintf "gzip >%s",filename;
printf "Dumping to %s\n",filename;
dodump | dumpcmd
}
evolver-2.30c.dfsg/fe/vrml.cmd 0000755 0001753 0001753 00000004771 11410765113 016501 0 ustar hazelsct hazelsct // vrml.cmd
// Makes VRML file for surface.
// Usage: Set edge_flag to 1 if you want do see all edges.
// Run "vrml" and re-direct output to file, e.g.
// Enter command: vrml >>> "myfile.wrl";
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
define vertex attribute order_num integer
edge_flag := 0 // 1 for all edges, 0 for special edges only
vrml := {
local counter;
counter := 0;
printf "#VRML V1.0 ascii\n\n";
printf "Separator {\n";
printf " DEF Title Info { string \"%s\" }\n",datafilename;
printf " DEF SceneInfo Info { string \"Created by Surface Evolver\" }\n";
printf " DEF BackgroundColor Info { string \".5 .6 1\" } \n";
printf " DirectionalLight { intensity .5 direction 0 0 -1 } \n";
printf " MaterialBinding { value PER_FACE_INDEXED }\n";
printf " Material { \n";
printf " diffuseColor [ 0.0 0.0 0.0 , 0.0 0.0 0.5 ,\n";
printf " 0.0 0.5 0.0 , 0.0 0.5 0.5 , 0.5 0.0 0.0 , 0.5 0.0 0.5 ,\n";
printf " 0.5 0.25 0. , .3 .3 .3 , .15 .15 .15 , .25 .25 .5 , .25 .5 .25 ,\n";
printf " .25 .5 .5 , .5 .25 .25 , .5 .25 .5 , .5 .5 .0 , .5 .5 .5 ] \n";
printf " emissiveColor [ 0.0 0.0 0.0 , 0.0 0.0 0.5 ,\n";
printf " 0.0 0.5 0.0 , 0.0 0.5 0.5 , 0.5 0.0 0.0 , 0.5 0.0 0.5 ,\n";
printf " 0.5 0.25 0. , .3 .3 .3 , .15 .15 .15 , .25 .25 .5 , .25 .5 .25 ,\n";
printf " .25 .5 .5 , .5 .25 .25 , .5 .25 .5 , .5 .5 .0 , .5 .5 .5 ] \n";
printf " }\n";
printf " Separator {\n";
printf " Coordinate3 { point [\n";
foreach vertex jvv do { printf " %f %f %f,\n",jvv.x,jvv.y,jvv.z;
set jvv order_num counter; counter := counter + 1; };
printf " ]\n }\n";
printf " IndexedFaceSet { coordIndex [\n";
foreach facet jff do printf " %g,%g,%g,-1,\n",
jff.vertex[1].order_num,jff.vertex[2].order_num,jff.vertex[3].order_num;
printf " ] \n";
printf " materialIndex [\n";
foreach facet jff do printf " %g,\n",jff.color;
printf " ]\n";
printf " }\n";
printf " Material { ambientColor 0 0 0 diffuseColor 0 0 0 }\n";
printf " IndexedLineSet { coordIndex [\n";
if edge_flag then
foreach edge jee do printf " %g,%g,-1,\n",
jee.vertex[1].order_num,jee.vertex[2].order_num
else foreach edge jee where valence != 2 do printf " %g,%g,-1,\n",
jee.vertex[1].order_num,jee.vertex[2].order_num;
printf " ] } \n";
printf " }\n";
printf "}\n";
} // end vrml
evolver-2.30c.dfsg/fe/phelanc.fe 0000644 0001753 0001753 00000017306 11410765113 016755 0 ustar hazelsct hazelsct // phelanc.fe
// Structure that beats Kelvin's partition of space.
// In 1887, Lord Kelvin posed the problem of finding the partition
// of space into equal volume cells minimizing the interface area.
// He suggested the cell shown in twointor.fe, which is basically
// the voronoi cell for a bcc lattice. Now Robert Phelan and Denis
// Weaire of Trinity College, Dublin, have found a structure using
// two types of cells that has 0.3% less area than Kelvin's. This is
// their Evolver datafile. There are 8 cells in a
// cubic 2x2x2 flat torus, which start as Voronoi cells on centers
//
// 0 0 0
// 1 1 1
// 0.5 0 1
// 1.5 0 1
// 0 1 0.5
// 0 1 1.5
// 1 0.5 0
// 1 1.5 0
// Just evolve to get the volumes all to 1, and Kelvin is beat.
// With more evolution, the ratio V^2/A^3 beats Kelvin by a
// whopping 1%. The Weaire-Phelan structure has its tetrakaidecahedra
// stacked on their hexagonal faces in three sets of perpendicular,
// mutually interlocking columns, with interstices filled by the
// dodecahedra.
// phelanc.fe with colored bodies
TORUS_FILLED
periods
2.000000 0.000000 0.000000
0.000000 2.000000 0.000000
0.000000 0.000000 2.000000
view_transform_generators 6
1 0 0 2
0 1 0 0
0 0 1 0
0 0 0 1
1 0 0 0
0 1 0 2
0 0 1 0
0 0 0 1
1 0 0 0
0 1 0 0
0 0 1 2
0 0 0 1
1 0 0 -2
0 1 0 0
0 0 1 0
0 0 0 1
1 0 0 0
0 1 0 -2
0 0 1 0
0 0 0 1
1 0 0 0
0 1 0 0
0 0 1 -2
0 0 0 1
vertices
1 1.374833 0.000542 0.313036
2 1.582639 1.583805 0.417091
3 1.999414 1.687884 0.625562
4 0.999778 0.000517 0.500564
5 1.686693 1.374893 1.999381
6 1.999036 0.312928 0.625224
7 0.416118 1.583554 0.417247
8 1.416641 1.417638 0.583002
9 0.999380 1.626008 0.687643
10 1.374528 0.000836 1.688167
11 1.582887 1.582882 1.583776
12 1.583228 0.416633 0.417188
13 0.415660 0.417170 0.416774
14 0.312152 1.375055 0.000199
15 1.999782 1.500468 1.000033
16 1.625132 1.312811 1.000465
17 1.312290 1.000953 0.374434
18 0.999015 1.625244 1.312907
19 0.582337 1.417418 0.583502
20 0.999205 0.000988 1.500509
21 1.582954 0.417290 1.583964
22 1.499589 1.000835 1.999244
23 1.687315 0.625137 1.999668
24 0.624322 0.000725 0.312769
25 0.416475 1.583942 1.583184
26 0.374830 1.313082 0.999521
27 1.624817 0.687664 1.000333
28 0.686621 1.000835 0.374834
29 1.416503 1.416444 1.417442
30 0.624634 0.000964 1.687531
31 1.999937 1.687755 1.375079
32 1.312386 1.000647 1.625031
33 0.499725 1.000658 0.000553
34 0.311830 0.624975 0.000488
35 0.375186 0.688291 0.999389
36 1.416715 0.583171 0.583818
37 0.582556 0.584101 0.583805
38 0.583642 1.417297 1.416440
39 1.999485 0.312616 1.375471
40 0.416489 0.416552 1.584015
41 1.999161 0.500331 0.999822
42 0.999925 0.375397 0.688204
43 0.688262 1.000529 1.624602
44 1.416155 0.584231 1.417123
45 0.584307 0.583998 1.416583
46 0.999499 0.376190 1.313024
edges
1 1 2 * - *
2 2 3 * * *
3 1 4 * * *
4 2 5 * * -
5 3 6 * + *
6 3 7 + * *
7 2 8 * * *
8 4 9 * - *
9 1 10 * * -
10 5 11 * * *
11 6 12 * * *
12 6 13 + * *
13 7 14 * * *
14 3 15 * * *
15 8 16 * * *
16 8 17 * * *
17 9 8 * * *
18 9 18 * * *
19 9 19 * * *
20 10 20 * * *
21 10 21 * * *
22 11 10 * + *
23 5 22 * * *
24 5 14 + * +
25 12 1 * * *
26 12 23 * * -
27 13 24 * * *
28 7 19 * * *
29 14 25 * * -
30 15 26 + * *
31 16 15 * * *
32 16 27 * * *
33 17 22 * * -
34 17 28 * * *
35 18 29 * * *
36 19 26 * * *
37 20 30 * * *
38 21 23 * * *
39 11 31 * * *
40 11 29 * * *
41 22 32 * * *
42 14 33 * * *
43 23 34 + * +
44 24 7 * - *
45 24 30 * * -
46 19 28 * * *
47 25 30 * + *
48 25 31 - * *
49 26 35 * * *
50 16 29 * * *
51 27 36 * * *
52 17 36 * * *
53 28 33 * * *
54 28 37 * * *
55 18 38 * * *
56 29 32 * * *
57 26 38 * * *
58 20 18 * - *
59 31 39 * + *
60 22 23 * * *
61 33 34 * * *
62 34 13 * * *
63 34 40 * * -
64 30 40 * * *
65 35 41 - * *
66 35 37 * * *
67 36 12 * * *
68 36 42 * * *
69 33 43 * * -
70 37 42 * * *
71 37 13 * * *
72 38 25 * * *
73 32 43 * * *
74 32 44 * * *
75 24 4 * * *
76 35 45 * * *
77 21 39 * * *
78 39 40 + * *
79 41 27 * * *
80 42 46 * * *
81 43 38 * * *
82 42 4 * * *
83 44 27 * * *
84 44 46 * * *
85 15 31 * * *
86 45 43 * * *
87 45 46 * * *
88 41 39 * * *
89 21 44 * * *
90 6 41 * * *
91 46 20 * * *
92 45 40 * * *
faces
1 1 2 5 11 25 color 1 backcolor 4
2 -1 3 8 17 -7 color 8 backcolor 4
3 2 6 13 -24 -4 color 5 backcolor 1
4 5 12 27 44 -6 color 3 backcolor 1
5 11 26 43 62 -12 color 5 backcolor 1
6 1 4 10 22 -9 color 8 backcolor 1
7 17 16 34 -46 -19 color 2 backcolor 8
8 7 16 33 -23 -4 color 8 backcolor 5
9 -2 7 15 31 -14 color 5 backcolor 4
10 -6 14 30 -36 -28 color 5 backcolor 3
11 -13 28 46 53 -42 color 5 backcolor 8
12 24 29 48 -39 -10 color 6 backcolor 1
13 44 13 29 47 -45 color 1 backcolor 8
14 62 27 45 64 -63 color 1 backcolor 7
15 25 9 21 38 -26 color 7 backcolor 1
16 -3 9 20 37 -45 75 color 8 backcolor 7
17 -10 23 41 -56 -40 color 8 backcolor 6
18 -22 39 59 -77 -21 color 4 backcolor 1
19 8 19 -28 -44 75 color 3 backcolor 8
20 -18 19 36 57 -55 color 2 backcolor 3
21 -17 18 35 -50 -15 color 2 backcolor 4
22 34 53 69 -73 -41 -33 color 8 backcolor 7
23 -46 36 49 66 -54 color 5 backcolor 2
24 -16 15 32 51 -52 color 2 backcolor 5
25 31 30 49 65 79 -32 color 6 backcolor 5
26 -53 54 71 -62 -61 color 5 backcolor 7
27 42 61 -43 -60 -23 24 color 5 backcolor 6
28 48 59 78 -64 -47 color 1 backcolor 3
29 43 63 -78 -77 38 color 1 backcolor 6
30 -41 60 -38 89 -74 color 7 backcolor 6
31 -56 -35 55 -81 -73 color 2 backcolor 8
32 40 -35 -58 -20 -22 color 8 backcolor 4
33 -57 -30 85 -48 -72 color 6 backcolor 3
34 50 56 74 83 -32 color 2 backcolor 6
35 34 54 70 -68 -52 color 7 backcolor 2
36 69 81 72 -29 42 color 6 backcolor 8
37 -33 52 67 26 -60 color 7 backcolor 5
38 49 76 86 81 -57 color 2 backcolor 6
39 66 71 -12 90 -65 color 3 backcolor 5
40 51 67 -11 90 79 color 5 backcolor 4
41 -37 58 55 72 47 color 8 backcolor 3
42 -89 -21 20 -91 -84 color 7 backcolor 4
43 74 84 -87 86 -73 color 7 backcolor 2
44 83 51 68 80 -84 color 4 backcolor 2
45 70 82 -75 -27 -71 color 3 backcolor 7
46 -68 67 25 3 -82 color 4 backcolor 7
47 -69 61 63 -92 86 color 6 backcolor 7
48 -76 65 88 78 -92 color 3 backcolor 6
49 -66 76 87 -80 -70 color 3 backcolor 2
50 90 88 -59 -85 -14 5 color 4 backcolor 3
51 79 -83 -89 77 -88 color 4 backcolor 6
52 -91 -87 92 -64 -37 color 3 backcolor 7
53 -85 -31 50 -40 39 color 6 backcolor 4
54 -82 80 91 58 -18 -8 color 3 backcolor 4
bodies
1 1 -3 -4 -5 -6 -12 13 14 -15 -18 28 29 volume 0.976527
2 7 20 21 -23 24 31 34 -35 38 -43 -44 -49 volume 0.976538
3 39 45 48 49 -50 4 54 -28 52 -33 19 -20 -41 -10 volume 1.007698
4 -40 44 46 50 51 -1 -42 -54 -53 -9 18 -2 -32 -21 volume 1.007902
5 3 -8 9 10 11 -24 -25 23 26 27 -37 40 -39 5 volume 1.007528
6 33 -38 25 12 36 -48 53 -51 -34 -27 47 -17 -30 -29 volume 1.008217
7 -22 30 35 -26 37 42 43 -45 -46 -47 15 -52 -16 -14 volume 1.008071
8 2 6 -7 8 16 17 -19 22 -31 32 -36 -11 41 -13 volume 1.007564
read
set body target 1
column_color := { /* colors bodies alike that are in same columns */
set facet frontcolor green where frontcolor==blue;
set facet backcolor green where backcolor==blue;
set facet frontcolor red where frontcolor==cyan;
set facet backcolor red where backcolor==cyan;
set facet frontcolor lightgray where frontcolor==darkgray;
set facet backcolor lightgray where backcolor==darkgray;
set facet frontcolor magenta where frontcolor==brown;
set facet backcolor magenta where backcolor==brown;
}
dodecs:= show facet ff where max(ff.body,id==1 or id==2)
column1:= show facet ff where max(ff.body,id==3 or id==4)
column2:= show facet ff where max(ff.body,id==5 or id==6)
column3:= show facet ff where max(ff.body,id==7 or id==8)
bunch := transform_expr "abc"
lots := transform_expr "abcdef"
few := transforms off
all := show facet
// Typical evolution
gogo := { g 5; r; g 5; hessian; r; g 5; hessian; }
evolver-2.30c.dfsg/fe/iges136.cmd 0000755 0001753 0001753 00000014766 11410765113 016707 0 ustar hazelsct hazelsct // iges136.cmd
// Surface Evolver script to write IGES file for surface, using IGES
// finite element entity (type 136), which handles linear, quadratic,
// and cubic triangles (among many other types not of interest).
// Finite element type not official "geometry"???? Rhino says can't
// find any independent geometry, and http://www.iges5x.org/taxonomy/ has
// FEM types included under "non-geometry taxonomy'.
// Also not listed in Table 3 on p. 38 of IGES-6 documentation.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// usage: iges >>> "filename.igs"
iges := {
// Flag section
// Don't need this since not doing binary or compressed format.
// Start section
start_counter := 0;
start_counter += 1;
printf "%-72sS%07d\n","IGES version of Surface Evolver surface",start_counter;
start_counter += 1;
printf " %-69sS%07d\n",datafilename,start_counter;
start_counter += 1;
printf "%-72sS%07d\n","Created using iges.cmd Evolver script.",
start_counter;
// Global section
global_counter := 0;
global_counter += 1;
printf "%-72sG%07d\n","1H,,1H;,",global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
message := sprintf "%s,",datafilename;
printf "%02dH%-69sG%07d\n",sizeof(datafilename),message,global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Surface Evolver"),"Surface Evolver,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","32,75,6,75,15,,1.0,1,2HIN,32768,0.0394,",
global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000,", global_counter; // date
xmax := max(vertex,abs(x));
ymax := max(vertex,abs(y));
zmax := max(vertex,abs(z));
maxsize := (xmax > ymax) ? xmax : ymax;
maxsize := (zmax > maxsize) ? zmax : maxsize;
message := sprintf "%g,%g,",maxsize/10000000,maxsize;
global_counter += 1;
printf "%-72sG%07d\n",message, global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Name of author"),"Name of author,",
global_counter;
global_counter += 1;
printf "%02dH%-69sG%07d\n",sizeof("Author's organization"),
"Author's organization,", global_counter;
global_counter += 1;
printf "%-72sG%07d\n","15H00000000.000000;", global_counter; // date
// Directory entry section. Each entry 20 8-char fields on two lines.
// Fields with default values
entype := 0; // 1 and 11
paramdata := 0; // 2
structure := 0; // 3
linefont := 0; // 4
level := 0; // 5
view := 0; // 6
transmat := 0; // 7
label := 0; // 8
status := "00000000"; // 9; actually 4 two-digit numbers
directory_counter := 0; // 10 and 20
lineweight := 0; // 12
colornum := 0; // 13
paramcount := 0; // 14
form := 0; // 15
reserved := " "; // 16 and 17
entlabel := "entity"; // 18
entsubscr := 0; // 19
// Vertices as "node" types
entype := 135;
status := "00010401";
paramcount := 1;
entlabel := " VERTEX";
define vertex attribute pdata integer;
define vertex attribute dir integer;
foreach vertex vv do
{ paramdata += 1; vv.pdata := paramdata;
entsubscr := vv.id;
directory_counter += 1; vv.dir := directory_counter;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,colornum,
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
};
// Facets as "finite element" types
entype := 136;
status := "00010001";
paramcount := 1;
entlabel := " FACET";
define facet attribute fpdata integer;
define facet attribute fdir integer;
foreach facet ff do
{ paramdata += 1; ff.fpdata := paramdata;
entsubscr := ff.id;
directory_counter += 1; ff.fdir := directory_counter;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,colornum,
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
};
// Geometry element
entype := 402;
status := "00000301";
paramcount := ceil(facet_count/10);
form := 7;
entlabel := " SURFACE";
paramdata += 1;
entsubscr := 1;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8d%8d%8d%8sD%7d\n",entype,paramdata,structure,
linefont,level,view,transmat,label,status,directory_counter;
directory_counter += 1;
printf "%8d%8d%8d%8d%8d%8s%8s%8s%8dD%7d\n",entype,lineweight,colornum,
paramcount,form,reserved,reserved,entlabel,entsubscr,directory_counter;
// Parameter data section
parameter_counter := 0;
// Vertices
entype := 134;
foreach vertex vv do
{ parameter_counter += 1;
if vv.pdata != parameter_counter then
errprintf
"ERROR: bad vertex parameter line number, vertex %d. Is %d, should be %d.\n",
vv.id,parameter_counter,vv.pdata;
message := sprintf "%d,%13.10f,%13.10f,%13.10f,0;",entype,vv.x,vv.y,vv.z;
printf "%-64s%8dP%7d\n",message,vv.dir,parameter_counter;
};
// Facets
entype := 136;
itop := 2; // Linear TRIAngle
etyp := "5HLTRIA";
numnodes := 3;
foreach facet ff do
{ parameter_counter += 1;
if ff.fpdata != parameter_counter then
errprintf
"ERROR: bad facet parameter line number, facet %d. Is %d, should be %d.\n",
ff.id,parameter_counter,ff.fpdata;
message := sprintf "%d,%d,%d,%d,%d,%d,%s;",entype,itop,numnodes,
ff.vertex[1].dir,ff.vertex[2].dir,ff.vertex[3].dir,etyp;
printf "%-64s%8dP%7d\n",message,ff.fdir,parameter_counter;
};
// Geometry element
line := sprintf "402,%d,",facet_count;
subcount := 0;
foreach facet ff do
{ if subcount == 10 then
{
parameter_counter += 1;
printf "%-64s%8dP%7d\n",line,directory_counter-1,parameter_counter;
line := "" ;
};
line := sprintf"%s%d,",line,ff.fdir;
};
line := sprintf "%s0,0;",line; // sample files ended with 2 extra 0's
parameter_counter += 1;
printf "%-64s%8dP%7d\n",line,directory_counter-1,parameter_counter;
// Terminate section
printf "S%07dG%07dD%07dP%07d%40sT0000001\n",start_counter,global_counter,
directory_counter,parameter_counter," ";
}
evolver-2.30c.dfsg/fe/wavefront.cmd 0000755 0001753 0001753 00000003000 11410765113 017514 0 ustar hazelsct hazelsct // wavefront.cmd
// Surface Evolver command file for producing Wavefront format file
// for surface, suitable for feeding to JavaView.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage:
// wavefront >>> "filename.obj"
// or, for version with normals at vertices,
// wavefrontn >>> "filename.obj"
define vertex attribute v_num integer
wavefront := {
// Make sure vertices consecutively numbered
new_v_num := 1;
foreach vertex vv do { vv.v_num := new_v_num; new_v_num += 1 };
printf "# Wavefront .obj file for %s\n",datafilename;
printf "# Produced by the Surface Evolver.\n\n";
foreach vertex vv do printf "v %f %f %f\n",vv.x,vv.y,vv.z;
printf "\n";
foreach facet ff do printf "f %g %g %g\n",ff.vertex[1].v_num,
ff.vertex[2].v_num, ff.vertex[3].v_num;
}
// version with normals at vertices
wavefrontn := {
// Make sure vertices consecutively numbered
new_v_num := 1;
foreach vertex vv do { vv.v_num := new_v_num; new_v_num += 1 };
printf "# Wavefront .obj file for %s\n",datafilename;
printf "# Produced by the Surface Evolver.\n\n";
foreach vertex vv do printf "v %f %f %f\n",vv.x,vv.y,vv.z;
printf "\n";
foreach vertex vv do printf "vn %f %f %f\n",vv.vertexnormal[1],
vv.vertexnormal[2],vv.vertexnormal[3];
printf "\n";
foreach facet ff do printf "f %g/%g %g/%g %g/%g\n",ff.vertex[1].v_num,
ff.vertex[1].v_num, ff.vertex[2].v_num,
ff.vertex[2].v_num, ff.vertex[3].v_num,
ff.vertex[3].v_num;
}
evolver-2.30c.dfsg/fe/polyfilm.cmd 0000755 0001753 0001753 00000002225 11410765113 017344 0 ustar hazelsct hazelsct // polyfilm.cmd
// command to produce Polycut format file
// usage: polyfilm >>> "filename"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
define vertex attribute offnumber integer;
// command to print OFF format part (the vertices and facets)
verlist := { local offnum;
offnum := 0;
foreach vertex vv do
{ printf "%f %f %f \n",x,y,z;
vv.offnumber := offnum;
offnum += 1;
}
} // end verlist
facelist := { foreach facet ff do
{ printf "3 ";
foreach ff.vertex vv do printf "%g ",vv.offnumber;
printf "\n";
}
} // end facelist
do_off := { printf "OFF\n%g %g %g\n",vertex_count,facet_count,edge_count;
verlist;
facelist
} // end do_off
// vect-like file command for triple lines
traa := { trcount ::= sum(edges where valence==3,1)}
trbb := { foreach edge ee where ee.valence==3 do
{ foreach ee.vertex vv do printf "%f %f %f ",x,y,z ;
printf "\n";
}
}
trips := { printf "TRIPLE\n"; traa; printf "%g\n",trcount; trbb }
polyfilm := {do_off; trips}
evolver-2.30c.dfsg/fe/100grain.fe 0000644 0001753 0001753 00000035154 11410765113 016665 0 ustar hazelsct hazelsct // 2D Voronoi diagram of 100 cells in unit torus.
// With automatic popping and chopping.
// Usage: just load in Evolver and do 'g' steps. You can do them
// in big chunks, say 10000 at a time.
STRING
SPACE_DIMENSION 2
TORUS
PERIODS
1.0 0.0
0.0 1.0
autopop
autochop 0.015000
area_normalization
scale 5e-006 fixed
VERTICES
1 -0.030008 0.140444
2 -0.053561 0.142482
3 -0.053946 0.142913
4 -0.043174 0.262670
5 -0.030826 0.272623
6 -0.002732 0.263058
7 0.030515 0.186263
8 0.229526 0.892844
9 0.197250 0.830725
10 0.164128 0.845516
11 0.155140 0.891287
12 0.175151 0.917947
13 0.013457 0.904425
14 0.019242 0.903750
15 0.099088 0.822584
16 0.099238 0.797112
17 0.038472 0.769136
18 0.345511 0.867172
19 0.316990 0.895976
20 0.302884 0.933134
21 0.305616 0.970797
22 0.502700 0.988511
23 0.513272 0.938981
24 0.467254 0.873503
25 0.358794 0.760227
26 0.421715 0.745342
27 0.447609 0.623441
28 0.386207 0.547841
29 0.379759 0.543637
30 0.327500 0.540091
31 0.301920 0.560712
32 0.038356 0.911818
33 0.074852 0.917690
34 0.109014 0.031672
35 0.082139 0.059863
36 0.116979 0.117814
37 0.169077 0.147739
38 0.249566 0.102936
39 0.265711 0.083110
40 0.263516 0.061681
41 0.157972 0.022724
42 0.668828 0.702216
43 0.657217 0.709184
44 0.648690 0.726695
45 0.639862 0.849299
46 0.671332 0.879221
47 0.795602 0.874217
48 0.825169 0.863559
49 0.822140 0.854479
50 0.051843 0.463089
51 -0.008885 0.547199
52 -0.009018 0.554344
53 0.064609 0.593106
54 0.195952 0.584518
55 0.715969 0.035473
56 0.720991 0.077810
57 0.759825 0.154628
58 0.803906 0.131127
59 0.832758 0.097005
60 0.840144 0.056532
61 0.828317 0.038418
62 0.793569 0.016632
63 0.866798 0.634036
64 0.874315 0.608119
65 0.810168 0.563294
66 0.722718 0.611416
67 0.686430 0.661210
68 0.674258 0.697043
69 0.736065 0.704853
70 0.799285 0.697204
71 0.128274 0.421961
72 0.151241 0.424619
73 0.270736 0.385808
74 0.252679 0.348670
75 0.163426 0.278401
76 0.120465 0.335411
77 0.923424 0.139123
78 0.957650 0.073212
79 0.935431 0.025421
80 0.671668 0.089803
81 0.620645 0.141321
82 0.653768 0.179083
83 0.714382 0.195884
84 0.749149 0.170561
85 0.897672 0.454661
86 0.900534 0.482589
87 1.053106 0.457102
88 1.015103 0.398474
89 0.966433 0.356965
90 0.960711 0.360602
91 0.913244 0.405778
92 0.153045 0.773386
93 0.209507 0.805331
94 0.238979 0.775913
95 0.165918 0.722482
96 0.102759 1.006934
97 0.147549 0.957675
98 0.132490 0.954404
99 0.034313 0.180479
100 0.029867 0.134185
101 0.025138 0.128845
102 0.432624 0.437038
103 0.434238 0.453639
104 0.529974 0.419934
105 0.533843 0.416214
106 0.542179 0.349833
107 0.493588 0.324922
108 0.020543 0.263635
109 0.087614 0.335281
110 0.593847 0.456960
111 0.654644 0.445022
112 0.648907 0.417561
113 0.615874 0.343447
114 0.589189 0.330605
115 1.035042 0.079044
116 0.836275 0.779507
117 0.870909 0.890102
118 0.879339 0.892276
119 0.945582 0.887996
120 0.943789 0.834657
121 0.906471 0.738313
122 0.904679 0.737826
123 0.471347 0.306478
124 0.393143 0.335959
125 0.833147 0.245908
126 0.830435 0.241033
127 0.716296 0.231275
128 0.730788 0.289488
129 0.734095 0.289792
130 0.770476 0.418024
131 0.763693 0.431898
132 0.818061 0.530796
133 0.106657 0.781975
134 0.203174 0.820975
135 0.075784 0.139866
136 0.068339 0.176548
137 0.305266 0.880414
138 0.354191 0.763363
139 0.265994 0.753654
140 0.246446 0.772642
141 0.159245 0.265211
142 0.138670 0.234806
143 0.861916 0.186777
144 0.174082 0.940799
145 0.279948 1.009278
146 0.273393 0.288033
147 0.271448 0.386266
148 0.370404 0.332813
149 0.361161 0.275986
150 0.323080 0.261652
151 0.829893 0.311422
152 0.858517 0.273344
153 0.588934 0.250300
154 0.520092 0.070927
155 0.454613 0.150364
156 0.470693 0.190299
157 0.271767 0.226323
158 0.265901 0.219436
159 0.556483 0.563129
160 0.546308 0.638700
161 0.631007 0.553525
162 0.821470 0.375664
163 0.770607 0.417231
164 0.758282 0.954513
165 0.780616 0.971172
166 0.977825 0.939932
167 0.979590 0.912835
168 0.138699 0.234511
169 0.235663 0.594778
170 0.592619 0.309939
171 0.398289 0.170783
172 0.409605 0.154346
173 0.311022 0.227565
174 0.672435 0.458037
175 0.695586 0.463138
176 0.728091 0.343070
177 0.145115 0.682641
178 0.099338 0.699126
179 0.719575 0.318548
180 0.058977 0.057878
181 0.895069 0.729562
182 0.624958 0.535856
183 0.575125 0.513126
184 0.554961 0.523143
185 0.524879 0.511588
186 0.522569 0.050489
187 0.977322 0.677757
188 0.964115 0.598347
189 0.695639 0.943549
190 0.082714 0.694723
191 0.218466 0.595225
192 0.206052 0.587706
193 0.832707 0.335253
194 0.021993 0.747569
195 0.937054 0.260196
196 0.867310 0.188595
197 0.680799 1.007336
198 0.656663 0.017536
199 0.461951 0.779741
200 1.023159 0.705505
EDGES
1 1 2 * *
2 2 3 * *
3 3 4 * *
4 4 5 * *
5 5 6 * *
6 6 7 * *
7 7 1 * *
8 8 9 * *
9 9 10 * *
10 10 11 * *
11 11 12 * *
12 12 8 * *
13 13 14 * *
14 14 15 * *
15 15 16 * *
16 16 17 * *
17 17 13 * *
18 18 19 * *
19 19 20 * *
20 20 21 * *
21 21 22 * *
22 22 23 * *
23 23 24 * *
24 24 18 * *
25 25 26 * *
26 26 27 * *
27 27 28 * *
28 28 29 * *
29 29 30 * *
30 30 31 * *
31 31 25 * *
32 10 15 * *
33 14 32 * *
34 32 33 * *
35 33 11 * *
36 34 35 * *
37 35 36 * *
38 36 37 * *
39 37 38 * *
40 38 39 * *
41 39 40 * *
42 40 41 * *
43 41 34 * *
44 42 43 * *
45 43 44 * *
46 44 45 * *
47 45 46 * *
48 46 47 * *
49 47 48 * *
50 48 49 * *
51 49 42 * *
52 50 51 * *
53 51 52 * *
54 52 53 * *
55 53 54 * *
56 54 50 * *
57 55 56 * *
58 56 57 * *
59 57 58 * *
60 58 59 * *
61 59 60 * *
62 60 61 * *
63 61 62 * *
64 62 55 * *
65 63 64 * *
66 64 65 * *
67 65 66 * *
68 66 67 * *
69 67 68 * *
70 68 69 * *
71 69 70 * *
72 70 63 * *
73 71 72 * *
74 72 73 * *
75 73 74 * *
76 74 75 * *
77 75 76 * *
78 76 71 * *
79 77 3 + *
80 2 78 - *
81 78 79 * *
82 79 60 * *
83 59 77 * *
84 80 81 * *
85 81 82 * *
86 82 83 * *
87 83 84 * *
88 84 57 * *
89 56 80 * *
90 85 86 * *
91 86 51 + *
92 50 87 - *
93 87 88 * *
94 88 89 * *
95 89 90 * *
96 90 91 * *
97 91 85 * *
98 92 93 * *
99 93 94 * *
100 94 95 * *
101 95 92 * *
102 96 34 * +
103 41 97 * -
104 97 98 * *
105 98 96 * *
106 7 99 * *
107 99 100 * *
108 100 101 * *
109 101 1 * *
110 102 103 * *
111 103 104 * *
112 104 105 * *
113 105 106 * *
114 106 107 * *
115 107 102 * *
116 108 6 * *
117 5 89 - *
118 88 109 + *
119 109 108 * *
120 110 111 * *
121 111 112 * *
122 112 113 * *
123 113 114 * *
124 114 106 * *
125 105 110 * *
126 101 115 - *
127 115 78 * *
128 116 49 * *
129 48 117 * *
130 117 118 * *
131 118 119 * *
132 119 120 * *
133 120 121 * *
134 121 122 * *
135 122 116 * *
136 107 123 * *
137 123 124 * *
138 124 102 * *
139 68 42 * *
140 116 69 * *
141 125 126 * *
142 126 84 * *
143 83 127 * *
144 127 128 * *
145 128 129 * *
146 129 125 * *
147 130 131 * *
148 131 132 * *
149 132 86 * *
150 85 130 * *
151 92 133 * *
152 133 16 * *
153 9 134 * *
154 134 93 * *
155 135 100 * *
156 99 136 * *
157 136 135 * *
158 137 19 * *
159 18 138 * *
160 138 139 * *
161 139 140 * *
162 140 137 * *
163 87 71 + *
164 76 109 * *
165 75 141 * *
166 141 142 * *
167 142 108 * *
168 143 58 * *
169 126 143 * *
170 33 98 * *
171 97 144 * *
172 144 12 * *
173 40 145 * -
174 145 144 * *
175 146 74 * *
176 73 147 * *
177 147 148 * *
178 148 149 * *
179 149 150 * *
180 150 146 * *
181 8 20 * *
182 137 134 * *
183 129 151 * *
184 151 152 * *
185 152 125 * *
186 153 82 * *
187 81 154 * *
188 154 155 * *
189 155 156 * *
190 156 153 * *
191 146 157 * *
192 157 158 * *
193 158 141 * *
194 159 160 * *
195 160 43 * *
196 67 161 * *
197 161 159 * *
198 91 162 * *
199 162 163 * *
200 163 130 * *
201 164 165 * *
202 165 117 * *
203 47 164 * *
204 79 166 * -
205 166 167 * *
206 167 119 * *
207 118 61 * +
208 136 168 * *
209 168 37 * *
210 36 135 * *
211 31 169 * *
212 169 139 * *
213 138 25 * *
214 153 170 * *
215 170 127 * *
216 171 172 * *
217 172 39 * *
218 38 158 * *
219 157 173 * *
220 173 171 * *
221 111 174 * *
222 174 175 * *
223 175 131 * *
224 163 176 * *
225 176 112 * *
226 95 177 * *
227 177 178 * *
228 178 133 * *
229 170 114 * *
230 113 179 * *
231 179 128 * *
232 145 21 * *
233 13 167 - *
234 166 180 + +
235 180 35 * *
236 96 32 * *
237 70 181 * *
238 181 63 * *
239 161 182 * *
240 182 183 * *
241 183 184 * *
242 184 159 * *
243 185 184 * *
244 183 110 * *
245 104 185 * *
246 66 175 * *
247 174 182 * *
248 140 94 * *
249 180 115 - *
250 172 155 * *
251 154 186 * *
252 186 22 * -
253 181 122 * *
254 121 187 * *
255 187 188 * *
256 188 64 * *
257 150 173 * *
258 149 171 * *
259 46 189 * *
260 189 164 * *
261 156 123 * *
262 190 178 * *
263 177 191 * *
264 191 192 * *
265 192 54 * *
266 53 190 * *
267 169 191 * *
268 179 176 * *
269 162 193 * *
270 193 151 * *
271 17 194 * *
272 194 120 - *
273 165 62 * +
274 103 29 * *
275 28 185 * *
276 152 195 * *
277 195 196 * *
278 196 143 * *
279 189 197 * *
280 197 55 * +
281 124 148 * *
282 147 30 * *
283 198 186 * *
284 80 198 * *
285 24 199 * *
286 199 26 * *
287 160 27 * *
288 199 44 * *
289 45 23 * *
290 198 197 * -
291 4 195 - *
292 193 90 * *
293 192 72 * *
294 65 132 * *
295 52 188 - *
296 187 200 * *
297 200 190 + *
298 142 168 * *
299 200 194 + *
300 196 77 * *
FACES
1 -7 -6 -5 -4 -3 -2 -1
2 -12 -11 -10 -9 -8
3 -17 -16 -15 -14 -13
4 -24 -23 -22 -21 -20 -19 -18
5 -31 -30 -29 -28 -27 -26 -25
6 -35 -34 -33 14 -32 10
7 -43 -42 -41 -40 -39 -38 -37 -36
8 -51 -50 -49 -48 -47 -46 -45 -44
9 -56 -55 -54 -53 -52
10 -64 -63 -62 -61 -60 -59 -58 -57
11 -72 -71 -70 -69 -68 -67 -66 -65
12 -78 -77 -76 -75 -74 -73
13 -83 61 -82 -81 -80 2 -79
14 -89 58 -88 -87 -86 -85 -84
15 -97 -96 -95 -94 -93 -92 52 -91 -90
16 -101 -100 -99 -98
17 -105 -104 -103 43 -102
18 7 -109 -108 -107 -106
19 -115 -114 -113 -112 -111 -110
20 -119 -118 94 -117 5 -116
21 -125 113 -124 -123 -122 -121 -120
22 -127 -126 109 1 80
23 -135 -134 -133 -132 -131 -130 -129 50 -128
24 115 -138 -137 -136
25 -140 128 51 -139 70
26 -146 -145 -144 -143 87 -142 -141
27 -150 90 -149 -148 -147
28 98 -154 -153 9 32 15 -152 -151
29 -157 -156 107 -155
30 -162 -161 -160 -159 18 -158
31 118 -164 78 -163 93
32 119 -167 -166 -165 77 164
33 -169 142 88 59 -168
34 35 11 -172 -171 104 -170
35 103 171 -174 -173 42
36 -180 -179 -178 -177 -176 75 -175
37 -182 158 19 -181 8 153
38 146 -185 -184 -183
39 -190 -189 -188 -187 85 -186
40 -193 -192 -191 175 76 165
41 -197 -196 69 139 44 -195 -194
42 150 -200 -199 -198 97
43 -203 49 129 -202 -201
44 -207 131 -206 -205 -204 82 62
45 157 -210 38 -209 -208
46 31 -213 160 -212 -211
47 -215 -214 186 86 143
48 -220 -219 192 -218 40 -217 -216
49 -225 -224 200 147 -223 -222 -221 121
50 101 151 -228 -227 -226
51 215 144 -231 -230 123 -229
52 12 181 20 -232 174 172
53 -236 102 36 -235 -234 205 -233 13 33
54 -238 -237 72
55 197 -242 -241 -240 -239
56 -245 112 125 -244 241 -243
57 -247 222 -246 68 196 239
58 182 154 99 -248 162
59 155 108 126 -249 235 37 210
60 21 -252 -251 188 -250 217 41 173 232
61 238 65 -256 -255 -254 134 -253
62 -257 180 191 219
63 257 220 -258 179
64 203 -260 -259 48
65 190 214 229 124 114 136 -261
66 -266 55 -265 -264 -263 227 -262
67 100 226 263 -267 212 161 248
68 183 -270 -269 199 224 -268 231 145
69 105 236 34 170
70 127 81 204 234 249
71 17 233 206 132 -272 -271
72 202 130 207 63 -273
73 245 -275 28 -274 111
74 169 -278 -277 -276 185 141
75 140 71 237 253 135
76 201 273 64 -280 -279 260
77 225 122 230 268
78 138 110 274 29 -282 177 -281
79 -284 84 187 251 -283
80 24 159 213 25 -286 -285
81 -288 286 26 -287 195 45
82 279 -290 283 252 22 -289 47 259
83 -292 270 184 276 -291 4 117 95
84 -293 265 56 92 163 73
85 284 290 280 57 89
86 247 240 244 120 221
87 246 223 148 -294 67
88 242 194 287 27 275 243
89 292 96 198 269
90 266 -297 -296 255 -295 54
91 156 208 -298 167 116 6 106
92 16 271 -299 297 262 228 152
93 -300 278 168 60 83
94 293 74 176 282 30 211 267 264
95 300 79 3 291 277
96 193 166 298 209 39 218
97 272 133 254 296 299
98 149 91 53 295 256 66 294
99 288 46 289 23 285
100 258 216 250 189 261 137 281 178
BODIES
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
10 10
11 11
12 12
13 13
14 14
15 15
16 16
17 17
18 18
19 19
20 20
21 21
22 22
23 23
24 24
25 25
26 26
27 27
28 28
29 29
30 30
31 31
32 32
33 33
34 34
35 35
36 36
37 37
38 38
39 39
40 40
41 41
42 42
43 43
44 44
45 45
46 46
47 47
48 48
49 49
50 50
51 51
52 52
53 53
54 54
55 55
56 56
57 57
58 58
59 59
60 60
61 61
62 62
63 63
64 64
65 65
66 66
67 67
68 68
69 69
70 70
71 71
72 72
73 73
74 74
75 75
76 76
77 77
78 78
79 79
80 80
81 81
82 82
83 83
84 84
85 85
86 86
87 87
88 88
89 89
90 90
91 91
92 92
93 93
94 94
95 95
96 96
97 97
98 98
99 99
100 100
read
clipped // for clipped unit cell display
evolver-2.30c.dfsg/fe/equi2.cmd 0000755 0001753 0001753 00000001571 11410765113 016541 0 ustar hazelsct hazelsct // equi2.cmd -- to color edges subject to equiangulation
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// useage: showequi
showequi := {
local ecount, al,bl,cl,dl,el,nn;
ecount := 0;
foreach edge ee do
{ al := ee.length;
nn := 1;
foreach ee.facet ff do
{ foreach ff.edge fe do
{ if ( fe.id != ee.id ) then
{ if ( nn == 1 ) then bl := fe.length
else if ( nn == 2 ) then cl := fe.length
else if ( nn == 3 ) then dl := fe.length
else if ( nn == 4 ) then el := fe.length;
nn := nn + 1;
}
}
};
if ( nn == 5 ) then
if (bl^2+cl^2-al^2)/bl/cl + (dl^2+el^2-al^2)/dl/el < 0 then
{ set ee color green;
ecount := 1 + ecount
}
};
printf "Found %g edges.\n",ecount;
show_expr edges where 1
}
evolver-2.30c.dfsg/fe/catman.fe 0000644 0001753 0001753 00000004510 11410765113 016577 0 ustar hazelsct hazelsct // catman.fe
// Evolver datafile for catenoid with parameters as in Manual tutorial.
PARAMETER radius = 1 // ring radius; runtime adjustable
PARAMETER height = 0.55 // ring height; runtime adjustable
boundary 1 parameters 1 // upper ring; p1 is ring parameter
x1: radius * cos(p1)
x2: radius * sin(p1)
x3: height
boundary 2 parameters 1 // lower ring
x1: radius * cos(p1)
x2: radius * sin(p1)
x3: -height
vertices /* given by parameter value on a boundary */
1 0*pi/3 boundary 1 fixed
2 1*pi/3 boundary 1 fixed
3 2*pi/3 boundary 1 fixed
4 3*pi/3 boundary 1 fixed
5 4*pi/3 boundary 1 fixed
6 5*pi/3 boundary 1 fixed
7 0*pi/3 boundary 2 fixed
8 1*pi/3 boundary 2 fixed
9 2*pi/3 boundary 2 fixed
10 3*pi/3 boundary 2 fixed
11 4*pi/3 boundary 2 fixed
12 5*pi/3 boundary 2 fixed
edges /* given by endpoint vertices */
1 1 2 boundary 1 fixed
2 2 3 boundary 1 fixed
3 3 4 boundary 1 fixed
4 4 5 boundary 1 fixed
5 5 6 boundary 1 fixed
6 6 1 boundary 1 fixed
7 7 8 boundary 2 fixed
8 8 9 boundary 2 fixed
9 9 10 boundary 2 fixed
10 10 11 boundary 2 fixed
11 11 12 boundary 2 fixed
12 12 7 boundary 2 fixed
13 1 7
14 2 8
15 3 9
16 4 10
17 5 11
18 6 12
faces /* given by oriented edge list */
1 1 14 -7 -13
2 2 15 -8 -14
3 3 16 -9 -15
4 4 17 -10 -16
5 5 18 -11 -17
6 6 13 -12 -18
read
// Demonstrating saddle point due to triangulation arrangement.
// First setting parameters to stable values.
gogo := { g; u; r; g 50; // at this point have nearly a saddle point
g 200; // triangulation twists around to lower energy
}
// Faster version of the above using conjugate gradient
gogo2 := { g; u; r; U; g 25; // at this point have nearly a saddle point
g 35;
}
// High accuracy evolution, using higher-order Lagrange elements.
gogo3 := { u; rmax := cosh(height); recalc;
r; g 5; hessian;
r; g 5; hessian;
lagrange 2; g 5; hessian;
lagrange 4; g 5; hessian;
lagrange 6; g 5; hessian;
lagrange 8; g 5; hessian;
true_area := 2*pi*(height + 0.5*sinh(2*height));
printf"Difference from true area: %g\n",total_area - true_area;
}
evolver-2.30c.dfsg/fe/multiplicate.cmd 0000755 0001753 0001753 00000022050 11410765113 020203 0 ustar hazelsct hazelsct // multiplicate.cmd
// Surface Evolver script to create datafile with surface duplicated
// according to view transforms in effect. Writes datafile to stdout.
// Does not create new elements in current surface, since together
// with view transforms, that would result in quadratic explosion.
// WARNING: This loses all element attributes in the output datafile.
// But does preserve "edgetype" attribute
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// usage: multiplicate >>> "newdatafile.fe"
define edge attribute edgetype integer // in case doesn't exist
eps := 1e-4 // tolerance for identifying vertices
// Hash table for finding identified vertices. Generates hash value
// from skew plane.
mskew1 := 0.361234123413728768
mskew2 := 0.725423451231725277
mskew3 := 0.5227723243451234514
vertex_hash_init := {
vertex_hash_table_size := vertex_count*transform_count;
define vertex_hash_table integer[vertex_hash_table_size];
define vertex_hash_chain integer[vertex_hash_table_size];
define newcoord real[vertex_hash_table_size][3];
vertex_entry_count := 0;
}
// deallocate memory
vertex_hash_end := {
define vertex_hash_table integer[0];
define vertex_hash_chain integer[0];
define newcoord real[0][0];
}
// Returns sequential number of found or new vertex.
function integer vertex_hash_add(real xx, real yy, real zz)
{ local hashval,hashspot;
local vnum,dist;
hashval := floor((mskew1*xx + mskew2*yy + mskew3*zz)/eps);
hashspot := hashval imod vertex_hash_table_size;
// See if there
for ( vnum := vertex_hash_table[hashspot] ; vnum != 0 ;
vnum := vertex_hash_chain[vnum] )
{
dist := sqrt((xx-newcoord[vnum][1])^2 + (yy-newcoord[vnum][2])^2 +
(zz-newcoord[vnum][3])^2);
if dist < eps then return vnum;
};
// Not there, so add
vertex_entry_count += 1;
vnum := vertex_entry_count;
vertex_hash_chain[vnum] := vertex_hash_table[hashspot];
vertex_hash_table[hashspot] := vnum;
newcoord[vnum][1] := xx;
newcoord[vnum][2] := yy;
newcoord[vnum][3] := zz;
return vnum;
}
// Hash table for finding identified edges.
edge_hash_init := {
edge_hash_table_size := edge_count*transform_count;
define edge_hash_table integer[edge_hash_table_size];
define edge_hash_chain integer[edge_hash_table_size];
define new_edge_verts integer[edge_hash_table_size][2];
edge_entry_count := 0;
}
// deallocate memory
edge_hash_end := {
define edge_hash_table integer[0];
define edge_hash_chain integer[0];
define new_edge_verts integer[0][0];
}
// Edge hasher. Returns sequential number (signed) of found or new edge.
function integer edge_hash_add(integer tailv, integer headv)
{ local temp,signflag;
local hashval,hashspot;
local edgenum;
// get vertices in canonical order
if tailv > headv then
{ temp := tailv;
tailv := headv;
headv := temp;
signflag := -1;
}
else signflag := 1;
hashval := tailv*737 + headv;
hashspot := hashval imod edge_hash_table_size;
// See if there
for ( edgenum := edge_hash_table[hashspot] ; edgenum != 0 ;
edgenum := edge_hash_chain[edgenum] )
{
if (tailv == new_edge_verts[edgenum][1]) and
(headv == new_edge_verts[edgenum][2])
then return signflag*edgenum;
};
// Not there, so add
edge_entry_count += 1;
edgenum := edge_entry_count;
edge_hash_chain[edgenum] := edge_hash_table[hashspot];
edge_hash_table[hashspot] := edgenum;
new_edge_verts[edgenum][1] := tailv;
new_edge_verts[edgenum][2] := headv;
return signflag*edgenum;
}
multiplicate := {
local tcount,high_vertex,vx,vy,vz;
local high_edge,thistail,thishead,fstride,tdet,edge1,edge2,edge3;
list topinfo;
define vertex attribute tx real[transform_count];
define vertex attribute ty real[transform_count];
define vertex attribute tz real[transform_count];
define vertex attribute valias integer[transform_count];
define edge attribute ehead integer[transform_count];
define edge attribute etail integer[transform_count];
define edge attribute ealias integer[transform_count];
printf "\nVertices\n";
vertex_hash_init;
tcount := 1;
high_vertex := 0;
while ( tcount <= transform_count ) do
{ foreach vertex vv do
{
vx := view_transforms[tcount][1][1]*vv.x
+ view_transforms[tcount][1][2]*vv.y
+ view_transforms[tcount][1][3]*vv.z
+ view_transforms[tcount][1][4]*1;
vy := view_transforms[tcount][2][1]*vv.x
+ view_transforms[tcount][2][2]*vv.y
+ view_transforms[tcount][2][3]*vv.z
+ view_transforms[tcount][2][4]*1;
vz := view_transforms[tcount][3][1]*vv.x
+ view_transforms[tcount][3][2]*vv.y
+ view_transforms[tcount][3][3]*vv.z
+ view_transforms[tcount][3][4]*1;
vv.tx[tcount] := vx; vv.ty[tcount] := vy; vv.tz[tcount] := vz;
// search for alias
vv.valias[tcount] := vertex_hash_add(vx,vy,vz);
if vv.valias[tcount] > high_vertex then
{ printf "%d %18.15f %18.15f %18.15f ",vv.valias[tcount],
vx,vy,vz;
printf "\n";
high_vertex := vv.valias[tcount];
};
};
tcount += 1;
};
vertex_hash_end;
printf "\nEdges\n";
tcount := 1;
edge_hash_init;
high_edge := 0;
while ( tcount <= transform_count ) do
{ foreach edge ee do
{
thistail := vertex[ee.vertex[1].id].valias[tcount];
thishead := vertex[ee.vertex[2].id].valias[tcount];
ee.ehead[tcount] := thishead;
ee.etail[tcount] := thistail;
// search for aliases
ee.ealias[tcount] := edge_hash_add(thistail,thishead);
if ( abs(ee.ealias[tcount]) > high_edge ) then
{ printf "%d %d %d edgetype %d",abs(ee.ealias[tcount]),
minimum(thistail,thishead),maximum(thistail,thishead),edgetype;
if ee.bare then printf " bare ";
printf "\n";
high_edge := abs(ee.ealias[tcount]);
};
};
tcount += 1;
};
edge_hash_end;
printf "\nFaces\n";
fstride := max(facet,id);
tcount := 1;
while ( tcount <= transform_count ) do
{ tdet := view_transforms[tcount][1][1]*
(view_transforms[tcount][2][2]*view_transforms[tcount][3][3]
- view_transforms[tcount][3][2]*view_transforms[tcount][2][3])
- view_transforms[tcount][1][2]*
(view_transforms[tcount][2][1]*view_transforms[tcount][3][3]
- view_transforms[tcount][3][1]*view_transforms[tcount][2][3])
+ view_transforms[tcount][1][3]*
(view_transforms[tcount][2][1]*view_transforms[tcount][3][2]
- view_transforms[tcount][3][1]*view_transforms[tcount][2][2]);
foreach facet ff do
{ edge1 := edge[ff.edge[1].id].ealias[tcount];
edge2 := edge[ff.edge[2].id].ealias[tcount];
edge3 := edge[ff.edge[3].id].ealias[tcount];
if ( view_transform_swap_colors[tcount] != (tdet < 0.0) ) then
// inverted
printf "%d %d %d %d\n",ff.id + (tcount-1)*fstride,
((ff.edge[3].oid > 0) ? -edge3 : edge3),
((ff.edge[2].oid > 0) ? -edge2 : edge2),
((ff.edge[1].oid > 0) ? -edge1 : edge1)
else
printf "%d %d %d %d\n",ff.id + (tcount-1)*fstride,
((ff.edge[1].oid > 0) ? edge1 : -edge1),
((ff.edge[2].oid > 0) ? edge2 : -edge2),
((ff.edge[3].oid > 0) ? edge3 : -edge3);
};
tcount += 1;
};
// not listing bottominfo on purpose; too much extraneous stuff
// free attribute storage
define vertex attribute tx real[0];
define vertex attribute ty real[0];
define vertex attribute tz real[0];
define vertex attribute valias integer[0];
define edge attribute ehead integer[0];
define edge attribute etail integer[0];
define edge attribute ealias integer[0];
}
aa := 1
pview := {
printf "%f %f %f %f\n",view_transforms[aa][1][1],view_transforms[aa][1][2],
view_transforms[aa][1][3],view_transforms[aa][1][4];
printf "%f %f %f %f\n",view_transforms[aa][2][1],view_transforms[aa][2][2],
view_transforms[aa][2][3],view_transforms[aa][2][4];
printf "%f %f %f %f\n",view_transforms[aa][3][1],view_transforms[aa][3][2],
view_transforms[aa][3][3],view_transforms[aa][3][4];
printf "%f %f %f %f\n",view_transforms[aa][4][1],view_transforms[aa][4][2],
view_transforms[aa][4][3],view_transforms[aa][4][4];
}
// Paste things together that didn't get pasted, by finding edges that
// come out of vertices in the same direction.
paste := {
local paste_count;
paste_count := 0; // track how many found, so know when no more left
foreach vertex vv do
{ foreach vv.edge ee do
{
foreach vv.edge eee do
{ if ee.id == eee.id then continue;
if (ee.x-eee.x)^2 + (ee.y-eee.y)^2 + (ee.z-eee.z)^2 < eps^2 then
{ edge_merge(ee.oid,eee.oid);
paste_count += 1;
break;
}
}
}
};
printf "Edges pasted: %d\n",paste_count;
}
// usage: Set view transforms as desired, then do
// multiplicate >>> "newdatafile.fe"
evolver-2.30c.dfsg/fe/metric.fe 0000644 0001753 0001753 00000000734 11410765113 016623 0 ustar hazelsct hazelsct // metric.fe
// Demonstration of background metric with strings
// Metric turns punctured plane into catenoid. Initial string
// shrinks to loop around throat. Note that graphing uses just
// the plane coordinates without metric.
SPACE_DIMENSION 2
STRING
#define G11 (1 + 1/(x^2 + y^2))^2
METRIC
G11 0
0 G11
vertices
1 1 0
2 0 2
3 -2 0
4 0 -1
edges
1 1 2
2 2 3
3 3 4
4 4 1
read
// Typical evolution
gogo := { g 5; r; g 5; r; g 5; r; g 5; }
evolver-2.30c.dfsg/fe/slice2.cmd 0000755 0001753 0001753 00000004356 11410765113 016701 0 ustar hazelsct hazelsct // slice2.cmd --- produce intersection of surface with plane
// plane eq: aa*x + bb*y + cc*z = dd
// output: length of slice, and area inside slice.
// Does not modify surface.
// Note all area inside slice is counted as positive!
// Do not to slice exactly through vertices!! Avoid special
// values for dd like 0 or .5!
// Fixed to do oriented facets of a particular body.
// Usage: set plane coefficients, then do slice2(body number).
// Results: Intersection length printed out, left in variable lensum.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
procedure slice2(integer body_num) := {
local any,xx1,yy1,zz1,xx2,yy2,zz2;
local denom,lambda,zaa,zbb,darea;
lensum := 0; areasum := 0;
xb := 0; yb := 0; zb := 0; // just for declaration before use.
foreach body[body_num].facet ff do
{ any := 0;
foreach ff.edge ee do
{
xx1 := ee.vertex[1].x;
yy1 := ee.vertex[1].y;
zz1 := ee.vertex[1].z;
xx2 := ee.vertex[2].x;
yy2 := ee.vertex[2].y;
zz2 := ee.vertex[2].z;
denom := aa*(xx1-xx2)+bb*(yy1-yy2)+cc*(zz1-zz2);
if ( denom != 0.0 ) then
{
lambda := (dd-aa*xx2-bb*yy2-cc*zz2)/denom;
if ( (lambda >= 0) and (lambda <= 1) ) then
{
xa := xb; ya := yb; za := zb;
xb := lambda*xx1+(1-lambda)*xx2;
yb := lambda*yy1+(1-lambda)*yy2;
zb := lambda*zz1+(1-lambda)*zz2;
any := any+1;
}
}
} ;
if any == 2 then
{
local triple;
dx := xa-xb; dy := ya-yb; dz := za - zb;
lensum := lensum + sqrt(dx^2+dy^2+dz^2);
zaa := za - dd/cc; zbb := zb - dd/cc;
fx := ff.x; fy := ff.y; fz := ff.z;
triple := fx*(dy*cc-dz*bb)+fy*(dz*aa-dx*cc)+fz*(dx*bb-dy*aa);
darea := (xa*yb-xb*ya)/2;
if ( triple > 0 ) then areasum := areasum + darea
else areasum := areasum - darea;
}
};
areasum := areasum*sqrt(aa*aa+bb*bb+cc*cc)/cc;
printf "Circumference: %18.15g Area: %18.15g\n",lensum,areasum;
} // end slice
evolver-2.30c.dfsg/fe/quadint2.cmd 0000755 0001753 0001753 00000015570 11410765113 017247 0 ustar hazelsct hazelsct // quadint2.cmd
// For detecting intersection of quadratic facets in 3D
// Not suitable for torus model.
// Needs quadbbox.cmd to be loaded first.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: quadmeet
// Prints id numbers of pairs of intersecting facets and colors them green.
a_refine_order := 4
b_refine_order := 5
eps := 1e-10 // tolerance for being equal to zero
ax := 0; bx := 0; cx := 0; ay := 0; by := 0; cy := 0; az := 0; bz := 0; cz := 0;
px := 0; py := 0; pz := 0; qx := 0; qy := 0; qz:= 0;
uuu := 0; vvv := 0;
xa1 := 0; xa2 := 0; xa3 := 0; xa4 := 0; xa5 := 0; xa6 := 0
ya1 := 0; ya2 := 0; ya3 := 0; ya4 := 0; ya5 := 0; ya6 := 0
za1 := 0; za2 := 0; za3 := 0; za4 := 0; za5 := 0; za6 := 0
intersection_found := 0;
// detection of triangle and edge intersection
detect := {
local acx,acy,acz,bcx,bcy,bcz,qpx,qpy,qpz,qcx,qcy,qcz;
local denom,lambda,mu,sigma;
do {
acx := ax-cx; acy := ay-cy; acz := az-cz;
bcx := bx-cx; bcy := by-cy; bcz := bz-cz;
qpx := qx-px; qpy := qy-py; qpz := qz-pz;
qcx := qx-cx; qcy := qy-cy; qcz := qz-cz;
denom := qpx*(acy*bcz-acz*bcy) - qpy*(acx*bcz-acz*bcx)
+ qpz*(acx*bcy-acy*bcx);
if ( abs(denom) < eps ) then break;
lambda := (qpx*(qcy*bcz-qcz*bcy) - qpy*(qcx*bcz-qcz*bcx)
+ qpz*(qcx*bcy-qcy*bcx))/denom;
if ( lambda <= eps ) then break;
mu := (qpx*(acy*qcz-acz*qcy) - qpy*(acx*qcz-acz*qcx)
+ qpz*(acx*qcy-acy*qcx))/denom;
if ( mu <= eps ) then break;
if ( lambda + mu > 1-eps ) then break;
sigma := (qcx*(acy*bcz-acz*bcy) - qcy*(acx*bcz-acz*bcx)
+ qcz*(acx*bcy-acy*bcx))/denom;
if ( (sigma <= eps) or (sigma > 1-eps) ) then break;
// now have intersection
intersection_found := 1;
} while 0; // so we could use break
} // end detect
calccoords := {
xx := 0.5*(uuu+vvv-1)*(uuu+vvv-2)*xa1 + uuu*(2-uuu-vvv)*xa2
+ 0.5*uuu*(uuu-1)*xa3 + vvv*(2-uuu-vvv)*xa4
+ uuu*vvv*xa5 + 0.5*vvv*(vvv-1)*xa6;
yy := 0.5*(uuu+vvv-1)*(uuu+vvv-2)*ya1 + uuu*(2-uuu-vvv)*ya2
+ 0.5*uuu*(uuu-1)*ya3 + vvv*(2-uuu-vvv)*ya4
+ uuu*vvv*ya5 + 0.5*vvv*(vvv-1)*ya6;
zz := 0.5*(uuu+vvv-1)*(uuu+vvv-2)*za1 + uuu*(2-uuu-vvv)*za2
+ 0.5*uuu*(uuu-1)*za3 + vvv*(2-uuu-vvv)*za4
+ uuu*vvv*za5 + 0.5*vvv*(vvv-1)*za6;
} // end calccoords
refine_and_test := {
// Test intersections of planar subtriangles and sub edges
adelta := 2/a_refine_order;
bdelta := 2/b_refine_order;
ua := 0;
while ( ua < 1.9999 ) do
{ va := 0;
while ( va < 1.9999 - ua ) do
{ uuu := ua; vvv := va; calccoords; ax := xx; ay := yy; az := zz;
uuu := ua+adelta; vvv := va; calccoords; bx := xx; by := yy; bz := zz;
uuu := ua; vvv := va+adelta; calccoords; cx := xx; cy := yy; cz := zz;
ub := 0;
while ( ub < 1.9999 ) do
{ vb := 0;
while ( vb < 1.9999 - ub ) do
{
uuu := ub; vvv := vb; calccoords; px := xx; py := yy; pz := zz;
uuu := ub+bdelta; vvv := vb; calccoords; qx := xx; qy := yy; qz := zz;
detect; if intersection_found then break;
uuu := ub; vvv := vb+bdelta; calccoords; px := xx; py := yy; pz := zz;
detect; if intersection_found then break;
uuu := ub; vvv := vb; calccoords; qx := xx; qy := yy; qz := zz;
detect; if intersection_found then break;
vb := vb + bdelta;
};
if intersection_found then break;
ub := ub + bdelta;
};
if intersection_found then break;
va := va + adelta;
};
if intersection_found then break;
ua := ua + adelta;
}
} // end refine_and_test
quadmeet := {
intersect_total := 0;
fboxes; // find facet bounding boxes
// test all facet pairs
foreach facet fa do
{ foreach facet fb where fb.id > fa.id do
{ // check adjacency
if ( fa.vertex[1].id == fb.vertex[1].id ) then continue;
if ( fa.vertex[2].id == fb.vertex[1].id ) then continue;
if ( fa.vertex[3].id == fb.vertex[1].id ) then continue;
if ( fa.vertex[1].id == fb.vertex[2].id ) then continue;
if ( fa.vertex[2].id == fb.vertex[2].id ) then continue;
if ( fa.vertex[3].id == fb.vertex[2].id ) then continue;
if ( fa.vertex[1].id == fb.vertex[3].id ) then continue;
if ( fa.vertex[2].id == fb.vertex[3].id ) then continue;
if ( fa.vertex[3].id == fb.vertex[3].id ) then continue;
// first, check bounding boxes
if ( fb.fbox[1] >= fa.fbox[2] or
fb.fbox[2] <= fa.fbox[1] or
fb.fbox[3] >= fa.fbox[4] or
fb.fbox[4] <= fa.fbox[3] or
fb.fbox[5] >= fa.fbox[6] or
fb.fbox[6] <= fa.fbox[5] ) then continue;
// extract coordinates
xa1 := fa.edge[1].vertex[1].x;
xa2 := fa.edge[1].vertex[3].x;
xa3 := fa.edge[1].vertex[2].x;
xa4 := fa.edge[3].vertex[3].x;
xa5 := fa.edge[2].vertex[3].x;
xa6 := fa.edge[2].vertex[2].x;
ya1 := fa.edge[1].vertex[1].y;
ya2 := fa.edge[1].vertex[3].y;
ya3 := fa.edge[1].vertex[2].y;
ya4 := fa.edge[3].vertex[3].y;
ya5 := fa.edge[2].vertex[3].y;
ya6 := fa.edge[2].vertex[2].y;
za1 := fa.edge[1].vertex[1].z;
za2 := fa.edge[1].vertex[3].z;
za3 := fa.edge[1].vertex[2].z;
za4 := fa.edge[3].vertex[3].z;
za5 := fa.edge[2].vertex[3].z;
za6 := fa.edge[2].vertex[2].z;
xb1 := fb.edge[1].vertex[1].x;
xb2 := fb.edge[1].vertex[3].x;
xb3 := fb.edge[1].vertex[2].x;
xb4 := fb.edge[3].vertex[3].x;
xb5 := fb.edge[2].vertex[3].x;
xb6 := fb.edge[2].vertex[2].x;
yb1 := fb.edge[1].vertex[1].y;
yb2 := fb.edge[1].vertex[3].y;
yb3 := fb.edge[1].vertex[2].y;
yb4 := fb.edge[3].vertex[3].y;
yb5 := fb.edge[2].vertex[3].y;
yb6 := fb.edge[2].vertex[2].y;
zb1 := fb.edge[1].vertex[1].z;
zb2 := fb.edge[1].vertex[3].z;
zb3 := fb.edge[1].vertex[2].z;
zb4 := fb.edge[3].vertex[3].z;
zb5 := fb.edge[2].vertex[3].z;
zb6 := fb.edge[2].vertex[2].z;
refine_and_test;
if intersection_found then
{ intersect_total := intersect_total + 1;
set fa color green; set fb color green;
printf "Facets %g and %g intersect.\n",fa.id,fb.id;
}
}
};
printf "Intersections found: %g\n",intersect_total;
} // end quadmeet
evolver-2.30c.dfsg/fe/gaussequi.cmd 0000755 0001753 0001753 00000003277 11410765113 017527 0 ustar hazelsct hazelsct // gaussequi.cmd
// Equiangulation using Gauss map for swap criterion.
// But has problems; can produce zero area facets. Also, swapping an
// edge changes the Gauss map, so maybe things don't improve.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: gaussequi
gaussequi := {
local ax,ay,az,bx,by,bz,ffnum,cx,cy,cz,dx,dy,dz,aa,bb,cc,dd,ee;
swapcount := 0;
foreach edge eee where not fixed and valence == 2 do
{ ax := eee.vertex[1].vertexnormal[1];
ay := eee.vertex[1].vertexnormal[2];
az := eee.vertex[1].vertexnormal[3];
bx := eee.vertex[2].vertexnormal[1];
by := eee.vertex[2].vertexnormal[2];
bz := eee.vertex[2].vertexnormal[3];
ffnum := eee.facet[1].id;
foreach facet[ffnum].vertex vv do
{ if vv.id != eee.vertex[1].id and vv.id != eee.vertex[2].id then
{ vvnum := vv.id; break; }
};
cx := vertex[vvnum].vertexnormal[1];
cy := vertex[vvnum].vertexnormal[2];
cz := vertex[vvnum].vertexnormal[3];
ffnum := eee.facet[2].id;
foreach facet[ffnum].vertex vv do
{ if vv.id != eee.vertex[1].id and vv.id != eee.vertex[2].id then
{ vvnum := vv.id; break; }
};
dx := vertex[vvnum].vertexnormal[1];
dy := vertex[vvnum].vertexnormal[2];
dz := vertex[vvnum].vertexnormal[3];
aa := (ax-bx)^2+(ay-by)^2+(az-bz)^2;
bb := (ax-cx)^2+(ay-cy)^2+(az-cz)^2;
cc := (bx-cx)^2+(by-cy)^2+(bz-cz)^2;
dd := (ax-dx)^2+(ay-dy)^2+(az-dz)^2;
ee := (bx-dx)^2+(by-dy)^2+(bz-dz)^2;
if ( (bb+cc-aa)*sqrt(dd*ee) + (dd+ee-aa)*sqrt(bb*cc) < 0 ) then
{ edgeswap eee;
swapcount += 1;
};
};
printf "Edges gaussequi swapped: %d\n",swapcount;
}
evolver-2.30c.dfsg/fe/rotate.cmd 0000755 0001753 0001753 00000000736 11410765113 017014 0 ustar hazelsct hazelsct // rotate.cmd
// Surface Evolver procedure to rotate unfixed vertices by angle about z axis.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: rotate(angle)
// where angle is in radians.
procedure rotate(real roth) := {
local sss,ccc,rrad,olds;
sss := sin(roth); ccc := cos(roth);
foreach vertex vv where not fixed do
{ rrad := vv.x^2+vv.y^2;
oldx := vv.x;
set vv x vv.x*ccc-vv.y*sss;
set vv y oldx*sss+vv.y*ccc;
}
}
evolver-2.30c.dfsg/fe/reorder.cmd 0000755 0001753 0001753 00000001070 11410765113 017150 0 ustar hazelsct hazelsct // reorder.cmd
define vertex attribute vertex_order_key real
define edge attribute edge_order_key real
define facet attribute facet_order_key real
define body attribute body_order_key real
define facetedge attribute facetedge_order_key real
reorder := {
set vertex vertex_order_key x+y+z;
set edge ee edge_order_key min(ee.vertex,vertex_order_key);
set facetedge fe facetedge_order_key fe.edge[1].edge_order_key;
set facet ff facet_order_key min(ff.vertex,vertex_order_key);
set body bb body_order_key min(bb.facet,facet_order_key);
reorder_storage;
}
evolver-2.30c.dfsg/fe/knotty.fe 0000644 0001753 0001753 00000007671 11410765113 016677 0 ustar hazelsct hazelsct // knotty.fe
// Evolver data for 3,2 torus knot (trefoil) with various knot energies.
// You need to set one type of energy and one type of length constraint;
// see the set_* commands in the "read" section of the datafile.
// Not all combinations are workable.
string // this is a 1D surface
parameter maj_r = 2 // torus major radius
parameter min_r = 0.5 // torus minor radius
boundary 1 parameter 1 // parametric curve around torus
x1: cos(2*p1)*(maj_r + min_r*cos(3*p1))
x2: sin(2*p1)*(maj_r + min_r*cos(3*p1))
x3: min_r*sin(3*p1)
// Here follow six different types of energy. Switch between them
// with the set_* commands in the bottom section of this datafile.
// elastic bending energy, i.e. squared curvature
quantity bending_energy ENERGY modulus 0 method sqcurve_string global
// conducting wire vertex energy
quantity conduct_energy ENERGY modulus 1 method knot_energy global
// insulating wire vertex energy
quantity insul_energy ENERGY modulus 0 method edge_knot_energy global
// Greg Buck's 1/(d1+d2+d3+d4-2(L1+L2)) energy
quantity buck_energy ENERGY modulus 0 method buck_knot_energy global
// have to start with modulus 0 since edges too long at start */
// Greg Buck's normal projection energy
quantity proj_energy ENERGY modulus 0 method proj_knot_energy global
// Peter Doyle's conformal circle energy
quantity circle_energy ENERGY modulus 0 method circle_knot_energy global
// Here follow three ways to control the length of edges.
// Switch between them with the set_* commands below.
// Elastic stretching energy to encourage edges to all have the same length.
// Use "hooke_length := value" command to set hooke_length to desired
// edge length
quantity hooke ENERGY modulus 0 method hooke_energy global
// Individually set edge equilibrium lengths.
// Use "set edge hooke_size expr" to set desired edge lengths
// When used, the modulus needs to be set high, like 1000 or 10000,
// to provide decent stiffness.
define edge attribute hooke_size real
quantity hooke2 ENERGY modulus 0 method hooke2_energy global
// to keep total length fixed
quantity knot_length FIXED = 24 modulus 1 method edge_tension global
vertices
1 0.0*pi boundary 1
2 0.2*pi boundary 1
3 0.4*pi boundary 1
4 0.6*pi boundary 1
5 0.8*pi boundary 1
6 1.0*pi boundary 1
7 1.2*pi boundary 1
8 1.4*pi boundary 1
9 1.6*pi boundary 1
10 1.8*pi boundary 1
edges
1 1 2 boundary 1
2 2 3 boundary 1
3 3 4 boundary 1
4 4 5 boundary 1
5 5 6 boundary 1
6 6 7 boundary 1
7 7 8 boundary 1
8 8 9 boundary 1
9 9 10 boundary 1
10 10 1 boundary 1
read // some initialization commands
r 2 // refining twice produces 40 vertices
unset vertices boundary 1 // release from parametric curve
unset edges boundary 1
set edge tension 0 // get rid of default tension energy
set edge color white where id <= edge_count/2 // dashed coloring
// Set all quantity moduli to zero
zero_moduli := {
bending_energy.modulus := 0;
conduct_energy.modulus := 0;
insul_energy.modulus := 0;
buck_energy.modulus := 0;
proj_energy.modulus := 0;
circle_energy.modulus := 0;
}
// Set up individual types of energy
set_bending := { zero_moduli; bending_energy.modulus := 1; }
set_conduct := { zero_moduli; conduct_energy.modulus := 1; }
set_insul := { zero_moduli; insul_energy.modulus := 1; }
set_buck := { zero_moduli; buck_energy.modulus := 1; }
set_proj := { zero_moduli; proj_energy.modulus := 1; }
set_circle := { zero_moduli; circle_energy.modulus := 1; }
// Set up type of length constraint
hooke_length := total_length/edge_count;
set edge hooke_size total_length/edge_count;
set_length := { fix knot_length; hooke.modulus := 0; hooke2.modulus := 0; }
set_hooke := { unfix knot_length; hooke.modulus := 1000; hooke2.modulus := 0; }
set_hooke2 := { unfix knot_length; hooke.modulus := 0; hooke2.modulus := 1000; }
// Sample evolution
gogo := { g 50; U; g 50; }
evolver-2.30c.dfsg/fe/zebra.cmd 0000755 0001753 0001753 00000003011 11410765113 016606 0 ustar hazelsct hazelsct // zebra.cmd
// Evolver command to alternately color string edges black and white
// Usage: Set color1 and color2 to the two colors you want, if the
// default black and white are not suitable. Then run "zebra".
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
color1 := white
color2 := black
zebra := {
local ecount,first_e,v_id,zcolor,zinx,e_id;
ecount := 0; // for safety
// Look for valence 2 vertices with same color edges and
// propagate zebra coloring in both directions.
foreach vertex vv where valence==2 and vv.edge[1].color == vv.edge[2].color do
{
first_e := vv.edge[1].oid;
v_id := vv.id;
zcolor := color1;
for ( zinx := 1 ; zinx <= 2 ; zinx += 1 )
{
// follow connected edges
e_id := first_e;
do
{ set edge[e_id] color zcolor;
v_id := edge[e_id].vertex[2].id;
if vertex[v_id].valence != 2 then break;
if vertex[v_id].edge[1].oid == -e_id then
e_id := vertex[v_id].edge[2].oid
else
e_id := vertex[v_id].edge[1].oid;
zcolor := (zcolor == color1) ? color2 : color1;
ecount := ecount + 1;
} while ( (v_id != vv.id) and (ecount <= edge_count) );
if ( v_id == vv.id ) then break; // don't need to go around the other way
// set things up to go around other way next time through the loop.
v_id := vv.id;
zcolor := color2;
first_e := vv.edge[2].oid;
}
} // end valence 2 vertex loop
} // end zebra
evolver-2.30c.dfsg/fe/mylarcube.fe 0000644 0001753 0001753 00000014636 11410765113 017331 0 ustar hazelsct hazelsct // mylarcube.fe
// By Kenneth Brakke, Feb. 17, 2002
// Evolver data for mylar cube. Idea is to deform cube
// without stretching to maximize volume. Implemented with
// relaxed_elastic_A method, which permits a little stretching, but
// shrinks freely. Can crank up the elastic modulus to get
// effective no stretching. The relaxed_elastic_A method calculates
// the Cauchy-Green strain tensor of a facet, and then uses
// Poisson's ratio to get the stress tensor. Then it calculates
// the stress eigenvalues, and assigns energy proportional to the
// square of positive eigenvalues, but zero energy for negative
// eigenvalues. So it permits effective wrinkling. The original
// unstretched shape of a facet is remembered in an extra facet
// attribute named form_factors, which has the components of the
// Gram matrix of the unstretched facet. This datafile assumes the
// initial surface is unstretched, and sets the form_factors in
// the "read" section below. To recompute form factors after refining,
// there is also a vertex attribute that holds the unstretched
// vertex coordinates. The "r" command has been redefined in the
// "read" section to properly adjust the form factors. DO NOT refine
// or modify the triangulation in any other way than using the "r"
// command, unless you want to take responsibility for fixing up
// the form factors.
// The Poisson ratio in this datafile is set to be 0.80 in the "read"
// section. This was the Poisson ratio used in the project that
// relaxed_elastic_A was originally developed for: modeling high-altitude
// balloons. A couple of test runs with lower Poisson ratio led to
// indefinite hessians at the end, so I am leaving the ratio as 0.80.
// Evolving hints: See the sample evolution "gogo" below. The idea is
// to ramp up the elastic modulus as you refine and approach the final
// shape. For final convergence, use "hessian_seek" instead of "hessian",
// since "hessian" has a tendency to blow up the surface here, and
// "hessian_seek" prevents that by doing a minimum-energy search along
// the direction to the putative hessian minimum. Note that the energy
// contribution of the elastic is inversely proportional to the elastic
// modulus. I'm not sure how high you can get the modulus effectively;
// at least 1000000. Extrapolate to infinite modulus for unstretchable
// mylar.
// If you want confirmation at the end that there is little stretching
// going on, the command "echeck" below will print out a histogram of
// edge stretch factors.
// Do not try to do quadratic or lagrange models; relaxed_elastic_A is
// defined only for the linear model.
/***************************************************************************/
// Set volume to be maximized. Do this by setting energy to negative
// volume, since Evolver minimizes energy.
quantity cube_volume energy modulus -1 method facet_volume global
// Elastic energy.
// Stuff to do relaxed_elastic_A method
define facet attribute poisson_ratio real
// For defining unstretched facet shape
define facet attribute form_factors real[3]
// For resetting form_factors in refining
define vertex attribute ref_coord real[3]
define vertex attribute old_vid integer
define edge attribute old_eid integer
// This is the key energy to permit wrinkling but discourage stretching.
quantity stretch energy modulus 10 method relaxed_elastic_A global
// For components of stress
quantity stretch1 info_only method relaxed_elastic1_A global
quantity stretch2 info_only method relaxed_elastic2_A global
vertices
1 0.0 0.0 0.0
2 1.0 0.0 0.0
3 1.0 1.0 0.0
4 0.0 1.0 0.0
5 0.0 0.0 1.0
6 1.0 0.0 1.0
7 1.0 1.0 1.0
8 0.0 1.0 1.0
edges /* given by endpoints and attribute */
1 1 2
2 2 3
3 3 4
4 4 1
5 5 6
6 6 7
7 7 8
8 8 5
9 1 5
10 2 6
11 3 7
12 4 8
faces /* given by oriented edge loop */
1 1 10 -5 -9 tension 0
2 2 11 -6 -10 tension 0
3 3 12 -7 -11 tension 0
4 4 9 -8 -12 tension 0
5 5 6 7 8 tension 0
6 -4 -3 -2 -1 tension 0
bodies /* one body, defined by its oriented faces */
1 1 2 3 4 5 6
read
// refine original edges so better suited to detect creases
refine edge where id >= 1 and id <=12
set facet poisson_ratio 0.80
set vertex ref_coord[1] x;
set vertex ref_coord[2] y;
set vertex ref_coord[3] z;
// Set form factors so initial cube is unstretched.
set_form_factors := {
foreach facet ff do
{ set ff.form_factors[1]
(ff.vertex[2].ref_coord[1] - ff.vertex[1].ref_coord[1])^2
+ (ff.vertex[2].ref_coord[2] - ff.vertex[1].ref_coord[2])^2
+ (ff.vertex[2].ref_coord[3] - ff.vertex[1].ref_coord[3])^2;
set ff.form_factors[2]
(ff.vertex[2].ref_coord[1] - ff.vertex[1].ref_coord[1])
*(ff.vertex[3].ref_coord[1] - ff.vertex[1].ref_coord[1])
+ (ff.vertex[2].ref_coord[2] - ff.vertex[1].ref_coord[2])
*(ff.vertex[3].ref_coord[2] - ff.vertex[1].ref_coord[2])
+ (ff.vertex[2].ref_coord[3] - ff.vertex[1].ref_coord[3])
*(ff.vertex[3].ref_coord[3] - ff.vertex[1].ref_coord[3]);
set ff.form_factors[3]
(ff.vertex[3].ref_coord[1] - ff.vertex[1].ref_coord[1])^2
+ (ff.vertex[3].ref_coord[2] - ff.vertex[1].ref_coord[2])^2
+ (ff.vertex[3].ref_coord[3] - ff.vertex[1].ref_coord[3])^2;
}
}
set_form_factors;
// redefine the "r" command to adjust form factors.
r :::= {
set vertex old_vid id;
set edge old_eid id;
'r';
foreach vertex vv where old_vid == 0 do
{ vv.ref_coord[1] :=
avg(vv.edge ee where old_eid != 0,sum(ee.vertex where old_vid != 0,
ref_coord[1]));
vv.ref_coord[2] :=
avg(vv.edge ee where old_eid != 0,sum(ee.vertex where old_vid != 0,
ref_coord[2]));
vv.ref_coord[3] :=
avg(vv.edge ee where old_eid != 0,sum(ee.vertex where old_vid != 0,
ref_coord[3]));
};
set_form_factors;
recalc;
}
// check of how edge lengths stretched
echeck := { histogram(edge ee, ee.length/sqrt(
(ee.vertex[2].ref_coord[1] - ee.vertex[1].ref_coord[1])^2
+ (ee.vertex[2].ref_coord[2] - ee.vertex[1].ref_coord[2])^2
+ (ee.vertex[2].ref_coord[3] - ee.vertex[1].ref_coord[3])^2));
}
// Typical evolution
gogo := { g 10; r; g 10; stretch.modulus := 100; g 10; r; g 10;
conj_grad; g 20; r; g 50;
stretch.modulus := 1000; g 50;
stretch.modulus := 10000; g 150;
g 200; hessian_seek; hessian_seek; hessian_seek; hessian_seek;
}
evolver-2.30c.dfsg/fe/dirichlet_to_disk.cmd 0000755 0001753 0001753 00000012601 11410765113 021173 0 ustar hazelsct hazelsct // dirichlet_to_disk.cmd
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// For mapping simply connected regions to unit disk minimizing Dirichlet
// energy to get conformal mappings.
// Prerequisites: Dirichlet energy defined, but no others.
// Usage: Remove all constraints and boundaries. Run to_disk. Then evolve.
define constraint circle_con formula: x^2 + y^2 = 1
define facet attribute form_factors real[3]
set_ff := {
foreach facet ff do
{ ff.form_factors[1] := ff.edge[1].length^2;
ff.form_factors[2] := -(ff.edge[1].x*ff.edge[3].x
+ ff.edge[1].y*ff.edge[3].y);
ff.form_factors[3] := ff.edge[3].length^2;
}
}
// Mapping to triangle. Especially nice since can use the three conformal
// degrees of freedom to map particular vertices to corners, and straight
// sides should let Hessian minimize Dirichlet energy in one step.
define cornerx real[4];
cornerx[1] := 1.0;
cornerx[2] := 0.0;
cornerx[3] := -1.0;
cornerx[4] := 1.0;
define cornery real[4];
cornery[1] := 0.0;
cornery[2] := sqrt(3);
cornery[3] := 0.0;
cornery[4] := 0.0;
define constraint side_1_con formula: sqrt(3)*x + y = sqrt(3);
define constraint side_2_con formula: -sqrt(3)*x + y = sqrt(3);
define constraint side_3_con formula: y = 0;
define cornerv integer[3]
cornerv[1] := 0
cornerv[2] := 0
cornerv[3] := 0
define sidecounts integer[3] // how many sides mapped to each triangle side
to_triangle := {
// Check simple connectivity
if vertex_count - edge_count + facet_count != 1 then
{ errprintf "to_disk error: Surface not simply connected. Aborting.\n";
return;
};
set_ff; // set form factors
set facet tension 0;
// Go around outside edges, mapping to unit circle
unfix vertices;
if ( valid_element(vertex[cornerv[1]]) and
(sum(vertex[cornerv[1]].edge,valence==1) == 2) and
valid_element(vertex[cornerv[2]]) and
(sum(vertex[cornerv[2]].edge,valence==1) == 2) and
valid_element(vertex[cornerv[3]]) and
(sum(vertex[cornerv[3]].edge,valence==1) == 2) ) then
{ foreach vertex[cornerv[1]].edge where valence == 1 do
{ thise := oid;
break;
};
starte := thise;
counter := 0;
sidenumber := 1;
do
{ foreach edge[thise].vertex[2].edge eee where valence == 1 and
eee.id != thise do
{ nexte := eee.oid; break; };
thise := nexte;
counter += 1;
if ( (edge[thise].vertex[1].id == cornerv[1]) or
(edge[thise].vertex[1].id == cornerv[2]) or
(edge[thise].vertex[1].id == cornerv[3]) ) then
{ sidecounts[sidenumber] := counter;
counter := 0;
sidenumber += 1;
};
} while thise != starte;
}
else
{ printf "Legal corner vertices not given, so doing my own.\n";
rimcount := sum(edge,valence==1);
sidecounts[1] := rimcount idiv 3;
sidecounts[2] := rimcount idiv 3;
sidecounts[3] := rimcount - sidecounts[1] - sidecounts[2];
foreach edge ee where valence == 1 do { starte := ee.id; break; };
};
// Now go around moving vertices to triangle sides
thise := starte;
for ( sidenum := 1 ; sidenum <= 3; sidenum += 1 )
{
for ( counter := 1; counter <= sidecounts[sidenum] ; counter += 1 )
{ lambda := counter/sidecounts[sidenum];
edge[thise].vertex[1].x := (1-lambda)*cornerx[sidenum]
+ lambda*cornerx[sidenum+1];
edge[thise].vertex[1].y := (1-lambda)*cornery[sidenum]
+ lambda*cornery[sidenum+1];
if ( space_dimension > 2) then
edge[thise].vertex[1].x[3] := 0;
if sidenum == 1 then
set edge[thise].vertex[1] constraint side_1_con;
if sidenum == 2 then
set edge[thise].vertex[1] constraint side_2_con;
if sidenum == 3 then
set edge[thise].vertex[1] constraint side_3_con;
foreach edge[thise].vertex[2].edge eee where valence == 1 and
eee.id != thise do
{ nexte := eee.oid; break; };
thise := nexte;
};
};
// Big move with rim fixed, since movable rim can have negative
// eigenvalues.
fix vertex where on_constraint circle_con;
hessian;
unfix vertex;
}
to_disk := {
// Check simple connectivity
if vertex_count - edge_count + facet_count != 1 then
{ errprintf "to_disk error: Surface not simply connected. Aborting.\n";
return;
};
set_ff; // set form factors
set facet tension 0;
// Go around outside edges, mapping to unit circle
unfix vertices;
rimcount := sum(edge,valence==1);
foreach edge ee where valence == 1 do { starte := ee.id; break; };
thise := starte;
counter := 0;
do
{
edge[thise].vertex[1].x := cos(counter/rimcount*2*pi);
edge[thise].vertex[1].y := sin(counter/rimcount*2*pi);
if ( space_dimension > 2) then
edge[thise].vertex[1].x[3] := 0;
set edge[thise].vertex[1] constraint circle_con;
foreach edge[thise].vertex[2].edge eee where valence == 1 and
eee.id != thise do
{ nexte := eee.oid; break; };
thise := nexte;
counter += 1;
} while thise != starte;
// Big move with rim fixed, since movable rim can have negative
// eigenvalues.
fix vertex where on_constraint circle_con;
hessian;
unfix vertex;
}
// Prerequisites: Dirichlet energy defined, but no others.
// Usage: Remove all constraints and boundaries. Run to_disk. Then evolve.
evolver-2.30c.dfsg/fe/off.cmd 0000755 0001753 0001753 00000000735 11410765113 016267 0 ustar hazelsct hazelsct // off.cmd
// Surface Evolver command to print OFF format file.
// usage:
// do_off >>> "filename.off"
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
do_off := {
// file header
printf "OFF\n%g %g %g\n",vertex_count,facet_count,edge_count;
// vertex list
foreach vertex do { printf "%f %f %f \n",x,y,z };
// triangle list
foreach facet ff do
{ printf "3 ";
foreach ff.vertex do printf "%g ",id-1; printf "\n";
}
}
evolver-2.30c.dfsg/fe/twointor.fe 0000644 0001753 0001753 00000002640 11410765113 017223 0 ustar hazelsct hazelsct // twointor.fe
// Two Kelvin tetrakaidecahedra in a torus.
TORUS_FILLED
periods
1.000000 0.000000 0.000000
0.000000 1.000000 0.000000
0.000000 0.000000 1.000000
vertices
1 0.50 0.00 0.75
2 0.25 0.00 0.50
3 0.00 0.25 0.50
4 0.75 0.00 0.50
5 0.00 0.50 0.75
6 0.50 0.00 0.25
7 0.00 0.75 0.50
8 0.50 0.25 0.00
9 0.25 0.50 0.00
10 0.00 0.50 0.25
11 0.50 0.75 0.00
12 0.75 0.50 0.00
edges /* with torus wrap symbols */
1 1 2 * * *
2 2 3 * * *
3 1 4 * * *
4 3 5 * * *
5 2 6 * * *
6 2 7 * - *
7 1 8 * * +
8 4 6 * * *
9 5 9 * * +
10 3 10 * * *
11 3 4 - * *
12 6 8 * * *
13 6 11 * - *
14 7 4 - + *
15 8 12 * * *
16 9 8 * * *
17 9 11 * * *
18 10 7 * * *
19 11 1 * + -
20 12 5 + * -
21 5 7 * * *
22 11 12 * * *
23 10 12 - * *
24 9 10 * * *
faces
1 1 2 4 9 16 -7
2 -2 5 12 -16 24 -10
3 -4 10 18 -21
4 7 15 20 -4 11 -3
5 -1 3 8 -5
6 6 14 -11 -2
7 5 13 -17 24 18 -6
8 -12 13 19 7
9 -16 17 22 -15
10 -10 11 8 12 15 -23
11 -21 9 17 19 1 6
12 -14 -18 23 -22 -13 -8
13 -24 -9 -20 -23
14 -19 22 20 21 14 -3
bodies
1 -1 -2 -3 -4 -5 9 7 11 -9 10 12 5 14 3 volume 0.500
2 2 -6 -7 8 -10 -12 -11 -13 1 13 -14 6 4 -8 volume 0.500
read
// Typical evolution
gogo := { g 5; r; g 5; hessian; r; g 5; hessian; hessian; }
evolver-2.30c.dfsg/fe/orderdmp.cmd 0000755 0001753 0001753 00000002352 11410765113 017326 0 ustar hazelsct hazelsct // orderdmp.cmd
// Evolver command to number string vertices consecutively
// by means of extra attribute 'number',
// and create an ordered dump file.
// Pipe output to file to save it.
// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke
// Usage: oderdmp
define vertex attribute number integer
orderdmp := {
local e_id,newv_id,ecount,first_e,v_id,newe_id;
list topinfo;
ecount := 0; // for safety
// get starting edge, since can't assume edge[1] exists
foreach edge do e_id := id;
first_e := e_id;
v_id := edge[e_id].vertex[1].id;
// follow connected edges
printf "\nVertices\n";
do
{ set vertex[v_id] number ecount+1;
printf "%g %g %g %g\n",ecount+1,vertex[v_id].x,vertex[v_id].y,
vertex[v_id].z;
foreach edge[e_id].vertex vv do
{ if ( vv.id != v_id ) then
{ newv_id := vv.id;
foreach vv.edge ee do
if ee.id != e_id then newe_id := ee.id
}
};
e_id := newe_id; v_id := newv_id;
ecount := ecount + 1;
} while ( (e_id != first_e) and (ecount <= edge_count) );
printf "\nEdges\n";
foreach edge ee do
{
printf"%g %g %g \n",ee.id,ee.vertex[1].number,ee.vertex[2].number;
};
list bottominfo;
}
evolver-2.30c.dfsg/src/ 0000755 0001753 0001753 00000000000 11410765113 015215 5 ustar hazelsct hazelsct evolver-2.30c.dfsg/src/popfilm.c 0000644 0001753 0001753 00000513411 11410765113 017034 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/******************************************************************
*
* File: popfilm.c
*
* Purpose: Convert all tangent cones to minimal cones in
* soapfilm model.
*/
#include "include.h"
/*********************************************************************
*
* Function: popfilm()
*
* Purpose: Overall control of tangent cone minimization.
* Creates sorted list of vertex-facet incidences
* sorted on vertex. Analyzes tangent cone for each
* vertex and calls minimizer for the non-minimal.
*/
/* comparison routine for qsort */
static int vfcomp(a,b)
struct verfacet *a,*b;
{
if ( a->v_id < b->v_id ) return -1;
if ( a->v_id > b->v_id ) return 1;
return 0;
}
int popfilm()
{
int popped = 0;
if ( web.counts_reported & edge_pop_count_bit )
web.edge_pop_count = 0;
popped = edgepop_film();
web.counts_reported |= edge_pop_count_bit;
sprintf(msg,"Edges popped: %d\n",popped); outstring(msg);
popped = verpop_film();
return popped;
}
/********************************************************************
*
* Function: edgepop_film()
*
* Purpose: Reconfigure all edges with more than 3 facets into
* triple edges. Also does two or more facets with
* common edge on boundary or constraint.
*/
int edgepop_film()
{
edge_id e_id,sentinel;
int popped = 0;
/* Loop through all edges, popping as you go. New edges created
during popping will be scanned to see if they are still
pop-worthy.
*/
e_id = NULLEDGE;
while ( generate_all(EDGE,&e_id,&sentinel) )
{ popped += pop_one_edge(e_id);
}
return popped;
}
/***************************************************************************
*
* function: vertex_degfree()
*
* purpose: find degrees of freedom left by a vertex's constraints
*
*/
int vertex_degfree(v_id)
vertex_id v_id;
{ int degfree;
int vattr = get_vattr(v_id);
struct boundary *vbdry;
conmap_t *vmap;
int i;
/* Get degrees of freedom of vertex */
degfree = SDIM;
if ( vattr & FIXED ) degfree = 0;
else if ( vattr & BOUNDARY )
{ vbdry = get_boundary(v_id);
if ( (vbdry->attr & NONWALL) )
degfree = vbdry->pcount;
}
else if ( vattr & CONSTRAINT )
{ vmap = get_e_constraint_map(v_id);
for ( i = 1; i <= (int)vmap[0] ; i++ )
if (!((get_constraint(vmap[i])->attr)&(NONPOSITIVE|NONNEGATIVE|NONWALL)))
degfree--;
}
return degfree;
}
/***************************************************************************
*
* function: edge_degfree()
*
* purpose: find degrees of freedom left by a edge's constraints
*
*/
int edge_degfree(e_id)
edge_id e_id;
{ int degfree;
int eattr = get_eattr(e_id);
struct boundary *ebdry;
conmap_t *emap;
int i;
/* Get degrees of freedom of edge */
degfree = SDIM;
if ( eattr & FIXED ) degfree = 0;
else if ( eattr & BOUNDARY )
{ ebdry = get_edge_boundary(e_id);
if ( (ebdry->attr & NONWALL) )
degfree = ebdry->pcount;
}
else if ( eattr & CONSTRAINT )
{ emap = get_e_constraint_map(e_id);
for ( i = 1; i <= (int)emap[0] ; i++ )
if (!((get_constraint(emap[i])->attr)&(NONPOSITIVE|NONNEGATIVE|NONWALL)))
degfree--;
}
return degfree;
}
/***************************************************************************
*
* function: facet_degfree()
*
* purpose: find degrees of freedom left by a facet's constraints
*
*/
int facet_degfree(f_id)
facet_id f_id;
{ int degfree;
int fattr = get_fattr(f_id);
struct boundary *fbdry;
conmap_t *fmap;
int i;
/* Get degrees of freedom of edge */
degfree = SDIM;
if ( fattr & FIXED ) degfree = 0;
else if ( fattr & BOUNDARY )
{ fbdry = get_facet_boundary(f_id);
if ( (fbdry->attr & NONWALL) )
degfree = fbdry->pcount;
}
else if ( fattr & CONSTRAINT )
{ fmap = get_f_constraint_map(f_id);
for ( i = 1; i <= (int)fmap[0] ; i++ )
if (!((get_constraint(fmap[i])->attr)&(NONPOSITIVE|NONNEGATIVE|NONWALL)))
degfree--;
}
return degfree;
}
/********************************************************************
*
* Function: pop_one_edge()
*
* Purpose: Try popping one edge. Tests for more than 3 facets.
* Also does two or more facets with
* common edge on boundary or constraint.
*/
REAL new_displacement[MAXCOORD]; /* one normal of splittin wedge */
int pop_one_edge(e_id)
edge_id e_id;
{
int facet_count = 0;
facetedge_id fe_id,fe,key_fe=NULLID,new_key;
REAL side[MAXCOORD],sideA[MAXCOORD],sideB[MAXCOORD];
REAL normA,normB,normalA[MAXCOORD],normalB[MAXCOORD];
REAL maxcos,newcos;
int didsplit;
int foundwedge;
facetedge_id first_fe;
int eattr = get_eattr(e_id);
facet_id f1,f2;
int attr1,attr2;
int i,k;
REAL midnormal[MAXCOORD];
int popped = 0;
int degfree; /* degrees of freedom of edge */
int fdegfree,next_fdegfree;
int popattr = -1; /* in case of kraynikpop */
int kraynikwedge; /* whether current wedge has kraynik preference */
int foundkraynik;
int maxffree; /* maximum degrees of freedom of adjacent facets */
int maxffreen; /* number of adjacent facets with that freedom */
int septum_flag=1; /* whether to put in septum joining popped edges */
/* count facets around edge */
fe_id = first_fe = get_edge_fe(e_id);
maxffree = 0; maxffreen = 0;
if ( valid_id(fe_id) )
do
{ int ffree = facet_degfree(get_fe_facet(fe_id));
if ( ffree > maxffree )
{ maxffree = ffree; maxffreen = 1; }
else if ( ffree == maxffree ) maxffreen ++;
facet_count++;
fe_id = get_next_facet(fe_id);
} while ( valid_id(fe_id) && !equal_id(fe_id,first_fe) );
/* only pop if more than 3 facets, or a wall or wire */
if ( !(eattr & (FIXED|BOUNDARY|CONSTRAINT) && (maxffreen >= 2))
&& !(maxffreen > 3) )
return 0;
/* Get degrees of freedom of edge */
degfree = edge_degfree(e_id);
if ( (facet_count == 3) && (degfree == SDIM) ) return 0;
if ( kraynikpopedge_flag )
{ /* find facets that disagree on edge_pop_attribute */
popattr = find_attribute(FACET,"edge_pop_attribute");
}
foundwedge = 0;
foundkraynik = 0;
if ( pop_disjoin_flag && (facet_count == 4) )
{ /* test for merging Plateau borders */
facetedge_id fea,feb,fec,fed;
body_id ba,bb,bc,bd;
fea = get_edge_fe(e_id);
feb = get_next_facet(fea);
fec = get_next_facet(feb);
fed = get_next_facet(fec);
ba = get_facet_body(get_fe_facet(fea));
bb = get_facet_body(get_fe_facet(feb));
bc = get_facet_body(get_fe_facet(fec));
bd = get_facet_body(get_fe_facet(fed));
if ( valid_id(ba) && equal_id(ba,bc) )
{ key_fe = feb;
foundwedge = 1;
septum_flag = 0;
}
else if ( valid_id(bb) && equal_id(bb,bd) )
{ key_fe = fea;
foundwedge = 1;
septum_flag = 0;
}
}
if ( !foundwedge )
{
/* find narrowest wedge to pull out */
get_edge_side(e_id,side);
maxcos = -2.0; /* for finding minimum angle between facets */
/* find first facet normal */
fe = get_edge_fe(e_id);
get_fe_side(get_next_edge(fe),sideA);
cross_prod(side,sideA,normalA);
normA = sqrt(SDIM_dot(normalA,normalA));
next_fdegfree = fdegfree = facet_degfree(get_fe_facet(fe));
for ( i = 0 ; i < facet_count ; i++ )
{ facetedge_id next_fe;
next_fe = get_next_facet(fe);
fdegfree = next_fdegfree;
next_fdegfree = facet_degfree(get_fe_facet(next_fe));
/* test wedge for compatibility */
if ( fdegfree < 3 ) continue;
if ( next_fdegfree < 3 ) continue;
f1 = get_fe_facet(fe);
f2 = get_fe_facet(next_fe);
attr1 = get_fattr(f1);
attr2 = get_fattr(f2);
if ( get_facet_boundary(f1) != get_facet_boundary(f2) )
continue;
if ( (attr1 & CONSTRAINT) || (attr2 & CONSTRAINT) )
{ conmap_t *map1 = get_f_constraint_map(f1);
conmap_t *map2 = get_f_constraint_map(f2);
conmap_t ii,jj,found;
found = 0;
for ( ii = 1 ; ii <= map1[0] ; ii++ )
{ for ( jj = 1; jj <= map2[0] ; jj++ )
if ( map1[ii] == map2[jj] ) found++;
}
if ( (found != map1[0]) || ( found != map2[0]) )
continue;
}
if ( (facet_count <= 3) &&
((fdegfree <= degfree)||(next_fdegfree <= degfree) ) )
continue; /* fake wall */
/* get normal */
get_fe_side(get_next_edge(next_fe),sideB);
cross_prod(side,sideB,normalB);
normB = sqrt(SDIM_dot(normalB,normalB));
newcos = SDIM_dot(normalA,normalB)/normA/normB;
/* If phases in effect, can estimate force */
if ( phase_flag )
{ REAL tensionA = get_facet_density(f1);
REAL tensionB = get_facet_density(f2);
REAL tensionC; /* for the proposed interface */
REAL force1;
REAL sum;
int ii = get_b_phase(get_facet_body(f1));
int jj = get_b_phase(get_facet_body(inverse_id(f2)));
tensionC = phase_data[ii][jj];
for ( k = 0, sum = 0.0 ; k < SDIM ; k++ )
{ REAL term =
(tensionA*normalA[0]/normA + tensionB*normalB[0]/normB);
sum += term;
}
force1 = sqrt(sum);
newcos = force1 - tensionC;
}
if ( popattr >= 0 ) /* kraynikpop test */
{ kraynikwedge = ( *(int*)get_extra(f1,popattr) !=
*(int*)get_extra(f2,popattr) );
}
else kraynikwedge = 0;
if ( ((newcos > maxcos) && (kraynikwedge >= foundkraynik))
|| (kraynikwedge > foundkraynik) )
{ key_fe = next_fe;
maxcos = newcos;
for ( k = 0 ; k < SDIM ; k++ )
midnormal[k] = normalA[k]/normA + normalB[k]/normB;
cross_prod(midnormal,side,new_displacement);
}
if ( kraynikwedge ) foundkraynik = 1;
/* set up for next angle */
normA = normB;
memcpy((char *)normalA,(char *)normalB,sizeof(normalA));
fe = next_fe;
}
/* now a little check just to make sure things happened as planned */
if ( (facet_count >= 4) && (maxcos < 0.0) && !foundkraynik )
{ sprintf(errmsg,
"Can't find poppable pair of facets on poppable edge %s.\n",
ELNAME(e_id));
kb_error(1299,errmsg, RECOVERABLE);
}
}
if ( !valid_id(key_fe) ) return 0;
/* check boundary and constraint compatibility of wedge */
/* test to see if we really want to do this pop */
f1 = get_fe_facet(key_fe);
f2 = get_fe_facet(get_next_edge(key_fe));
attr1 = get_fattr(f1);
attr2 = get_fattr(f2);
if ( (attr1 & FIXED) || (attr2 & FIXED) )
return 0;
if ( get_facet_boundary(f1) != get_facet_boundary(f2) )
return 0;
if ( (attr1 & CONSTRAINT) || (attr2 & CONSTRAINT) )
{ conmap_t *map1 = get_e_constraint_map(f1);
conmap_t *map2 = get_e_constraint_map(f2);
conmap_t ii,jj,found;
found = 0;
for ( ii = 1 ; ii <= map1[0] ; ii++ )
{
for ( jj = 1; jj <= map2[0] ; jj++ )
if ( map1[ii] == map2[jj] ) found++;
}
if ( (found != map1[0]) || ( found != map2[0]) )
return 0;
}
if ( verbose_flag )
{ sprintf(msg,"Popping edge %s\n",ELNAME(e_id));
outstring(msg);
}
didsplit = 0;
if ( (facet_count == 2) && (degfree==2) )
{ /* special treatment, since may split either way */
popped = two_split(key_fe,septum_flag);
if ( popped ) return popped; /* else do Y pull-out */
}
/* try propagating split forward */
new_key = key_fe;
while ( try_prop(&new_key,key_fe,septum_flag) )
{ didsplit = 1;
if ( verbose_flag )
{ sprintf(msg," Propagating pop to edge %s\n",ELNAME(get_fe_edge(new_key)));
outstring(msg);
}
popped++;
}
/* try propagating split backward */
new_key = inverse_id(get_prev_facet(key_fe));
while ( try_prop(&new_key,inverse_id(get_prev_facet(key_fe)),septum_flag) )
{ didsplit = 1;
if ( verbose_flag )
{ sprintf(msg," Propagating pop to edge %s\n",ELNAME(get_fe_edge(key_fe)));
outstring(msg);
}
popped++;
}
/* if can't split forward or backward, divide edge and split */
if ( !didsplit )
{
edge_refine(e_id);
popped += pop_one_edge(e_id); /* try again */
}
return popped;
} /* end pop_one_edge */
/***********************************************************************
*
* Function: try_prop()
*
* Purpose: Sees if vertex at head of *pass_key can be split.
* If it can, it does. If split can be propagated
* further, it returns the next edge to try in *pass_key.
* If the vertex was split, it returns 1, else 0.
* Does not split FIXED vertices. Or BOUNDARY vertices.
*/
int try_prop(pass_key,start_key,septum_flag)
facetedge_id *pass_key;
facetedge_id start_key; /* to check for complete loop */
int septum_flag; /* whether to put septum between popped edges */
{
int splitflag;
int propflag;
facetedge_id wing_fe;
facetedge_id flip_fe;
facetedge_id new_key=0;
facetedge_id key_fe = *pass_key;
edge_id e_id = get_fe_edge(key_fe);
edge_id next_e=0;
if ( !valid_id(*pass_key) ) return 0;
/* if ( get_vattr(get_fe_headv(key_fe)) & FIXED ) return 0; */
/* don't even try if valence is already <= 3 */
/*if ( get_edge_valence(e_id) <= 3 ) return 0; */
/* swing forward on one side until find multiple edge */
flip_fe = inverse_id(key_fe);
for (;;)
{
wing_fe = get_next_edge(inverse_id(flip_fe));
if ( equal_id(wing_fe,start_key) )
{ /* have made complete loop around */
splitflag = 1;
propflag = 0;
break;
}
flip_fe = get_next_facet(wing_fe);
if ( equal_id(wing_fe,flip_fe) )
{ /* dead end on wing, so OK to split vertex maybe */
if ( edge_degfree(get_fe_edge(wing_fe)) >= 2 )
splitflag = 1;
else splitflag = 0;
propflag = 0;
break;
}
if ( !equal_id(wing_fe,get_next_facet(flip_fe))
|| (get_eattr(get_fe_edge(wing_fe)) & (FIXED|BOUNDARY|CONSTRAINT)) )
{ /* have found multiple edge, or wall or wire */
next_e = get_fe_edge(wing_fe);
if ( !equal_element(e_id,next_e) )
{ /* have found legitimate next edge */
splitflag = 1;
propflag = 1;
new_key = wing_fe;
break;
}
if ( equal_element(wing_fe,get_prev_facet(key_fe)) )
{ /* have cirque, so OK to split, but no propagation */
splitflag = 1;
propflag = 0;
}
else
{ /* have cirque crossing proposed split */
/* which ends propagation */
splitflag = 0;
propflag = 0;
}
break;
}
}
if ( !splitflag ) return 0;
/* swing forward on other side until find multiple edge */
flip_fe = inverse_id(get_prev_facet(key_fe));
for (;;)
{
wing_fe = get_next_edge(inverse_id(flip_fe));
flip_fe = get_next_facet(wing_fe);
if ( equal_id(wing_fe,flip_fe) )
{ /* dead end on wing, so OK to split vertex maybe */
if ( edge_degfree(get_fe_edge(wing_fe)) < 2 )
splitflag = 0;
propflag = 0;
break;
}
if ( !equal_id(wing_fe,get_next_facet(flip_fe))
|| (get_eattr(get_fe_edge(wing_fe)) & (FIXED|BOUNDARY|CONSTRAINT)) )
{ /* have found multiple edge */
if ( !equal_id(get_fe_edge(wing_fe),next_e) )
{
/* can't split; have serious nonminimal vertex */
splitflag = 0;
propflag = 0;
break;
}
else /* check normals */
{
}
break;
}
}
if ( !propflag ) new_key = NULLFACETEDGE;
/* check to see if new_key is already just triple */
{ facetedge_id feb = get_next_facet(new_key);
facetedge_id fec = get_next_facet(feb);
facetedge_id fed = get_next_facet(fec);
if ( equal_id(fec,new_key) )
{ /* can't split further */
splitflag = 0;
}
else if ( equal_id(fed,new_key) )
{ /* already triple edge; split and stop */
propflag = 0;
}
}
if ( splitflag ) versplit(key_fe,new_key,septum_flag);
if ( !propflag ) new_key = NULLFACETEDGE;
*pass_key = new_key;
return splitflag;
} /* end try_prop */
/**********************************************************************
*
* Function: versplit()
*
* Purpose: Split a wedge of facets off a vertex along two edges.
* Old edges go with split wedge (old edges now proper
* minimal cones) and new edges have rest of old facets
* and await scanning for minimality. Arguments are
* facetedges for the two edges inside the wedge; if
* second is null, means there is no second edge.
* This is essentially the reverse of eliminating an edge.
*/
void versplit(fe_a,fe_b,septum_flag)
facetedge_id fe_a,fe_b;
int septum_flag;
{
vertex_id old_v = get_fe_headv(fe_a);
vertex_id new_v;
edge_id new_e=0,new_a=0,new_b=0,e_id;
edge_id old_a = get_fe_edge(fe_a);
edge_id old_b = get_fe_edge(fe_b);
facetedge_id fe_aa = get_prev_facet(fe_a);
facetedge_id fe_bb = get_prev_facet(fe_b);
facetedge_id fe_a_old,fe_a_new,fe_a_e;
facetedge_id fe_b_old=0,fe_b_new=0,fe_b_e=0;
facet_id new_fa,new_fb=0;
body_id b_id;
int i;
REAL *x;
int halfflag;
facetedge_id fe,first_fe;
int valence = get_edge_valence(old_a);
conmap_t *vmap,*emap,*fmap;
facetedge_id halffe;
/* create a new vertex, which will be split away with wedge */
new_v = dup_vertex(old_v);
x = get_coord(new_v);
for ( i = 0 ; i < SDIM ; i++ )
x[i] += 0.01*new_displacement[i];
if ( septum_flag )
{ /* create new edge between vertices */
new_e = new_edge(old_v,new_v,NULLID);
}
/* create new edges split off from wedge */
if ( !equal_id(get_prev_facet(fe_aa),fe_a) )
{
new_a = dup_edge(old_a);
insert_vertex_edge(get_edge_tailv(old_a),new_a);
insert_vertex_edge(old_v,inverse_id(new_a));
}
/* fix up attributes of old edge, in case pulling off wall */
unset_attr(old_a,FIXED);
set_edge_boundary_num(old_a,0);
unset_attr(old_a,BOUNDARY);
fmap = get_f_constraint_map(get_fe_facet(fe_a));
emap = get_e_constraint_map(old_a);
for ( i = 1 ; i <= (int)fmap[0] ; i++ )
emap[i] = fmap[i];
for ( ; i <= (int)emap[0] ; i++ ) emap[i] = 0;
emap[0] = fmap[0];
if ( emap[0] == 0 ) unset_attr(old_a,CONSTRAINT);
else set_attr(old_a,CONSTRAINT);
if ( valid_id(fe_b) )
{
new_b = dup_edge(old_b);
insert_vertex_edge(old_v,new_b);
insert_vertex_edge(get_edge_headv(old_b),inverse_id(new_b));
/* fix up attributes of old edge, in case pulling off wall */
unset_attr(old_b,FIXED);
set_edge_boundary_num(old_b,0);
unset_attr(old_b,BOUNDARY);
fmap = get_f_constraint_map(get_fe_facet(fe_b));
emap = get_e_constraint_map(old_b);
for ( i = 1 ; i <= (int)fmap[0] ; i++ )
emap[i] = fmap[i];
for ( ; i <= (int)emap[0] ; i++ ) emap[i] = 0;
emap[0] = fmap[0];
if ( emap[0] == 0 ) unset_attr(old_b,CONSTRAINT);
else set_attr(old_b,CONSTRAINT);
}
/* reset edge endpoints coming into new_v */
fe = fe_a;
halfflag = 0;
halffe = NULLID; /* for attributes of new_v */
do
{ e_id = get_fe_edge(fe);
remove_vertex_edge(old_v,inverse_id(e_id));
set_edge_headv(e_id,new_v);
if ( equal_id(fe,get_next_facet(fe)) )
{ halfflag = 1; /* need to go back and do other side of wedge */
halffe = fe;
break;
}
fe = get_next_facet(inverse_id(get_next_edge(fe)));
if ( !valid_id(halffe) ) halffe = fe;
} while ( !equal_id(fe,fe_a) );
if ( halfflag )
{ fe = get_prev_facet(inverse_id(get_next_edge(fe_aa)));
if ( !valid_id(halffe) ) halffe = fe;
do
{
e_id = get_fe_edge(fe);
remove_vertex_edge(old_v,inverse_id(e_id));
set_edge_headv(e_id,new_v);
if ( equal_id(fe,get_next_facet(fe)) )
break;
fe = get_prev_facet(inverse_id(get_next_edge(fe)));
} while ( !equal_id(fe,fe_aa) );
}
/* fix up attributes of new_v, which was clone of old_v */
unset_attr(new_v,FIXED);
if ( valid_id(halffe) )
{ /* set attributes to same as halffe */
e_id = get_fe_edge(halffe);
if ( get_eattr(e_id) & BOUNDARY )
{ if ( get_boundary(new_v) != get_edge_boundary(e_id) )
kb_error(2440,"Trying to pop vertex not on same boundary as incoming edge.",RECOVERABLE);
}
else
{ set_boundary_num(new_v,0);
unset_attr(new_v,BOUNDARY);
}
vmap = get_v_constraint_map(new_v);
emap = get_e_constraint_map(e_id);
for ( i = 1 ; i <= (int)emap[0] ; i++ ) vmap[i] = emap[i];
for ( ; i <= (int)vmap[0] ; i++ ) vmap[i] = 0;
vmap[0] = emap[0];
if ( vmap[0] ) set_attr(new_v,CONSTRAINT);
else unset_attr(new_v,CONSTRAINT);
}
if ( septum_flag )
{
/* fix up attributes of new_e, which was brand new */
if ( valid_id(halffe) )
{ /* set attributes to same as halffe */
e_id = get_fe_edge(halffe);
if ( get_eattr(e_id) & BOUNDARY )
{ set_edge_boundary_num(new_e,get_edge_boundary_num(e_id));
set_attr(new_e,BOUNDARY);
}
if ( get_eattr(e_id) & CONSTRAINT )
{ conmap_t *eemap = get_e_constraint_map(new_e);
emap = get_e_constraint_map(e_id);
for ( i = 1 ; i <= (int)emap[0] ; i++ ) eemap[i] = emap[i];
eemap[0] = emap[0];
set_attr(new_e,CONSTRAINT);
}
}
/* create two new facets */
new_fa = dup_facet(get_fe_facet(fe_a));
if ( valid_id(fe_b) )
{
new_fb = dup_facet(get_fe_facet(fe_b));
}
/* create new facet-edges */
fe_a_e = new_facetedge(new_fa,new_e);
fe_a_new = new_facetedge(new_fa,new_a);
fe_a_old = new_facetedge(new_fa,inverse_id(old_a));
if ( valid_id(fe_b) )
{
fe_b_e = new_facetedge(new_fb,inverse_id(new_e));
fe_b_new = new_facetedge(new_fb,new_b);
fe_b_old = new_facetedge(new_fb,inverse_id(old_b));
}
/* link elements to facet-edges */
set_edge_fe(old_a,inverse_id(fe_a_old));
set_edge_fe(new_a,fe_a_new);
set_edge_fe(new_e,fe_a_e);
set_facet_fe(new_fa,fe_a_new);
if ( valid_id(fe_b) )
{
set_edge_fe(old_b,inverse_id(fe_b_old));
set_edge_fe(new_b,fe_b_new);
set_facet_fe(new_fb,fe_b_new);
}
/* link edges around new facets */
set_next_edge(fe_a_e,fe_a_old);
set_next_edge(fe_a_old,fe_a_new);
set_next_edge(fe_a_new,fe_a_e);
set_prev_edge(fe_a_old,fe_a_e);
set_prev_edge(fe_a_new,fe_a_old);
set_prev_edge(fe_a_e,fe_a_new);
if ( valid_id(fe_b) )
{
set_next_edge(fe_b_e,fe_b_new);
set_next_edge(fe_b_old,fe_b_e);
set_next_edge(fe_b_new,fe_b_old);
set_prev_edge(fe_b_old,fe_b_new);
set_prev_edge(fe_b_new,fe_b_e);
set_prev_edge(fe_b_e,fe_b_old);
}
/* link facets around edges */
/* new middle edge */
if ( valid_id(fe_b) )
{ set_next_facet(fe_a_e,inverse_id(fe_b_e));
set_next_facet(fe_b_e,inverse_id(fe_a_e));
set_prev_facet(fe_a_e,inverse_id(fe_b_e));
set_prev_facet(fe_b_e,inverse_id(fe_a_e));
}
else
{ set_next_facet(fe_a_e,fe_a_e);
set_prev_facet(fe_a_e,fe_a_e);
}
/* facet A old edge */
set_next_facet(fe_a_old,inverse_id(fe_a));
set_prev_facet(fe_a_old,inverse_id(fe_aa));
/* facet A new edge */
if ( valence >= 3 )
{ set_next_facet(fe_a_new,get_next_facet(fe_a));
set_prev_facet(fe_a_new,get_prev_facet(fe_aa));
}
else
{ set_next_facet(fe_a_new,fe_a_new);
set_prev_facet(fe_a_new,fe_a_new);
}
/* reset old links */
set_next_facet(get_prev_facet(fe_a_old),fe_a_old);
set_prev_facet(get_next_facet(fe_a_old),fe_a_old);
set_next_facet(get_prev_facet(fe_a_new),fe_a_new);
set_prev_facet(get_next_facet(fe_a_new),fe_a_new);
/* reset edges of facet-edges around new edge */
fe = first_fe = get_edge_fe(new_a);
if ( valid_id(fe) ) do
{ set_fe_edge(fe,new_a);
fe = get_next_facet(fe);
} while ( valid_id(fe) && !equal_id(fe,first_fe) );
if ( valid_id(fe_b) )
{ /* facet B old edge */
set_next_facet(fe_b_old,inverse_id(fe_b));
set_prev_facet(fe_b_old,inverse_id(fe_bb));
/* facet B new edge */
set_next_facet(fe_b_new,get_next_facet(fe_b));
set_prev_facet(fe_b_new,get_prev_facet(fe_bb));
/* reset old links */
set_next_facet(get_prev_facet(fe_b_old),fe_b_old);
set_prev_facet(get_next_facet(fe_b_old),fe_b_old);
set_next_facet(get_prev_facet(fe_b_new),fe_b_new);
set_prev_facet(get_next_facet(fe_b_new),fe_b_new);
/* reset edges of facet-edges around new edge */
fe = first_fe = get_edge_fe(new_b);
if ( valid_id(fe) ) do
{ set_fe_edge(fe,new_b);
fe = get_next_facet(fe);
} while ( valid_id(fe) && !equal_id(fe,first_fe) );
}
/* set new facet bodies */
fe = get_next_facet(fe_a_new);
b_id = get_facet_body(get_fe_facet(fe));
set_facet_body(inverse_id(new_fa),b_id);
if ( valid_id(fe_b) )
set_facet_body(inverse_id(new_fb),b_id);
fe = inverse_id(get_prev_facet(fe_a_new));
b_id = get_facet_body(get_fe_facet(fe));
set_facet_body(new_fa,b_id);
if ( valid_id(fe_b) )
set_facet_body(new_fb,b_id);
/* Tension, if phases */
if ( phase_flag )
{ set_f_phase_density(new_fa);
if ( valid_id(fe_b) )
set_f_phase_density(new_fb);
}
/* set velocity, so can tell edge is supposed to grow */
{ REAL *velocity;
velocity = get_velocity(old_v);
for ( i = 0 ; i < SDIM ; i++ )
velocity[i] = -new_displacement[i];
velocity = get_velocity(new_v);
for ( i = 0 ; i < SDIM ; i++ )
velocity[i] = new_displacement[i];
}
} /* end if septum_flag */
else
{ /* no septum, so just reset facetedge links */
facetedge_id fe_a_next = get_next_facet(fe_a);
facetedge_id fe_aa_prev = get_prev_facet(fe_aa);
if ( !equal_id(fe_a_next,fe_aa) )
{
set_next_facet(fe_a,fe_aa);
set_prev_facet(fe_aa,fe_a);
set_next_facet(fe_aa_prev,fe_a_next);
set_prev_facet(fe_a_next,fe_aa_prev);
set_fe_edge(fe_a_next,new_a);
set_fe_edge(fe_aa_prev,new_a);
set_edge_fe(old_a,fe_a);
set_edge_fe(new_a,fe_a_next);
}
set_edge_headv(old_a,new_v);
if ( valid_id(fe_b) )
{ facetedge_id fe_b_next = get_next_facet(fe_b);
facetedge_id fe_bb_prev = get_prev_facet(fe_bb);
set_next_facet(fe_b,fe_bb);
set_prev_facet(fe_bb,fe_b);
set_next_facet(fe_bb_prev,fe_b_next);
set_prev_facet(fe_b_next,fe_bb_prev);
set_fe_edge(fe_b_next,new_b);
set_fe_edge(fe_bb_prev,new_b);
set_edge_tailv(old_b,new_v);
set_edge_fe(old_b,fe_b);
set_edge_fe(new_b,fe_b_next);
}
}
}
/***************************************************************************
*
* function: two_split()
*
* purpose: Handle special case of two facets meeting at an edge on a wall,
* with two degrees of freedom on the wall so splitting apart
* is legal.
*
* input: facetedge of edge known to have 2 facets and 2 degrees of freedom.
*
* return: Number of edges split.
*/
int two_split(key_fe,septum_flag)
facetedge_id key_fe; /* starting edge */
int septum_flag; /* no septum not implemented yet */
{
facetedge_id headsplitlist[10];
int headsplitcount = 0;
int headsplitflag = 0; /* whether to split end vertex */
facetedge_id tailsplitlist[10];
int tailsplitcount = 0;
int tailsplitflag = 0; /* 7hether to split end vertex */
facetedge_id fe_a,fe_aa,fe_aaa;
int stopflag;
int popped = 0;
int splitcount;
int i;
/* See how far potential split can be traced in each direction,
checking that Y split is not more suitable all the way.
*/
/* Try forward */
fe_a = key_fe;
headsplitflag = 1;
for (stopflag=0;!stopflag;)
{ int head_degfree;
int aa_degfree;
headsplitlist[headsplitcount++] = fe_a;
/* test head vertex */
head_degfree = vertex_degfree(get_fe_headv(fe_a));
if ( head_degfree == 0 )
{ /* can't split */
headsplitflag = 0;
break;
}
/* find next wall edge forward */
fe_aaa = inverse_id(fe_a);
do
{
fe_aa = inverse_id(get_next_edge(fe_aaa));
fe_aaa = get_next_facet(fe_aa);
if ( !equal_id(fe_aa,get_next_facet(fe_aaa)) )
{ /* run into valence more than 2, can't split head */
stopflag = 1;
headsplitflag = 0;
break;
}
if ( equal_id(fe_aa,fe_aaa) )
{ /* valence 1, could still split head */
aa_degfree = edge_degfree(get_fe_edge(fe_aa));
if ( aa_degfree < 2 ) headsplitflag = 0;
else headsplitflag = 1;
stopflag = 1;
break;
}
/* now have valence 2 */
aa_degfree = edge_degfree(get_fe_edge(fe_aa));
if ( aa_degfree == 2 )
{ /* back to wall */
if ( (facet_degfree(get_fe_facet(fe_aa)) != 3)
|| (facet_degfree(get_fe_facet(get_next_facet(fe_aa))) != 3) )
stopflag = 1;
break;
}
else if ( aa_degfree != 3 )
{ /* end of the line */
stopflag = 1;
}
} while ( aa_degfree == 3 );
fe_a = fe_aa;
} /* end of going forward */
/* go backward */
fe_a = inverse_id(key_fe);
tailsplitflag = 1;
for (stopflag=0;!stopflag;)
{ int tail_degfree;
int aa_degfree;
tailsplitlist[tailsplitcount++] = fe_a;
/* test tail vertex */
tail_degfree = vertex_degfree(get_fe_headv(fe_a));
if ( tail_degfree == 0 )
{ /* can't split */
tailsplitflag = 0;
break;
}
/* find next wall edge forward */
fe_aaa = inverse_id(fe_a);
do
{ fe_aa = inverse_id(get_next_edge(fe_aaa));
fe_aaa = get_next_facet(fe_aa);
if ( !equal_id(fe_aa,get_next_facet(fe_aaa)) )
{ /* run into valence more than 2, can't split tail */
stopflag = 1;
tailsplitflag = 0;
break;
}
if ( equal_id(fe_aa,fe_aaa) )
{ /* valence 1, could still split tail */
aa_degfree = edge_degfree(get_fe_edge(fe_aa));
if ( aa_degfree < 2 ) tailsplitflag = 0;
else tailsplitflag = 1;
stopflag = 1;
break;
}
/* now have valence 2 */
aa_degfree = edge_degfree(get_fe_edge(fe_aa));
if ( aa_degfree == 2 )
{ /* back to wall */
if ( (facet_degfree(get_fe_facet(fe_aa)) != 3)
|| (facet_degfree(get_fe_facet(get_next_facet(fe_aa))) != 3) )
stopflag = 1;
break;
}
else if ( aa_degfree != 3 )
{ /* end of the line */
stopflag = 1;
}
} while ( aa_degfree == 3 );
fe_a = fe_aa;
} /* end of going backward */
/* split things */
splitcount = headsplitcount + tailsplitcount - 1;
if ( (splitcount == 1) && !headsplitflag && !tailsplitflag )
return 0;
/* now get into one list for splitting */
for ( i = headsplitcount-1 ; i >= 0 ; i-- )
headsplitlist[i+tailsplitcount-1] = headsplitlist[i];
for ( i = 1 ; i < tailsplitcount ; i++ )
headsplitlist[tailsplitcount-i] = inverse_id(tailsplitlist[i]);
/* Test to see if all edges have their facets less than 90 degrees
apart, in which case we don't split, but let Y pull-out happen.
*/
for ( i = 0 ; i < splitcount ; i++ )
{ facetedge_id fe = headsplitlist[i];
facetedge_id fe_a = get_next_facet(fe);
REAL normal[MAXCOORD];
REAL normala[MAXCOORD];
get_facet_normal(get_fe_facet(fe),normal);
get_facet_normal(get_fe_facet(fe_a),normala);
if ( SDIM_dot(normal,normala) < 0 )
break; /* too wide */
}
if ( i == splitcount ) return 0;
/* split new edge off with facetedges in list */
for ( i = 0 ; i < splitcount ; i++ )
{ facetedge_id fe,fe_b,fe_c;
edge_id new_e,old_e;
fe = headsplitlist[i];
old_e = get_fe_edge(fe);
new_e = dup_edge(old_e);
if ( verbose_flag )
{ sprintf(msg,"Popping valence 2 edge %s on a constraint.\n",ELNAME(old_e));
outstring(msg);
}
insert_vertex_edge(get_edge_tailv(old_e),new_e);
insert_vertex_edge(get_edge_headv(old_e),inverse_id(new_e));
fe_a = get_next_facet(fe);
set_fe_edge(fe,new_e);
set_edge_fe(new_e,fe);
set_edge_fe(old_e,fe_a);
set_next_facet(fe,fe);
set_prev_facet(fe,fe);
set_next_facet(fe_a,fe_a);
set_prev_facet(fe_a,fe_a);
if ( (i > 0) || tailsplitflag )
{ vertex_id old_tail = get_edge_tailv(old_e);
vertex_id new_tail = dup_vertex(old_tail);
fe_b = fe;
fe_c = NULLID;
/* reconnect edges */
for (;;)
{
remove_vertex_edge(old_tail,get_fe_edge(fe_b));
set_edge_tailv(get_fe_edge(fe_b),new_tail);
if ( equal_id(fe_b,fe_c) ) break;
fe_c = inverse_id(get_prev_edge(fe_b));
fe_b = get_next_facet(fe_c);
}
}
if ( (i == splitcount-1) && headsplitflag )
{ vertex_id old_head = get_edge_headv(old_e);
vertex_id new_head = dup_vertex(old_head);
fe_b = fe;
fe_c = NULLID;
/* reconnect edges */
for (;;)
{
remove_vertex_edge(old_head,inverse_id(get_fe_edge(fe_b)));
set_edge_headv(get_fe_edge(fe_b),new_head);
if ( equal_id(fe_b,fe_c) ) break;
fe_c = inverse_id(get_next_edge(fe_b));
fe_b = get_next_facet(fe_c);
}
}
}
popped = splitcount;
return popped;
}
/**********************************************************************
Vertex popping.
*************************************************************************/
#define OTHERCONE 0
#define WIREBOUNDARY 1
#define PLANECONE 2
#define WIREWING 3
#define WIRECORNER 4
#define TRIPLE_EDGER 5
#define TETRAHEDRAL 6
#define KRAYNIKCONE 7
#define CUBECONE 8
#define ODD4CONE 9
static facetedge_id *felist; /* for cell-ordered list */
/*************************************************************************
*
* Function: verpop_film()
*
* Purpose: Pop vertices with non-minimal tangent cones. Assumes
* all edges are at most triple edges.
*/
int verpop_film()
{
int popcount = 0;
while ( find_vertex_to_pop() )
{ popcount++;
}
return popcount;
}
/************************************************************************
*
* function: find_vertex_to_pop
*
* purpose: Looks through all vertices and finds one to pop. Whole
* process restarts after each pop since popping makes
* search lists obsolete.
*
* Returns number popped (0 or 1)
*/
int find_vertex_to_pop()
{
struct verfacet *vflist;
facetedge_id fe;
facet_id f_id;
int count,maxcount;
int spot,dups,conetype;
int popcount = 0;
/* Allocate list, with room for each facet thrice */
maxcount = 3*web.skel[FACET].count;
vflist = (struct verfacet *)temp_calloc(sizeof(struct verfacet),maxcount);
/* create unsorted list */
count = 0;
FOR_ALL_FACETS(f_id)
{
vflist[count].f_id = f_id;
fe = get_facet_fe(f_id);
vflist[count].v_id = get_fe_tailv(fe);
count++;
fe = get_next_edge(fe);
vflist[count].f_id = f_id;
vflist[count].v_id = get_fe_tailv(fe);
count++;
fe = get_next_edge(fe);
vflist[count].f_id = f_id;
vflist[count].v_id = get_fe_tailv(fe);
count++;
if ( count > maxcount )
{
kb_error(1300,
"Internal error: Not enough structures allocated for vertex-facet list.\n",
RECOVERABLE);
return 0;
}
}
/* sort by vertex order */
qsort((char *)vflist,count,sizeof(struct verfacet),FCAST vfcomp);
/* go through list and pop appropriate vertices */
for ( spot = 0 ; spot < count ; spot += dups )
{
vertex_id v_id = vflist[spot].v_id;
/* find how many successive duplicates of current vertex */
for ( dups = 1 ; spot+dups < count ; dups++ )
if ( !equal_id(vflist[spot+dups].v_id,v_id) ) break;
if ( get_vattr(v_id) & FIXED ) continue;
conetype = cone_analyze(vflist + spot,dups);
if ( conetype == KRAYNIKCONE )
popcount += kraynik_pop(v_id,dups);
else if ( conetype == CUBECONE )
popcount += cubecone_pop(v_id,dups);
else if ( conetype == ODD4CONE )
popcount += odd4cone_pop(v_id,dups);
else if ( conetype == OTHERCONE )
popcount += pop_vertex(v_id,dups);
temp_free((char *)felist);
if ( popcount ) break; /* one vertex at a time */
}
temp_free((char *)vflist);
return popcount;
}
/**************************************************************************
*
* function: pop_given_vertex()
*
* purpose: pop vertex specified by user.
*
*/
int pop_given_vertex(v_id)
vertex_id v_id;
{
struct verfacet *vflist;
facetedge_id fe,start_fe,loop_fe;
facet_id f_id;
int count,maxcount;
int spot,dups,conetype;
int popcount = 0;
int con_hits;
if ( !valid_id(get_vertex_edge(v_id)) )
{ if ( !(get_vattr(v_id) & FIXED) )
{ if ( verbose_flag )
{ sprintf(msg,"Dissolving bare vertex %s\n",ELNAME(v_id));
outstring(msg);
}
free_element(v_id);
return 1;
}
}
if ( web.representation == STRING ) return pop_string_vertex(v_id);
con_hits = v_hit_constraint_count(v_id);
if ( con_hits )
return pop_constrained_vertex(v_id);
/* Allocate list, with room for each facet thrice */
maxcount = 3*web.skel[FACET].count;
vflist = (struct verfacet *)temp_calloc(sizeof(struct verfacet),maxcount);
/* create unsorted list */
count = 0;
start_fe = get_vertex_first_facet(v_id);
loop_fe = start_fe;
if ( !valid_id(loop_fe) )
return 0;
do
{ f_id = get_fe_facet(loop_fe);
vflist[count].f_id = f_id;
fe = get_facet_fe(f_id);
vflist[count].v_id = get_fe_tailv(fe);
count++;
fe = get_next_edge(fe);
vflist[count].f_id = f_id;
vflist[count].v_id = get_fe_tailv(fe);
count++;
fe = get_next_edge(fe);
vflist[count].f_id = f_id;
vflist[count].v_id = get_fe_tailv(fe);
count++;
if ( count > maxcount )
{
kb_error(2526,
"Internal error: Not enough structures allocated for vertex-facet list.\n",
RECOVERABLE);
return 0;
}
loop_fe = get_next_vertex_facet(v_id,loop_fe);
} while ( !equal_element(loop_fe,start_fe));
/* sort by vertex order */
qsort((char *)vflist,count,sizeof(struct verfacet),FCAST vfcomp);
/* go through list and pop appropriate vertices */
for ( spot = 0 ; spot < count ; spot += dups )
{
if ( v_id != vflist[spot].v_id ) { dups = 1; continue; }
/* find how many successive duplicates of current vertex */
for ( dups = 1 ; spot+dups < count ; dups++ )
if ( !equal_id(vflist[spot+dups].v_id,v_id) ) break;
if ( get_vattr(v_id) & FIXED ) continue;
conetype = cone_analyze(vflist + spot,dups);
if ( conetype == KRAYNIKCONE )
popcount += kraynik_pop(v_id,dups);
else if ( conetype == CUBECONE )
popcount += cubecone_pop(v_id,dups);
else if ( conetype == ODD4CONE )
popcount += odd4cone_pop(v_id,dups);
else if ( conetype == OTHERCONE )
popcount += pop_vertex(v_id,dups);
temp_free((char *)felist);
break; /* one vertex at a time */
}
temp_free((char *)vflist);
return popcount;
}
/**************************************************************************
*
* function: figure_type()
*
* purpose: figure out what type of tangent cone a vertex has.
*
*/
#define CELLMAX 300
#define ARCMAX 600
static struct cell { int start; /* arc list start in arclist */
int festart; /* starting place in felist */
int num; /* number of arcs */
int fenum; /* number of facetedges */
REAL area; /* external angle deficit */
body_id b_id; /* which body, if any */
} cell[CELLMAX];
static struct arc { int start; /* edge list start in felist */
int num; /* number of edges */
int valence; /* number of arcs into head node */
/* int headtype; */ /* type of head node */
} arclist[ARCMAX];
static int cells;
int figure_type ARGS((int));
int figure_type(arcs)
int arcs;
{ int k,type;
/* Classifying cone */
switch ( cells )
{
case 1: /* wire boundary */
type = WIREBOUNDARY;
break;
case 2: switch ( arcs )
{
case 2: /* internal plane */
type = PLANECONE;
break;
case 4: /* two wings on wire boundary */
type = WIREWING; /* minimality depends on angle */
break;
default: /* n boundary wires meet at center */
type = WIRECORNER;
break;
}
break;
case 3: switch ( arcs )
{
case 6: /* triple edge */
type = TRIPLE_EDGER;
for ( k = 0 ; k < cells ; k++ )
if ( cell[k].num != 2 ) type = OTHERCONE;
break;
default:
type = OTHERCONE;
break;
}
break;
case 4: switch ( arcs )
{
case 12: /* maybe tetrahedral cone */
{ int twos=0,threes=0,fours=0;
for ( k = 0 ; k < cells ; k++ )
{ switch ( cell[k].num )
{ case 2: twos++; break;
case 3: threes++; break;
case 4: fours++; break;
}
}
if ( threes == 4 )
type = TETRAHEDRAL;
else if ( twos==2 && fours==2 )
type = ODD4CONE;
else type = OTHERCONE;
}
break;
default:
type = OTHERCONE;
break;
}
break;
case 5: if ( !kraynikpopvertex_flag || (arcs != 18) )
{ type = OTHERCONE; break; }
type = KRAYNIKCONE;
for ( k = 0 ; k < cells ; k++ )
if ( (cell[k].num < 3) || (cell[k].num > 4) )
{ type = OTHERCONE; break; }
break;
case 6: type = CUBECONE;
if ( arcs != 24 )
{ type = OTHERCONE; break; }
for ( k = 0 ; k < cells ; k++ )
if ( cell[k].num != 4 )
{ type = OTHERCONE; break; }
break;
default:
type = OTHERCONE;
break;
}
return type;
}
/***************************************************************************
*
* function: cone_analyze()
*
* purpose: construct tangent cone structure around vertex and
* return cone type from figure_type().
*
*/
int cone_analyze(vf,count)
struct verfacet *vf;
int count;
{
int type; /* final classification */
facetedge_id fe,nextfe,ray,nextray;
vertex_id v_id = vf->v_id;
int cellstart,arcstart,cellsides;
int arclen,valence;
int arcs;
int k,j;
int nodeflag; /* whether any interesting node has been found for cell */
/* First, set up network structure of edges opposite central vertex */
felist = (facetedge_id *)temp_calloc(sizeof(facetedge_id),2*count);
/* fill with outside edges of facets */
for ( k = 0 ; k < count ; k++ )
{
fe = get_facet_fe(vf[k].f_id);
if ( equal_id(v_id,get_fe_tailv(fe)) )
fe = get_next_edge(fe);
else if ( equal_id(v_id,get_fe_headv(fe)) )
fe = get_prev_edge(fe);
felist[2*k] = fe;
felist[2*k+1] = inverse_id(fe);
}
/* order into arcs and cell boundaries */
k = 0; /* current edge number */
cells = 0; /* current cell number */
arcs = 0; /* current arc number */
while ( k < 2*count )
{
CELLSTART:
/* starting new cell */
if ( k >= 2*count ) break;
if ( cells >= CELLMAX )
{ sprintf(errmsg,"pop: Too many cells around vertex %s in cone_analyze().\n",
ELNAME(v_id));
kb_error(1301,errmsg, RECOVERABLE);
}
nodeflag = 0; /* whether interesting node found on cell */
cellstart = k;
cellsides = 0;
cell[cells].start = arcs;
ARCSTART:
/* starting new arc */
if ( arcs >= ARCMAX )
{ sprintf(errmsg,"pop: Too many arcs around vertex %s in cone_analyze().\n",
ELNAME(v_id));
kb_error(1302,errmsg, RECOVERABLE);
}
arcstart = k;
arclist[arcs].start = arcstart;
ARCRESTART:
arclen = 0;
for (k = arcstart; k < 2*count ;k++)
{
/* starting next edge */
arclen++;
fe = felist[k];
nextray = ray = get_next_edge(fe);
for ( valence = 1 ; ; valence++ )
{ nextray = get_next_facet(nextray);
if ( equal_id(nextray,ray) ) break;
}
nextray = get_next_facet(ray);
nextfe = get_next_edge(inverse_id(nextray));
if ( equal_id(nextfe,felist[cellstart]) ) /* have gone around */
{
arclist[arcs].num = arclen;
arclist[arcs].valence = valence;
arcs++;
cellsides++;
cell[cells].num = cellsides;
cells++;
k++;
goto CELLSTART;
}
/* linear search list until nextfe found */
for ( j = k+1 ; j < 2*count ; j++ )
if ( equal_id(nextfe,felist[j]) ) break;
if ( !equal_id(nextfe,felist[j]) )
{ sprintf(errmsg,
"Internal error: cone_analyze vertex %s: can't find nextfe in felist.\n",
ELNAME(v_id));
kb_error(1303,errmsg,RECOVERABLE);
}
if ( j > k+1 ) /* swap into place */
{
felist[j] = felist[k+1];
felist[k+1] = nextfe;
}
/* see if node between is interesting */
if ( (valence != 2))
{ /* have interesting node */
if ( nodeflag == 0 )
{ /* first interesting node for cell */
/* reset felist so cell and arc start are same */
felist[k] = felist[arcstart];
felist[arcstart] = nextfe;
felist[k+1] = fe;
nodeflag = 1;
goto ARCRESTART;
}
arclist[arcs].num = arclen;
arclist[arcs].valence = valence;
arcs++;
cellsides++;
k++;
goto ARCSTART;
}
}
}
type = figure_type(arcs); /* so stupid SUN can optimize */
return type;
}
/*******************************************************************
*
* Function: pop_vertex()
*
* Purpose: pops one non-minimal vertex using info found by
* cone_analyze(). Finds areas of each face. All
* face cones are pulled out to sphere except largest
* area. Special treatment for face with disjoint
* boundary.
*/
int pop_vertex(v_id,count)
vertex_id v_id;
int count; /* number of entries in vflist */
{
int i,j,k,m;
struct arc *ar;
int fenum;
facetedge_id fe;
REAL cosdef;
REAL prevnormal[MAXCOORD],prevnorm;
REAL thisnormal[MAXCOORD],thisnorm;
REAL maxarea = 0.0;
int bigcell=0;
REAL total_area = 0.0;
REAL total_angle,angle;
REAL side[MAXCOORD],ray[MAXCOORD];
REAL *vx,newx[MAXCOORD];
edge_id ray_e;
facetedge_id ray_fe;
vertex_id new_v;
conmap_t *old_conmap;
int old_bdrynum = -1;
int samecell2, othercell2;
body_id bs1,bs2,bo1,bo2;
REAL totside1length,totside2length;
int flipflag = 0; /* if cones switched in widecones */
if ( verbose_flag )
{ sprintf(msg,"Popping vertex %s\n",ELNAME(v_id));
outstring(msg);
}
/* fix up cell structures */
for ( i = 0 ; i < cells ; i++ )
{ cell[i].fenum = 0;
ar = arclist + cell[i].start;
cell[i].festart = ar->start;
for ( j = 0 ; j < cell[i].num ; j++, ar++ )
cell[i].fenum += ar->num;
}
/* check for special configuration of touching disjoint cones
that may want to be merged rather than split
*/
if ( (cells == 4) && (cell[0].num == 1) && (cell[1].num == 1)
&& (cell[2].num == 1) && (cell[3].num == 1) )
{ REAL cosa,bestcosa;
facetedge_id bestray1=NULLID, bestray2=NULLID,fe_1,fe_2;
int samecell,othercell;
REAL area1,area2,normal1[MAXCOORD],normal2[MAXCOORD];
REAL totnorm1[MAXCOORD],totnorm2[MAXCOORD];
REAL axis1[MAXCOORD], axis2[MAXCOORD];
REAL side1[MAXCOORD], side2[MAXCOORD];
facet_id f_1,f_2,f_septum=NULLID;
REAL ratio;
int middleflag = 0; /* whether to put in septum */
facetedge_id first_fe3=NULLID, prev_fe3, newfe3;
body_id b_1, b_2;
/* first, see which cells are really the same cones */
samecell = 0;
for ( i = 1 ; i < cells ; i++ )
{ for ( j = 0 ; j < cell[0].fenum ; j++ )
for ( k = 0 ; k < cell[i].fenum ; k++ )
if (equal_element(felist[cell[0].festart+j],felist[cell[i].festart+k]))
{ samecell = i;
break;
}
}
if ( samecell == 0 )
{ sprintf(errmsg,"Vertex %s looks like double cones but isn't.\n",
ELNAME(v_id));
kb_error(2890,errmsg,RECOVERABLE);
}
othercell = (samecell == 1) ? 2 : 1;
/* get axis and see if cones wide enough to pop this way */
area1 = area2 = 0.0;
memset((char*)axis1,0,sizeof(axis1));
memset((char*)axis2,0,sizeof(axis2));
memset((char*)totnorm1,0,sizeof(totnorm1));
memset((char*)totnorm2,0,sizeof(totnorm2));
totside1length = totside2length = 0.0;
for ( i = 0 ; i < cell[samecell].fenum ; i++ )
{ fe_1 = felist[cell[samecell].festart+i];
f_1 = get_fe_facet(fe_1);
get_facet_normal(f_1,normal1);
area1 += sqrt(dot(normal1,normal1,SDIM));
for ( j = 0 ; j < SDIM ; j++ )
totnorm1[j] += normal1[j];
get_fe_side(get_prev_edge(fe_1),side1);
for ( j = 0 ; j < SDIM ; j++ )
axis1[j] += side1[j];
totside1length += sqrt(dot(side1,side1,SDIM));
}
for ( i = 0 ; i < cell[othercell].fenum ; i++ )
{ fe_2 = felist[cell[othercell].festart+i];
f_2 = get_fe_facet(fe_2);
get_facet_normal(f_2,normal2);
area2 += sqrt(dot(normal2,normal2,SDIM));
for ( j = 0 ; j < SDIM ; j++ )
totnorm2[j] += normal2[j];
get_fe_side(get_prev_edge(fe_2),side2);
for ( j = 0 ; j < SDIM ; j++ )
axis2[j] += side2[j];
totside2length += sqrt(dot(side2,side2,SDIM));
}
if ( pop_disjoin_flag ) goto narrowcones;
if ( pop_enjoin_flag ) goto widecones;
/* test wideness */
ratio = (sqrt(dot(totnorm1,totnorm1,SDIM))+sqrt(dot(totnorm2,totnorm2,SDIM)))
/(area1 + area2);
if ( ratio < (middleflag?0.94:0.88) )
goto narrowcones;
widecones:
/* choose cones to get facet normals going same way */
for ( j = 1 ; j < cells ; j++ )
if ( (j != samecell) && (j != othercell) ) break;
othercell2 = j;
samecell2 = 0;
/*
if ( dot(axis2,totnorm2,SDIM) < 0 )
{ int tmp = othercell;
othercell = othercell2;
othercell2 = tmp;
}
if ( dot(axis1,totnorm1,SDIM) > 0 )
{ samecell2 = samecell;
samecell = 0;
}
*/
if ( dot(totnorm1,totnorm2,SDIM) < 0 )
{ int tmp = othercell;
othercell = othercell2;
othercell2 = tmp;
for ( i = 0 ; i < SDIM ; i++ )
{ axis2[i] *= -1;
totnorm2[i] *= -1;
}
}
if ( dot(axis1,totnorm1,SDIM)/totside1length >
dot(axis2,totnorm1,SDIM)/totside2length )
{ int tmp = othercell; othercell = samecell; samecell = tmp;
tmp = samecell2; samecell2 = othercell2; othercell2 = tmp;
}
bs1 = get_facet_body(get_fe_facet(felist[cell[samecell].festart]));
bs2 = get_facet_body(get_fe_facet(felist[cell[samecell2].festart]));
bo1 = get_facet_body(get_fe_facet(felist[cell[othercell].festart]));
bo2 = get_facet_body(get_fe_facet(felist[cell[othercell2].festart]));
if ( !equal_id(bs2,bo1) )
{ /* have to flip sides */
int tmp;
body_id btmp;
if ( !equal_id(bs1,bo2) )
{ /* no matching sides. Shouldn't happen. */
return 0;
}
tmp = othercell; othercell = othercell2; othercell2 = tmp;
btmp = bs1; bs1 = bs2; bs2 = btmp;
tmp = samecell; samecell = samecell2; samecell2 = tmp;
btmp = bo1; bo1 = bo2; bo2 = btmp;
}
/* test bodies to see if we want septum */
fe_1 = felist[cell[samecell].festart];
f_1 = get_fe_facet(fe_1);
fe_2 = felist[cell[othercell].festart];
f_2 = get_fe_facet(fe_2);
b_1 = get_facet_body(f_1);
b_2 = get_facet_body(inverse_id(f_2));
if ( !valid_id(b_1) || !valid_id(b_2) || !equal_id(b_1,b_2) )
{ middleflag = 1;
f_septum = dup_facet(f_1);
set_facet_body(f_septum,b_1);
set_facet_body(inverse_id(f_septum),b_2);
}
/* now find closest rays on opposite cells */
bestcosa = -1.0;
for ( i = 0 ; i < cell[samecell].fenum ; i++ )
{ REAL edge1[MAXCOORD],edge2[MAXCOORD];
facetedge_id ray1 = get_prev_edge(felist[cell[samecell].festart+i]);
get_fe_side(ray1,edge1);
for ( j = 0 ; j < cell[othercell].fenum ; j++ )
{ facetedge_id ray2 = get_prev_edge(felist[cell[othercell].festart+j]);
get_fe_side(ray2,edge2);
cosa = dot(edge1,edge2,SDIM)/sqrt(dot(edge1,edge1,SDIM)*
dot(edge2,edge2,SDIM));
if ( cosa > bestcosa )
{ bestray1 = ray1; bestray2 = ray2; bestcosa = cosa; }
}
}
/* get lower number of sides in first cone */
if ( cell[samecell].fenum > cell[othercell].fenum )
{ int tmp = samecell;
facetedge_id fetmp = bestray1;
samecell = othercell;
othercell = tmp;
bestray1 = bestray2;
bestray2 = fetmp;
flipflag = 1;
}
/* go around, inserting edges */
fe_1 = bestray1;
fe_2 = bestray2;
prev_fe3 = NULLID;
for ( j = 0 ; j < cell[samecell].fenum ; j++ )
{ edge_id e_1,e_1next,e_2next,newe;
facetedge_id fe_1next,fe_2next,newfe1,newfe2;
facet_id f_1,f_2;
vertex_id newv;
REAL *x;
e_1 = get_fe_edge(fe_1);
fe_1next = inverse_id(get_prev_edge(fe_1));
e_1next = get_fe_edge(fe_1next);
fe_2next = inverse_id(get_prev_edge(fe_2));
e_2next = get_fe_edge(fe_2next);
f_1 = get_fe_facet(fe_1next);
f_2 = get_fe_facet(fe_2next);
if ( j < cell[samecell].fenum - 1 )
{ newv = dup_vertex(v_id);
remove_vertex_edge(v_id,e_1next);
remove_vertex_edge(v_id,e_2next);
set_edge_tailv(e_1next,newv);
set_edge_tailv(e_2next,newv);
}
else newv = v_id;
get_edge_side(e_1next,side1);
get_edge_side(e_2next,side2);
x = get_coord(newv);
for ( k = 0 ; k < SDIM ; k++ )
x[k] += 0.25*(side1[k]+side2[k]);
newe = new_edge(get_edge_tailv(e_1),newv,e_1);
newfe1 = new_facetedge(f_1,newe);
newfe2 = new_facetedge(f_2,newe);
set_edge_fe(newe,newfe1);
set_prev_facet(newfe1,newfe2);
set_next_facet(newfe2,newfe1);
set_prev_facet(newfe2,newfe1);
set_next_facet(newfe1,newfe2);
if ( middleflag )
{ newfe3 = new_facetedge(f_septum,newe);
if ( flipflag )
{
set_prev_facet(newfe3,newfe2);
set_next_facet(newfe2,newfe3);
set_prev_facet(newfe1,newfe3);
set_next_facet(newfe3,newfe1);
}
else
{
set_prev_facet(newfe3,newfe1);
set_next_facet(newfe1,newfe3);
set_prev_facet(newfe2,newfe3);
set_next_facet(newfe3,newfe2);
}
if ( valid_id(prev_fe3) )
{ set_next_edge(prev_fe3,newfe3);
set_prev_edge(newfe3,prev_fe3);
prev_fe3 = newfe3;
}
else
{ first_fe3 = newfe3;
set_facet_fe(f_septum,first_fe3);
prev_fe3 = newfe3;
}
}
set_next_edge(newfe1,fe_1next);
set_prev_edge(fe_1next,newfe1);
set_prev_edge(newfe1,inverse_id(fe_1));
set_next_edge(inverse_id(fe_1),newfe1);
set_next_edge(newfe2,fe_2next);
set_prev_edge(fe_2next,newfe2);
set_prev_edge(newfe2,inverse_id(fe_2));
set_next_edge(inverse_id(fe_2),newfe2);
cross_cut(newfe1,fe_1next);
cross_cut(newfe2,fe_2next);
fe_1 = get_next_facet(fe_1next);
fe_2 = get_next_facet(fe_2next);
}
if ( middleflag )
{ set_next_edge(prev_fe3,first_fe3);
set_prev_edge(first_fe3,prev_fe3);
if ( cell[samecell].fenum > 3 )
face_triangulate(f_septum,cell[samecell].fenum);
}
return 1;
narrowcones: ; /* bailout if not poppable this way */
}
/* see if any cells are totally detachable */
for ( i = 0 ; i < cells ; i++ )
{ vertex_id newv;
ar = arclist + cell[i].start;
if ( (cell[i].num != 1) || (ar->valence != 2) ) continue;
/* now have one */
newv = dup_vertex(v_id);
for ( j = 0 ; j < ar->num ; j++ )
{ fe = felist[ar->start+j];
ray_e = get_fe_edge(get_next_edge(fe));
remove_vertex_edge(v_id,inverse_id(ray_e));
set_edge_headv(ray_e,newv);
}
return 1; /* safe to do only one at a time */
}
/* calculate areas of each cell */
for ( i = 0 ; i < cells ; i++ )
{
total_angle = 0.0;
fenum = cell[i].festart;
fe = felist[fenum+cell[i].fenum-1];
cell[i].b_id = get_facet_body(get_fe_facet(inverse_id(fe)));
get_fe_side(fe,side);
get_fe_side(get_prev_edge(fe),ray);
cross_prod(ray,side,prevnormal);
prevnorm = sqrt(SDIM_dot(prevnormal,prevnormal));
for ( k = 0 ; k < cell[i].fenum ; k++,fenum++ )
{
fe = felist[fenum];
get_fe_side(fe,side);
get_fe_side(get_prev_edge(fe),ray);
cross_prod(ray,side,thisnormal);
thisnorm = sqrt(SDIM_dot(thisnormal,thisnormal));
cosdef = SDIM_dot(prevnormal,thisnormal)/prevnorm/thisnorm;
if ( cosdef > 1.0 ) angle = 0.0;
else if ( cosdef < -1.0 ) angle = M_PI;
else angle = acos(cosdef);
if ( SDIM_dot(side,prevnormal) > 0.0 )
total_angle += angle;
else
total_angle -= angle; /* in case cell not convex */
/* set up for next loop */
prevnorm = thisnorm;
memcpy((char *)prevnormal,(char *)thisnormal,sizeof(prevnormal));
}
cell[i].area = 2*M_PI - total_angle;
total_area += cell[i].area;
}
/* kludge to adjust for 2*pi ambiguity in turning angle that can
affect badly shaped cells */
while ( total_area > 4*M_PI + 1 )
{ int maxi = -1;
REAL maxa = -1e30;
for ( i = 0 ; i < cells ; i++ )
if ( cell[i].area > maxa )
{ maxi = i; maxa = cell[i].area; }
cell[maxi].area -= 2*M_PI;
total_area -= 2*M_PI;
}
while ( total_area < 4*M_PI - 1)
{ int mini = -1;
REAL mina = 1e30;
for ( i = 0 ; i < cells ; i++ )
if ( cell[i].area < mina )
{ mini = i; mina = cell[i].area; }
cell[mini].area += 2*M_PI;
total_area += 2*M_PI;
}
if ( total_area < 4*M_PI - 0.00001 )
{ sprintf(errmsg,
"Solid angle deficit %g found around vertex %s. Not popped.\n",
(double)(4*M_PI-total_area), ELNAME(v_id));
kb_error(2176,errmsg,WARNING);
return 0;
}
if ( total_area > 4*M_PI + 0.00001 )
{ sprintf(errmsg,
"Solid angle excess %g found around vertex %s. Not popped.\n",
(double)(total_area-4*M_PI), ELNAME(v_id));
kb_error(2177,errmsg,WARNING);
return 0;
}
/* see which cell is the largest */
for ( i = 0 ; i < cells ; i++ )
if ( cell[i].area > maxarea )
{ bigcell = i; maxarea = cell[i].area; }
/* Now go around covering over all cells but bigcell or cells
bigger than hemisphere */
/* First, put new endpoint on all edges coming into v_id */
vx = get_coord(v_id);
old_conmap = get_v_constraint_map(v_id);
if ( get_vattr(v_id) & BOUNDARY )
{ old_bdrynum = get_vertex_boundary_num(v_id);
}
for ( j = 0 ; j < 2*count ; j++ )
{ REAL rayvec[MAXCOORD];
fe = felist[j];
ray_fe = get_prev_edge(fe);
if ( !equal_id(v_id,get_fe_tailv(ray_fe)) ) continue; /* done this */
ray_e = get_fe_edge(ray_fe);
get_edge_side(ray_e,rayvec);
for ( m = 0 ; m < SDIM ; m++ )
newx[m] = 0.5*rayvec[m] + vx[m];
new_v = new_vertex(newx,ray_e);
remove_vertex_edge(v_id,ray_e);
set_edge_tailv(ray_e,new_v);
if ( old_bdrynum >= 0 )
set_vertex_boundary_num(new_v,old_bdrynum);
else
set_v_conmap(new_v,old_conmap);
}
/* divide up old facets */
for ( j = 0 ; j < 2*count ; j++ )
{ facetedge_id new_fe,new_fe_next,new_fe_prev;
facetedge_id inray_fe;
vertex_id v1,v2;
edge_id new_e;
fe = felist[j];
ray_fe = get_prev_edge(fe);
inray_fe = get_next_edge(fe);
v1 = get_fe_tailv(ray_fe);
v2 = get_fe_headv(inray_fe);
/* Each facet gets covered twice. First time we put in edge;
second time triangulate the quadrilateral. This way we
can substitute the new inner fe for the old outer fe
in felist.
*/
if ( equal_id(inray_fe,get_prev_edge(ray_fe)) )
{ /* first time around */
/* put in new edge */
new_e = new_edge(v2,v1,get_fe_facet(fe));
new_fe = new_facetedge(get_fe_facet(fe),new_e);
set_edge_fe(new_e,new_fe);
set_next_edge(inray_fe,new_fe);
set_prev_edge(new_fe,inray_fe);
set_next_edge(new_fe,ray_fe);
set_prev_edge(ray_fe,new_fe);
if ( old_bdrynum >= 0 )
set_edge_boundary_num(new_e,old_bdrynum);
else
set_e_conmap(new_e,old_conmap);
/* stub fe's for cells on each side */
new_fe_prev = new_facetedge(NULLFACET,new_e);
new_fe_next = new_facetedge(NULLFACET,new_e);
set_next_facet(new_fe,new_fe_next);
set_next_facet(new_fe_next,new_fe_prev);
set_next_facet(new_fe_prev,new_fe);
set_prev_facet(new_fe,new_fe_prev);
set_prev_facet(new_fe_prev,new_fe_next);
set_prev_facet(new_fe_next,new_fe);
felist[j] = inverse_id(new_fe_next); /* new inner fe */
}
else
{ felist[j] = inverse_id(get_next_facet(get_next_edge(inray_fe)));
divide_quad(fe);
}
}
/* now connect up insides of cells */
for ( i = 0 ; i < cells ; i++ )
{
facet_id new_f=0,old_f;
facetedge_id prev_fe=0; /* last in edge chain */
fenum = cell[i].festart;
if ( (i != bigcell) && (cell[i].area < 2*M_PI) )
{ prev_fe = felist[fenum+cell[i].fenum-1];
old_f = facet_inverse(get_fe_facet(get_next_facet(prev_fe)));
new_f = dup_facet(old_f);
set_facet_body(new_f,cell[bigcell].b_id);
set_facet_body(inverse_id(new_f),cell[i].b_id);
set_facet_fe(new_f,prev_fe);
}
for ( k = 0 ; k < cell[i].fenum ; k++,fenum++ )
{
fe = felist[fenum];
if ( (i == bigcell) || (cell[i].area >= 2*M_PI) )
{ /* have to excise fe */
set_prev_facet(get_next_facet(fe),get_prev_facet(fe));
set_next_facet(get_prev_facet(fe),get_next_facet(fe));
free_element(fe);
}
else
{ /* hook into edge loop around facet */
set_prev_edge(fe,prev_fe);
set_next_edge(prev_fe,fe);
set_fe_facet(fe,new_f);
prev_fe = fe;
}
}
/* if necessary, triangulate new cell facet */
if ( (i != bigcell) && (cell[i].area < 2*M_PI) )
{ if ( cell[i].fenum >= 5 )
face_triangulate(new_f,cell[i].fenum);
else if ( cell[i].fenum == 4 )
divide_quad(get_facet_fe(new_f));
}
}
/* free original central vertex */
free_element(v_id);
return 1;
}
/*******************************************************************
*
* Function: kraynik_pop()
*
* Purpose: pops one non-minimal vertex of type KRAYNIKCONE.
*/
int kraynik_pop(v_id,count)
vertex_id v_id;
int count; /* number of entries in vflist */
{
int i,j,k,m,kk;
struct arc *ar;
facetedge_id fe;
vertex_id newv;
edge_id newe;
edge_id head_triples[3],tail_triples[3];
REAL tailside[MAXCOORD],headside[MAXCOORD];
REAL tailforce[MAXCOORD],headforce[MAXCOORD];
REAL mag;
/* find the 3-arc cells */
for ( k = 0 ; k < cells ; k++ )
if ( cell[k].num == 3 ) break;
for ( kk = k+1 ; kk < cells ; kk++ )
if ( cell[kk].num == 3 ) break;
if ( kk == cells )
return 0; /* failure */
for ( i = 0 ; i < SDIM ; i++ )
tailforce[i] = headforce[i] = 0.0;
/* get triple lines and vectors to see which way to pop */
for ( m = 0 ; m < 3 ; m++ )
{ ar = arclist + cell[k].start + m;
fe = felist[ar->start];
tail_triples[m] = get_fe_edge(get_prev_edge(fe));
get_edge_side(tail_triples[m],tailside);
mag = sqrt(dot(tailside,tailside,SDIM));
if ( mag != 0 )
for ( i = 0 ; i < SDIM ; i++ )
tailforce[i] += tailside[i]/mag;
ar = arclist + cell[kk].start + m;
fe = felist[ar->start];
head_triples[m] = get_fe_edge(get_prev_edge(fe));
get_edge_side(head_triples[m],headside);
mag = sqrt(dot(headside,headside,SDIM));
if ( mag != 0 )
for ( i = 0 ; i < SDIM ; i++ )
headforce[i] += headside[i]/mag;
}
if ( pop_to_face_flag || ( !pop_to_edge_flag &&
(dot(headforce,headforce,SDIM)+dot(tailforce,tailforce,SDIM) < 3)) )
return pop_vertex_to_tri(v_id,tail_triples);
newv = dup_vertex(v_id);
newe = new_edge(newv,v_id,NULLID);
/* go around the 3 arcs and reconfigure */
for ( m = 0 ; m < 3 ; m++ )
{ facetedge_id ray_fe,other_ray_fe,third_ray_fe;
facetedge_id newfe_a,newfe_b,newfe_c;
edge_id ray_e,newray_e;
facet_id newf;
ar = arclist + cell[k].start + m;
for ( j = 0 ; j < ar->num ; j++ )
{ fe = felist[ar->start+j];
ray_e = get_fe_edge(get_next_edge(fe));
remove_vertex_edge(v_id,inverse_id(ray_e));
set_edge_headv(ray_e,newv);
}
/* last one for splitting triple edge */
j = ar->num-1;
fe = felist[ar->start+j];
ray_fe = get_next_edge(fe);
ray_e = get_fe_edge(ray_fe);
newray_e = dup_edge(ray_e);
set_edge_headv(newray_e,v_id);
set_edge_tailv(newray_e,get_edge_tailv(ray_e));
other_ray_fe = inverse_id(get_prev_edge(felist[(ar+(m==2?-2:1))->start]));
third_ray_fe = get_next_facet(ray_fe);
if ( equal_id(third_ray_fe,other_ray_fe) )
third_ray_fe = get_prev_facet(ray_fe);
newf = dup_facet(get_fe_facet(third_ray_fe));
newfe_a = new_facetedge(newf,newe);
newfe_b = new_facetedge(newf,inverse_id(newray_e));
newfe_c = new_facetedge(newf,ray_e);
set_facet_fe(newf,newfe_a);
if ( m == 0 ) set_edge_fe(newe,newfe_a);
set_next_edge(newfe_a,newfe_b);
set_next_edge(newfe_b,newfe_c);
set_next_edge(newfe_c,newfe_a);
set_prev_edge(newfe_a,newfe_c);
set_prev_edge(newfe_b,newfe_a);
set_prev_edge(newfe_c,newfe_b);
if ( equal_id(ray_fe,get_next_facet(other_ray_fe)) )
{
set_next_facet(ray_fe,newfe_c);
set_prev_facet(newfe_c,ray_fe);
set_prev_facet(other_ray_fe,newfe_c);
set_next_facet(newfe_c,other_ray_fe);
}
else
{
set_prev_facet(ray_fe,newfe_c);
set_next_facet(newfe_c,ray_fe);
set_next_facet(other_ray_fe,newfe_c);
set_prev_facet(newfe_c,other_ray_fe);
}
set_edge_fe(ray_e,ray_fe);
set_edge_fe(newray_e,third_ray_fe);
set_next_facet(third_ray_fe,inverse_id(newfe_b));
set_prev_facet(third_ray_fe,inverse_id(newfe_b));
set_next_facet(inverse_id(newfe_b),third_ray_fe);
set_prev_facet(inverse_id(newfe_b),third_ray_fe);
set_fe_edge(third_ray_fe,newray_e);
set_edge_fe(newray_e,third_ray_fe);
if ( m == 1 )
{ set_next_facet(newfe_a,get_edge_fe(newe));
set_prev_facet(newfe_a,get_edge_fe(newe));
set_next_facet(get_edge_fe(newe),newfe_a);
set_prev_facet(get_edge_fe(newe),newfe_a);
}
else if ( m == 2 )
{ facetedge_id fe1 = get_edge_fe(newe);
facetedge_id fe2 = get_next_facet(fe1);
set_next_facet(newfe_a,fe2);
set_prev_facet(fe2,newfe_a);
set_prev_facet(newfe_a,fe1);
set_next_facet(fe1,newfe_a);
}
}
/* move a bit to avoid zero area facets */
new_vertex_average(newv,RAWEST);
new_vertex_average(v_id,RAWEST);
return 1; /* success */
}
/*******************************************************************
*
* Function: cubecone_pop()
*
* Purpose: pops one non-minimal vertex of type CUBECONE.
* Inserts central square in most favorable orientation.
*/
int cubecone_pop(v_id,count)
vertex_id v_id;
int count; /* number of entries in vflist */
{
int i,k,m;
struct arc *ar;
facetedge_id fe;
REAL side[MAXCOORD];
REAL faceforce[MAXCOORD];
REAL facemag,bestmag,mag;
int bestk=0;
edge_id triples[6][4];
/* find mean triple edge vectors for each face */
/* get triple lines and vectors to see which way to pop */
bestmag = 1e20;
for ( k = 0 ; k < 6 ; k++ )
{ for ( i = 0 ; i < SDIM ; i++ )
faceforce[i] = 0.0;
for ( m = 0 ; m < 4 ; m++ )
{ ar = arclist + cell[k].start + m;
fe = felist[ar->start];
triples[k][m] = get_fe_edge(get_prev_edge(fe));
get_edge_side( triples[k][m],side);
mag = sqrt(dot(side,side,SDIM));
if ( mag != 0 )
for ( i = 0 ; i < SDIM ; i++ )
faceforce[i] += side[i]/mag;
}
facemag = sqrt(dot(faceforce,faceforce,SDIM));
if ( facemag < bestmag )
{ bestmag = facemag;
bestk = k;
}
}
return pop_vertex_to_quad(v_id,triples[bestk]);
}
/********************************************************************
*
* Function: facet_force_on_vertex()
*
* Purpose: Calculate force of a facet on one of its vertices,
* force due to surface tension with density. For
* determining pop directions. Note the vector in fvec
* is the force, i.e. the negative of the area gradient.
*/
void facet_force_on_vertex(f_id,v_id,fvec)
facet_id f_id;
vertex_id v_id;
REAL *fvec; /* returned force */
{
REAL sides[2][MAXCOORD];
MAT2D(vx,FACET_VERTS,MAXCOORD);
int i,j,basei=0;
facetedge_id fe;
REAL s1s1,s1s2,s2s2,det;
REAL tension = get_facet_density(f_id);
REAL coeff;
get_facet_verts(f_id,vx,NULL);
fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
if ( equal_id(get_fe_tailv(fe),v_id) )
basei = i;
fe = get_next_edge(fe);
}
for ( j = 0 ; j < SDIM ; j++ )
{ sides[0][j] = vx[1][j] - vx[0][j];
sides[1][j] = vx[2][j] - vx[0][j];
}
s1s1 = dot(sides[0],sides[0],SDIM);
s2s2 = dot(sides[1],sides[1],SDIM);
s1s2 = dot(sides[0],sides[1],SDIM);
det = s1s1*s2s2 - s1s2*s1s2;
if ( det <= 0.0 )
{ for ( j = 0 ; j < SDIM ; j++ )
fvec[j] = 0.0;
}
coeff = tension/2/sqrt(det);
if ( basei == 0 )
{ for ( j = 0 ; j < SDIM ; j++ )
fvec[j] = coeff*((s2s2*sides[0][j] - s1s2*sides[1][j])
+ (s1s1*sides[1][j] - s1s2*sides[0][j]));
}
else if ( basei == 1 )
{ for ( j = 0 ; j < SDIM ; j++ )
fvec[j] = -coeff*(s2s2*sides[0][j] - s1s2*sides[1][j]);
}
else
{ for ( j = 0 ; j < SDIM ; j++ )
fvec[j] = -coeff*(s1s1*sides[1][j] - s1s2*sides[0][j]);
}
} /* end facet_force_on_vertex() */
/*******************************************************************
*
* Function: odd4cone_pop()
*
* Purpose: pops one non-minimal vertex of type ODD4CONE,
* which is two triple lines touching at the vertex.
* Can either detach the triple lines or split into
* two tetrahedral points with septum between.
*/
int odd4cone_pop(v_id,count)
vertex_id v_id;
int count; /* number of entries in vflist */
{
int i,j,k;
facetedge_id fe_a=NULLID,fe_b=NULLID; /* triple edge fe's on septum side*/
facetedge_id fe_c=NULLID,fe_d=NULLID; /* other pair of triple edge fe's */
edge_id e_a, e_b, e_c, e_d; /* triple edges */
facet_id f_a,f_b,f_c, f_d; /* septum facets */
REAL veca[MAXCOORD],vecb[MAXCOORD],vecc[MAXCOORD],vecd[MAXCOORD];
REAL vecab[MAXCOORD],vecac[MAXCOORD],veccd[MAXCOORD],vecbd[MAXCOORD];
int flag;
int split_cell=0;
int cdswap = 0;
REAL tripnetforce; /* force towards separate triples; pos favorable */
REAL quadnetforce; /* force towards quad line; pos favorable */
facetedge_id next_fe,fe;
REAL ee,ea,eb,ec,ed,aa,bb,cc,dd,bd,ac,acac,bdbd;
REAL eside[MAXCOORD];
int counter;
/* identify key parts */
/* find two triple lines on one side */
for ( i = 0, flag = 0 ; i < cells ; i++ )
{ if ( cell[i].num == 2 )
{ if ( flag )
{ fe_c = felist[arclist[cell[i].start].start]; /* outer fe */
fe_c = get_prev_edge(fe_c); /* radial fe */
fe_c = get_prev_facet(fe_c); /* on septum */
fe_d = felist[arclist[cell[i].start+1].start];
fe_d = get_prev_edge(fe_d); /* radial fe */
fe_d = get_prev_facet(fe_d); /* on septum */
}
else
{ fe_a = felist[arclist[cell[i].start].start]; /* outer fe */
fe_a = get_prev_edge(fe_a); /* radial fe */
fe_a = get_prev_facet(fe_a); /* on septum */
fe_b = felist[arclist[cell[i].start+1].start];
fe_b = get_prev_edge(fe_b); /* radial fe */
fe_b = get_prev_facet(fe_b); /* on septum */
split_cell = i;
flag = 1;
}
}
}
/* get a and c on same side of vertex */
next_fe = fe_a;
counter = 0;
for(;;)
{ next_fe = inverse_id(get_prev_edge(next_fe));
if ( equal_id(next_fe,fe_c) || equal_id(next_fe,fe_d))
break;
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) || (++counter > 100) )
{ sprintf(errmsg,"Internal: Cannot match fe_c with fe_a at vertex %s; skipping pop.\n",
ELNAME(v_id));
kb_error(3692,errmsg,RECOVERABLE);
return 0;
}
next_fe = get_next_facet(next_fe);
}
if ( equal_id(next_fe,fe_d) )
{ /* swap c and d */
facetedge_id temp = fe_c;
fe_c = fe_d;
fe_d = temp;
cdswap = 1;
}
/* more parts */
e_a = get_fe_edge(fe_a);
e_b = get_fe_edge(fe_b);
e_c = get_fe_edge(fe_c);
e_d = get_fe_edge(fe_d);
f_a = get_fe_facet(fe_a);
f_b = get_fe_facet(fe_b);
f_c = get_fe_facet(fe_c);
f_d = get_fe_facet(fe_d);
get_edge_side(e_a,veca);
get_edge_side(e_b,vecb);
get_edge_side(e_c,vecc);
get_edge_side(e_d,vecd);
for ( i = 0 ; i < SDIM ; i++ )
{ vecab[i] = (veca[i] + vecb[i])/4;
veccd[i] = (vecc[i] + vecd[i])/4;
vecac[i] = (veca[i] + vecc[i])/4;
vecbd[i] = (vecb[i] + vecd[i])/4;
}
/* determine which way to split */
/* First, if pull triple lines apart*/
tripnetforce = 0.0;
for ( i = 0, flag = 0 ; i < cells ; i++ )
{ /* forces from existing facets */
if ( cell[i].num == 2 )
{ for ( k = 0 ; k < cell[i].num ; k++ )
{ struct arc *a = arclist + cell[i].start + k;
for ( j = 0 ; j < a->num ; j++ )
{ facetedge_id fe = felist[a->start + j];
REAL force[MAXCOORD];
facet_force_on_vertex(get_fe_facet(fe),v_id,force);
if ( flag )
tripnetforce += dot(veccd,force,SDIM);
else
tripnetforce += dot(vecab,force,SDIM);
}
}
flag = 1;
}
}
/* force from introduced facets */
ee = dot(vecab,vecab,SDIM);
aa = dot(veca,veca,SDIM);
ea = dot(veca,vecab,SDIM);
tripnetforce -= sqrt(aa*ee - ea*ea)/2*get_facet_density(f_a);
bb = dot(vecb,vecb,SDIM);
eb = dot(vecb,vecab,SDIM);
tripnetforce -= sqrt(bb*ee - eb*eb)/2*get_facet_density(f_b);
ee = dot(veccd,veccd,SDIM);
cc = dot(vecc,vecc,SDIM);
ec = dot(vecc,veccd,SDIM);
tripnetforce -= sqrt(cc*ee - ec*ec)/2*get_facet_density(f_c);
dd = dot(vecd,vecd,SDIM);
ed = dot(vecd,veccd,SDIM);
tripnetforce -= sqrt(dd*ee - ed*ed)/2*get_facet_density(f_d);
/* now force from expanding vertex to quad line */
/* assuming splits at the a->num/2 edge in the side arcs */
quadnetforce = 0.0;
for ( i = 0, flag = 0 ; i < cells ; i++ )
{ if ( cell[i].num == 2 )
{ for ( k = 0 ; k < cell[i].num ; k++ )
{ struct arc *a = arclist + cell[i].start + k;
for ( j = 0 ; j < a->num ; j++ )
{ facetedge_id fe = felist[a->start + j];
REAL force[MAXCOORD];
facet_force_on_vertex(get_fe_facet(fe),v_id,force);
if ( !flag || !cdswap )
{
if ( ((k==0) && (j < a->num/2)) || ((k==1)&&(j >= a->num/2)) )
quadnetforce += dot(vecac,force,SDIM);
else
quadnetforce += dot(vecbd,force,SDIM);
}
else
{ if ( ((k==0) && (j < a->num/2)) || ((k==1)&&(j >= a->num/2)) )
quadnetforce += dot(vecbd,force,SDIM);
else
quadnetforce += dot(vecac,force,SDIM);
}
}
}
flag = 1;
}
}
/* force from old septa */
ac = dot(veca,vecc,SDIM);
quadnetforce += sqrt(aa*cc-ac*ac)/4*get_facet_density(f_a);
bd = dot(vecb,vecd,SDIM);
quadnetforce += sqrt(bb*dd-bd*bd)/4*get_facet_density(f_b);
/* force from introduced facets */
for ( i = 0 ; i < cells ; i++ )
{ if ( cell[i].num == 2 )
{ for ( k = 0 ; k < cell[i].num ; k++ )
{ struct arc *a = arclist + cell[i].start + k;
REAL tension;
fe = felist[a->start + a->num/2];
fe = get_prev_edge(fe);
get_edge_side(get_fe_edge(fe),eside);
ee = dot(eside,eside,SDIM);
tension = get_facet_density(get_fe_facet(fe));
acac = dot(vecac,vecac,SDIM);
ea = dot(vecac,eside,SDIM);
quadnetforce -= sqrt(acac*ee - ea*ea)/2*tension;
bdbd = dot(vecbd,vecbd,SDIM);
eb = dot(vecbd,eside,SDIM);
quadnetforce -= sqrt(bdbd*ee - eb*eb)/2*tension;
}
}
}
if ( (tripnetforce < 0) && (quadnetforce < 0) )
{ if ( verbose_flag )
{ sprintf(msg,"Not popping touching-triple-lines vertex %s since stable.\n",
ELNAME(v_id));
outstring(msg);
}
return 0; /* no profit from splitting either way */
}
/* if separate triple lines */
if ( tripnetforce > quadnetforce )
{ vertex_id newv = dup_vertex(v_id);
edge_id newe;
facetedge_id fe_aa,fe_bb,new_fe_a,new_fe_b;
REAL *xold = get_coord(v_id);
REAL *xnew = get_coord(newv);
if ( verbose_flag )
{ sprintf(msg,"Separating triple lines at vertex %s.\n",
ELNAME(v_id));
outstring(msg);
}
/* spread vertices apart */
for ( i = 0 ; i < SDIM ; i++ )
{
xnew[i] += vecab[i];
xold[i] += veccd[i];
}
/* reconnected other edges on split-off part */
for ( i = 0 ; i < cell[split_cell].num ; i++ )
{ struct arc *a = arclist + cell[split_cell].start + i;
for ( j = 0 ; j < a->num ; j++ )
{ facetedge_id fe = felist[a->start + j];
edge_id e_id;
fe = get_prev_edge(fe);
e_id = get_fe_edge(fe);
set_edge_tailv(e_id,newv);
}
}
/* new edge and its facetedges */
newe = new_edge(v_id,newv,v_id);
new_fe_a = new_facetedge(f_a,newe);
new_fe_b = new_facetedge(f_b,newe);
set_edge_fe(newe,new_fe_a);
set_next_facet(new_fe_a,new_fe_b);
set_prev_facet(new_fe_a,new_fe_b);
set_next_facet(new_fe_b,new_fe_a);
set_prev_facet(new_fe_b,new_fe_a);
fe_aa = get_prev_edge(fe_a);
set_next_edge(new_fe_a,fe_a);
set_prev_edge(fe_a,new_fe_a);
set_prev_edge(new_fe_a,fe_aa);
set_next_edge(fe_aa,new_fe_a);
fe_bb = get_prev_edge(fe_b);
set_next_edge(new_fe_b,fe_b);
set_prev_edge(fe_b,new_fe_b);
set_prev_edge(new_fe_b,fe_bb);
set_next_edge(fe_bb,new_fe_b);
/* subdivide septum quadrilaterals */
cross_cut(new_fe_a,fe_a);
cross_cut(new_fe_b,fe_b);
}
else
{ /* split vertex to form quadruple line */
vertex_id newv = dup_vertex(v_id);
edge_id newe;
REAL *xold = get_coord(v_id);
REAL *xnew = get_coord(newv);
if ( verbose_flag )
{ sprintf(msg,"Inserting new septum at vertex %s.\n",
ELNAME(v_id));
outstring(msg);
}
/* spread vertices apart */
for ( i = 0 ; i < SDIM ; i++ )
{
xnew[i] += vecac[i];
xold[i] += vecbd[i];
}
/* new edge and its facetedges */
newe = new_edge(v_id,newv,v_id);
/* reconnected other edges on split-off part */
set_edge_tailv(e_a,newv);
set_edge_tailv(e_c,newv);
for ( i = 0, flag = 0 ; i < cells ; i++ )
{ if ( cell[i].num != 2 )
continue;
for ( k = 0 ; k < cell[i].num ; k++ )
{ struct arc *a = arclist + cell[i].start + k;
int upflag = (!flag && (k==0)) || (flag && !cdswap && (k==0))
|| (flag && cdswap && (k==1)) ;
facet_id ff;
facetedge_id new_fe,fe_prev,e_fe;
for ( j = 1 ; j < a->num ; j++ )
{ facetedge_id fe = felist[a->start + j];
edge_id e_id;
fe = get_prev_edge(fe);
e_id = get_fe_edge(fe);
if ( (upflag && (j <= a->num/2)) || (!upflag && (j >= a->num/2)) )
set_edge_tailv(e_id,newv);
}
/* now expand some facets to quads */
fe = felist[a->start + a->num/2];
fe = get_prev_edge(fe);
if ( !upflag )
fe = get_next_facet(fe);
ff = get_fe_facet(fe);
new_fe = new_facetedge(ff,newe);
fe_prev = get_prev_edge(fe);
set_prev_edge(new_fe,fe_prev);
set_next_edge(fe_prev,new_fe);
set_next_edge(new_fe,fe);
set_prev_edge(fe,new_fe);
e_fe = get_edge_fe(newe);
if ( valid_id(e_fe) )
{ fe_prev = get_prev_facet(e_fe);
set_next_facet(fe_prev,new_fe);
set_prev_facet(new_fe,fe_prev);
set_prev_facet(e_fe,new_fe);
set_next_facet(new_fe,e_fe);
}
else
{ set_edge_fe(newe,new_fe);
set_next_facet(new_fe,new_fe);
set_prev_facet(new_fe,new_fe);
}
cross_cut(new_fe,fe);
}
flag = 1;
}
fe_reorder(newe);
pop_one_edge(newe);
}
return 1;
} /* end odd4cone_pop() */
/*****************************************************************************
*
* function: pop_tri_to_edge()
*
* purpose: Topology change of small triangle to edge perpendicular to it.
* Implements pop_tri_to_edge command.
*
* return: 1 for success, 0 for failure.
*/
int pop_tri_to_edge(f_id)
facet_id f_id;
{ edge_id ea,eb,ec,newe;
vertex_id va,vb,vc,keepv=NULLID,newv;
facetedge_id fe,next_fe,fa,fb,fc;
int retval,i,j;
int legs;
REAL side[MAXCOORD],separation[MAXCOORD];
edge_id trip[3];
REAL *keepx,*newx;
edge_id tredges[12];
int ti;
if ( (web.modeltype != LINEAR) && (web.modeltype != QUADRATIC) )
kb_error(3366,"pop_tri_to_edge only for LINEAR or QUADRATIC models.\n",
RECOVERABLE);
/* Test geometry is appropriate */
next_fe = fe = get_facet_fe(f_id);
ti = 0;
do
{ int triples;
ea = get_fe_edge(next_fe);
ec = inverse_id(get_fe_edge(get_prev_edge(next_fe)));
if ( get_edge_valence(ea) != 3 )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_tri_to_edge fails on facet %s; not all its edges triple .\n",
ELNAME(f_id));
outstring(msg);
}
return 0;
}
va = get_fe_tailv(next_fe);
eb = get_next_tail_edge(ea);
triples = 1;
while ( !equal_id(ea,eb) )
{ int val = get_edge_valence(eb);
if ( (val < 2) || ( val > 3 ) )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_tri_to_edge fails on facet %s due to edge %s having valence %d.\n",
ELNAME(f_id),ELNAME1(eb),val);
outstring(msg);
}
return 0;
}
if ( (val == 3) && !equal_id(eb,ec) )
{ tredges[ti++] = eb;
triples++;
}
eb = get_next_tail_edge(eb);
}
if ( triples != 3 )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_tri_to_edge fails on facet %s due to %d triple edges on vertex %s; need 4.\n",
ELNAME(f_id),triples+1,ELNAME1(get_edge_tailv(eb)));
outstring(msg);
}
return 0;
}
next_fe = get_next_edge(next_fe);
} while ( !equal_id(fe,next_fe) );
fe = get_facet_fe(f_id);
ea = get_fe_edge(fe);
eb = get_fe_edge(get_next_edge(fe));
ec = get_fe_edge(get_prev_edge(fe));
va = get_edge_tailv(ea);
vb = get_edge_tailv(eb);
vc = get_edge_tailv(ec);
/* check for disjoint endpoints of triple edges */
for ( i = 1 ; i < ti ; i++ )
for ( j = 0 ; j < i ; j++ )
if ( equal_id(get_edge_headv(tredges[i]),get_edge_headv(tredges[j])) )
{ if ( verbose_flag )
{ sprintf(msg,"pop_tri_to_edge fails on facet %s due to outer triple edges with common endpoint.\n",ELNAME(f_id));
outstring(msg);
}
return 0;
}
if ( verbose_flag )
{ sprintf(msg,"pop_tri_to_edge on facet %s\n",ELNAME(f_id));
outstring(msg);
}
retval = eliminate_facet(f_id);
if ( retval == 0 ) return 0;
/* now finish elimination by eliminating the remaining facet edge */
if ( valid_element(ea) )
{ retval = eliminate_edge(ea); free_element(ea); }
else if ( valid_element(eb) )
{ retval = eliminate_edge(eb); free_element(eb); }
else if ( valid_element(ec) )
{ retval = eliminate_edge(ec); free_element(ec); }
else retval = 0;
if ( retval == 0 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_tri_to_edge failed on facet %s; failed to delete edge remaining after deleting facet.\n",ELNAME(f_id));
outstring(msg);
}
return 0;
}
if ( valid_element(va) ) keepv = va;
else if ( valid_element(vb) ) keepv = vb;
else if ( valid_element(vc) ) keepv = vc;
/* Identify the three downward triple lines */
trip[0] = ea = tredges[0]; trip[1] = trip[2] = NULLID;
fe = get_edge_fe(ea);
get_edge_side(ea,side);
for ( j = 0 ; j < SDIM ; j++ )
separation[j] = side[j];
for ( i = 0 ; i < 3 ; i++,fe=get_next_facet(fe) )
{ next_fe = inverse_id(get_prev_edge(fe));
while ( equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
next_fe = inverse_id(get_prev_edge(get_next_facet(next_fe)));
eb = get_fe_edge(next_fe);
get_edge_side(eb,side);
if ( equal_id(eb,tredges[2]) || equal_id(eb,tredges[3]) )
{ trip[1] = eb;
for ( j = 0 ; j < SDIM ; j++ )
separation[j] += side[j];
}
if ( equal_id(eb,tredges[4]) || equal_id(eb,tredges[5]) )
{ trip[2] = eb;
for ( j = 0 ; j < SDIM ; j++ )
separation[j] += side[j];
}
}
if ( !valid_id(trip[1]) || !valid_id(trip[2]) )
{ if ( verbose_flag )
{ sprintf(msg,"pop_tri_to_edge failed after deleting facet %s; didn't find triple of edges in same direction.\n",ELNAME(f_id));
outstring(msg);
}
return 0;
}
legs = 3;
/* Insert new vertex and edge */
newv = dup_vertex(keepv);
newe = new_edge(keepv,newv,NULLID);
keepx = get_coord(keepv);
newx = get_coord(newv);
for ( j = 0 ; j < SDIM ; j++ )
{ newx[j] = keepx[j] + separation[j]/12;
keepx[j] -= separation[j]/12;
}
/* Reconnect lower edge endpoints */
for ( i = 0 ; i < legs ; i++ ) /* lower triple edges */
{ facetedge_id next_fe,start_fe;
remove_vertex_edge(keepv,trip[i]);
set_edge_tailv(trip[i],newv);
fe = start_fe = get_edge_fe(trip[i]);
do /* around the multiple edge */
{
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ /* traverse fan of edges */
edge_id eg;
if ( !equal_id(get_fe_tailv(next_fe),keepv) ) break;
if ( get_next_facet(next_fe) != get_prev_facet(next_fe) )
{ /* have reached next triple edge */
eg = get_fe_edge(next_fe);
if ( equal_id(eg,trip[0]) || equal_id(eg,trip[1])
|| equal_id(eg,trip[2]) )
{ /* all lower edges, so go back and reconnect */
next_fe = inverse_id(get_prev_edge(next_fe));
while ( !equal_id(next_fe,fe) )
{ edge_id e_id = get_fe_edge(next_fe);
remove_vertex_edge(keepv,e_id);
set_edge_tailv(e_id,newv);
next_fe = get_prev_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
else
{ /* vertical, so insert new edge above trip[i] */
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,newe);
facetedge_id newefe = get_edge_fe(newe);
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
if ( valid_id(newefe) )
{ set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_prev_facet(newfe,get_next_facet(newefe));
set_next_facet(get_next_facet(newefe),newfe);
}
else
{ set_edge_fe(newe,newfe);
set_next_facet(newfe,newfe);
set_prev_facet(newfe,newfe);
}
cross_cut(newfe,fe); /* triangulate */
}
break; /* done with this way out of triple edge */
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
fe = get_next_facet(fe);
} while ( !equal_id(fe,start_fe) );
}
/* Fix up facet edge orders */
fa = get_edge_fe(newe);
fb = get_next_facet(fa);
fc = get_prev_facet(fa);
if ( equal_id(get_facet_body(get_fe_facet(fb)),
get_facet_body(inverse_id(get_fe_facet(fc)))) )
{ /* have to switch order around edge */
set_prev_facet(fa,fb);
set_prev_facet(fb,fc);
set_prev_facet(fc,fa);
set_next_facet(fa,fc);
set_next_facet(fc,fb);
set_next_facet(fb,fa);
}
if ( web.modeltype == QUADRATIC )
{ /* fix up edge midpoints */
vertex_id vv[2];
int bailcount = 0;
vv[0] = keepv; vv[1] = newv;
/* fix up edge midpoints */
for ( i = 0 ; i < 2 ; i++ )
{ edge_id start_e = get_vertex_edge(vv[i]);
edge_id ea;
ea = start_e;
do
{ new_vertex_average(get_edge_midv(ea),VOLKEEP);
ea = get_next_tail_edge(ea);
if ( bailcount++ > 1000 ) break;
} while ( !equal_id(ea,start_e));
}
}
fe_reorder(newe);
return 1;
}
/*****************************************************************************
*
* function: pop_edge_to_tri()
*
* purpose: Topology change of edge to small triangle perpendicular to it.
* Implements pop_edge_to_tri command.
*
* return: 1 for success, 0 for failure.
*/
int pop_edge_to_tri(e_id)
edge_id e_id;
{ int triples;
vertex_id tail_triples[3],head_triples[3];
vertex_id headv,tailv;
int retval;
int i,j;
conmap_t *hmap,*tmap;
int thit=0,hhit=0;
unsigned int k;
if ( (web.modeltype != LINEAR) && (web.modeltype != QUADRATIC) )
kb_error(2835,"pop_edge_to_tri only for LINEAR or QUADRATIC models.\n",
RECOVERABLE);
/* Check valences and gather info on triple edges */
if ( get_edge_valence(e_id) != 3 )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_edge_to_tri fails on edge %s; it is not a triple edge.\n",
ELNAME(e_id)+1);
outstring(msg);
}
return 0;
}
tailv = get_edge_tailv(e_id);
tmap = get_v_constraint_map(tailv);
for ( k = 1 ; k <= tmap[0] ; k++ )
if ( tmap[k] & CON_HIT_BIT )
{ thit = 1;
break;
}
if ( !thit )
{ /* check for proper number of triple edges */
edge_id eb = get_next_tail_edge(e_id);
triples = 0;
while ( !equal_id(e_id,eb) )
{ int val = get_edge_valence(eb);
if ( (val < 2) || ( val > 3 ) )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_edge_to_tri fails on edge %s due to edge %s having valence %d.\n",
ELNAME(e_id),ELNAME1(eb),val);
outstring(msg);
}
return 0;
}
if ( val == 3 )
{ if ( triples >= 3 )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_edge_to_tri fails on edge %s due to too many triple edges at end.\n",
ELNAME(e_id)+1);
outstring(msg);
}
return 0;
}
tail_triples[triples++] = eb;
}
eb = get_next_tail_edge(eb);
}
if ( triples != 3 )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_edge_to_tri fails on edge %s due to not enough triple edges at an endpoint.\n",
ELNAME(e_id));
outstring(msg);
}
return 0;
}
}
headv = get_edge_headv(e_id);
hmap = get_v_constraint_map(headv);
for ( k = 1 ; k <= hmap[0] ; k++ )
if ( hmap[k] & CON_HIT_BIT )
{ hhit = 1;
break;
}
if ( !hhit )
{ /* check for proper number of triples */
edge_id eb = get_next_head_edge(e_id);
triples = 0;
while ( !equal_id(e_id,eb) )
{ int val = get_edge_valence(eb);
if ( (val < 2) || ( val > 3 ) )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_edge_to_tri fails on edge %s due to edge %s having valence %d.\n",
ELNAME(e_id),ELNAME1(eb),val);
outstring(msg);
}
return 0;
}
if ( val == 3 )
{ if ( triples >= 3 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_edge_to_tri fails on edge %s due to too many triple edges at one endpoint.\n",ELNAME(e_id));
outstring(msg);
}
return 0;
}
head_triples[triples++] = inverse_id(eb);
}
eb = get_next_head_edge(eb);
}
if ( triples != 3 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_edge_to_tri fails on edge %s due to not enough triple edges at one endpoint.\n",ELNAME(e_id));
outstring(msg);
}
return 0;
}
}
if ( thit && hhit )
{ if ( verbose_flag )
{ sprintf(msg,"pop_edge_to_tri fails on edge %s due to both endpoints on constraints.\n",ELNAME(e_id));
outstring(msg);
}
return 0;
}
if ( thit )
return pop_edge_to_tri_con(e_id);
if ( hhit )
return pop_edge_to_tri_con(inverse_id(e_id));
/* check for common endpoints on triples */
for ( i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
if ( equal_id(get_edge_headv(tail_triples[i]),
get_edge_headv(head_triples[j])) )
{ if ( verbose_flag )
{ sprintf(msg,"pop_edge_to_tri fails on edge %s due to outer triple edges with common endpoint.\n",ELNAME(e_id));
outstring(msg);
}
return 0;
}
if ( verbose_flag )
{ sprintf(msg,"pop_edge_to_tri on edge %s\n",ELNAME(e_id));
outstring(msg);
}
/* Delete the edge */
retval = eliminate_edge(e_id);
if ( retval == 0 ) return 0;
free_element(e_id);
return pop_vertex_to_tri((valid_element(headv) ? headv : tailv),tail_triples);
}
/**************************************************************************
*
* function: pop_vertex_to_tri()
*
* purpose: main work for pop_edge_to_tri and kraynik pop.
*/
int pop_vertex_to_tri(v_id,tail_triples)
vertex_id v_id;
edge_id *tail_triples;
{ int i,j;
vertex_id newv[3],keepv;
edge_id newe[3];
facet_id newf;
facetedge_id newfe[3],fe,fa,fb,fc;
edge_id ea,eb,ec,ee,head_triples[3];
/* Create new vertices, edges, and facet */
newv[0] = v_id;
newv[1] = dup_vertex(newv[0]);
newv[2] = dup_vertex(newv[0]);
newe[0] = new_edge(newv[0],newv[1],NULLID);
newe[1] = new_edge(newv[1],newv[2],NULLID);
newe[2] = new_edge(newv[2],newv[0],NULLID);
fe = get_vertex_first_facet(newv[0]);
newf = dup_facet(get_fe_facet(fe));
set_facet_body(newf,NULLID);
set_facet_body(inverse_id(newf),NULLID);
newfe[0] = new_facetedge(newf,newe[0]); set_edge_fe(newe[0],newfe[0]);
newfe[1] = new_facetedge(newf,newe[1]); set_edge_fe(newe[1],newfe[1]);
newfe[2] = new_facetedge(newf,newe[2]); set_edge_fe(newe[2],newfe[2]);
set_next_edge(newfe[0],newfe[1]);
set_next_edge(newfe[1],newfe[2]);
set_next_edge(newfe[2],newfe[0]);
set_prev_edge(newfe[0],newfe[2]);
set_prev_edge(newfe[1],newfe[0]);
set_prev_edge(newfe[2],newfe[1]);
set_facet_fe(newf,newfe[0]);
/* Reconnect things */
keepv = newv[0];
for ( i = 0 ; i < 3 ; i++ ) /* lower triple edges */
{ facetedge_id next_fe;
remove_vertex_edge(keepv,tail_triples[i]);
set_edge_tailv(tail_triples[i],newv[i]);
fe = get_edge_fe(tail_triples[i]);
for ( j = 0 ; j < 3 ; j++ ) /* around the triple edge */
{ fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ /* traverse fan of edges */
vertex_id vv_id;
edge_id eg,ee;
eg = get_fe_edge(next_fe);
if ( equal_element(eg,newe[0]) ) break;
if ( equal_element(eg,newe[1]) ) break;
if ( equal_element(eg,newe[2]) ) break;
vv_id = get_edge_tailv(eg);
if ( !equal_id(vv_id,keepv) && !equal_id(vv_id,newv[i]) )
{ sprintf(errmsg,
"pop_edge_to_tri bug: edge %s tail vertex is %s instead of %s.\n",
ELNAME(eg),ELNAME1(get_edge_tailv(eg)),ELNAME2(keepv));
kb_error(2834,errmsg,RECOVERABLE);
break;
}
if ( get_next_facet(next_fe) != get_prev_facet(next_fe) )
{ /* have reached next triple edge */
if ( equal_id(eg,tail_triples[(i+2)%3]) ) break;
else if ( equal_id(eg,tail_triples[(i+1)%3]) )
{ /* all lower edges, so go back and split out to triangle edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,inverse_id(newe[i]));
facetedge_id newefe = get_edge_fe(inverse_id(newe[i]));
while ( !equal_id(feb,next_fe) )
{ ee = get_fe_edge(feb);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[(i+1)%3]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_next_facet(newefe,newfe);
set_prev_facet(newfe,newefe);
cross_cut(newfe,fe); /* triangulate */
}
else /* hit one of the head_triples */
{ /* vertical wall, so reconnect */
head_triples[i] = eg;
next_fe = inverse_id(get_prev_edge(next_fe));
while ( !equal_id(next_fe,fe) )
{ edge_id ee = get_fe_edge(next_fe);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[i]);
next_fe = get_prev_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
break; /* done with this way out of triple edge */
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
}
/* Now go around head end and reconnect, head_triples having been
put in proper correspondence above */
for ( i = 0 ; i < 3 ; i++ ) /* upper triple edges */
{ facetedge_id next_fe;
remove_vertex_edge(keepv,head_triples[i]);
set_edge_tailv(head_triples[i],newv[i]);
fe = get_edge_fe(head_triples[i]);
for ( j = 0 ; j < 3 ; j++ ) /* around the triple edge */
{ fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ /* traverse fan of edges */
edge_id eg;
if ( !equal_id(get_fe_tailv(next_fe),keepv) ) break;
eg = get_fe_edge(next_fe);
if ( get_next_facet(next_fe) != get_prev_facet(next_fe) )
{ /* have reached next triple edge */
if ( equal_id(eg,head_triples[(i+2)%3]) ) break;
if ( equal_element(eg,newe[0]) ) break;
if ( equal_element(eg,newe[1]) ) break;
if ( equal_element(eg,newe[2]) ) break;
else if ( equal_id(eg,head_triples[(i+1)%3]) )
{ /* all upper edges, so go back and split out to triangle edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(inverse_id(fa),newe[i]);
facetedge_id newefe = get_edge_fe(newe[i]);
while ( !equal_id(feb,next_fe) )
{ ee = get_fe_edge(feb);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[(i+1)%3]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,inverse_id(newfe));
set_prev_edge(inverse_id(newfe),fea);
set_prev_edge(fe,inverse_id(newfe));
set_next_edge(inverse_id(newfe),fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_prev_facet(newfe,get_next_facet(newefe));
set_next_facet(get_next_facet(newefe),newfe);
cross_cut(inverse_id(newfe),fe); /* triangulate */
}
else /* hit one of the head_triples */
{ /* vertical wall, but those already reconnected */
}
break; /* done with this way out of triple edge */
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
}
/* Spread new vertices */
for ( i = 0 ; i < 3 ; i++ ) /* the vertices */
{ REAL *x,side1[MAXCOORD],side2[MAXCOORD];
x = get_coord(newv[i]);
get_edge_side(tail_triples[i],side1);
get_edge_side(head_triples[i],side2);
for ( j = 0 ; j < SDIM ; j++ )
x[j] += (side1[j]+side2[j])/6;
}
/* Fix up facet edge orders */
for ( i = 0 ; i < 3 ; i++ )
{ facetedge_id next_fe;
int count;
vertex_id base_v;
fa = newfe[i];
fb = get_next_facet(fa);
fc = get_prev_facet(fa);
ea = get_fe_edge(fa);
eb = get_fe_edge(inverse_id(get_prev_edge(fa)));
base_v = get_edge_tailv(ea);
next_fe = inverse_id(get_prev_edge(fb));
for(count=0;count < 10000 ;count++)
{ ec = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ec),base_v) )
kb_error(2833,"pop_tri_to_edge failure.\n",RECOVERABLE);
if ( equal_id(ec,ea) )
break; /* ok */
if ( equal_id(ec,eb) )
{ /* have to switch order around edge */
set_prev_facet(fa,fb);
set_prev_facet(fb,fc);
set_prev_facet(fc,fa);
set_next_facet(fa,fc);
set_next_facet(fc,fb);
set_next_facet(fb,fa);
break;
}
next_fe = inverse_id(get_prev_edge(get_prev_facet(next_fe)));
}
if ( count >= 10000 )
{ sprintf(errmsg,"Internal error after pop_vertex_to_tri edge %s, bad topology around vertex %s.\n",ELNAME(v_id),ELNAME1(get_edge_tailv(ea)));
kb_error(2832,errmsg,RECOVERABLE);
}
}
/* Fix up bodies on new facet */
fe = newfe[0];
set_facet_body(newf,
get_facet_body(inverse_id(get_fe_facet(get_prev_facet(fe)))));
set_facet_body(inverse_id(newf),
get_facet_body(get_fe_facet(get_next_facet(fe))));
if ( web.modeltype == QUADRATIC )
{ /* fix up edge midpoints */
int bailcount = 0;
for ( i = 0 ; i < 3 ; i++ )
{ edge_id start_e = get_vertex_edge(newv[i]);
edge_id ea;
ea = start_e;
do
{ new_vertex_average(get_edge_midv(ea),VOLKEEP);
ea = get_next_tail_edge(ea);
if ( bailcount++ > 1000 ) break;
} while ( !equal_id(ea,start_e));
}
}
return 1;
} /* end pop_edge_to_tri */
/**************************************************************************
*
* function: pop_vertex_to_quad()
*
* purpose: main work for pop_cubecone.
*/
int pop_vertex_to_quad(v_id,tail_triples)
vertex_id v_id;
edge_id *tail_triples;
{ int i,j;
vertex_id newv[4],keepv;
edge_id newe[4];
facet_id newf;
facetedge_id newfe[4],fe,fa,fb,fc;
edge_id ea,eb,ec,ee,head_triples[4];
/* Create new vertices, edges, and facet */
newv[0] = v_id;
newv[1] = dup_vertex(newv[0]);
newv[2] = dup_vertex(newv[0]);
newv[3] = dup_vertex(newv[0]);
newe[0] = new_edge(newv[0],newv[1],NULLID);
newe[1] = new_edge(newv[1],newv[2],NULLID);
newe[2] = new_edge(newv[2],newv[3],NULLID);
newe[3] = new_edge(newv[3],newv[0],NULLID);
fe = get_vertex_first_facet(newv[0]);
newf = dup_facet(get_fe_facet(fe));
set_facet_body(newf,NULLID);
set_facet_body(inverse_id(newf),NULLID);
newfe[0] = new_facetedge(newf,newe[0]); set_edge_fe(newe[0],newfe[0]);
newfe[1] = new_facetedge(newf,newe[1]); set_edge_fe(newe[1],newfe[1]);
newfe[2] = new_facetedge(newf,newe[2]); set_edge_fe(newe[2],newfe[2]);
newfe[3] = new_facetedge(newf,newe[3]); set_edge_fe(newe[3],newfe[3]);
set_next_edge(newfe[0],newfe[1]);
set_next_edge(newfe[1],newfe[2]);
set_next_edge(newfe[2],newfe[3]);
set_next_edge(newfe[3],newfe[0]);
set_prev_edge(newfe[0],newfe[3]);
set_prev_edge(newfe[1],newfe[0]);
set_prev_edge(newfe[2],newfe[1]);
set_prev_edge(newfe[3],newfe[2]);
set_facet_fe(newf,newfe[0]);
/* Reconnect things */
keepv = newv[0];
for ( i = 0 ; i < 4 ; i++ ) /* lower triple edges */
{ facetedge_id next_fe;
remove_vertex_edge(keepv,tail_triples[i]);
set_edge_tailv(tail_triples[i],newv[i]);
fe = get_edge_fe(tail_triples[i]);
for ( j = 0 ; j < 3 ; j++ ) /* around the triple edge */
{ fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ /* traverse fan of edges */
vertex_id vv_id;
edge_id eg,ee;
eg = get_fe_edge(next_fe);
if ( equal_element(eg,newe[0]) ) break;
if ( equal_element(eg,newe[1]) ) break;
if ( equal_element(eg,newe[2]) ) break;
if ( equal_element(eg,newe[3]) ) break;
vv_id = get_edge_tailv(eg);
if ( !equal_id(vv_id,keepv) && !equal_id(vv_id,newv[i]) )
{ sprintf(errmsg,
"pop_vertex_to_quad bug: edge %s tail vertex is %s instead of %s.\n",
ELNAME(eg),ELNAME1(get_edge_tailv(eg)),ELNAME2(keepv));
kb_error(3930,errmsg,RECOVERABLE);
break;
}
if ( get_next_facet(next_fe) != get_prev_facet(next_fe) )
{ /* have reached next triple edge */
if ( equal_id(eg,tail_triples[(i+3)%4]) ) break;
else if ( equal_id(eg,tail_triples[(i+1)%4]) )
{ /* all lower edges, so go back and split out to triangle edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,inverse_id(newe[i]));
facetedge_id newefe = get_edge_fe(inverse_id(newe[i]));
while ( !equal_id(feb,next_fe) )
{ ee = get_fe_edge(feb);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[(i+1)%4]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_next_facet(newefe,newfe);
set_prev_facet(newfe,newefe);
cross_cut(newfe,fe); /* triangulate */
}
else /* hit one of the head_triples */
{ /* vertical wall, so reconnect */
head_triples[i] = eg;
next_fe = inverse_id(get_prev_edge(next_fe));
while ( !equal_id(next_fe,fe) )
{ edge_id ee = get_fe_edge(next_fe);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[i]);
next_fe = get_prev_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
break; /* done with this way out of triple edge */
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
}
/* Now go around head end and reconnect, head_triples having been
put in proper correspondence above */
for ( i = 0 ; i < 4 ; i++ ) /* upper triple edges */
{ facetedge_id next_fe;
remove_vertex_edge(keepv,head_triples[i]);
set_edge_tailv(head_triples[i],newv[i]);
fe = get_edge_fe(head_triples[i]);
for ( j = 0 ; j < 3 ; j++ ) /* around the triple edge */
{ fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ /* traverse fan of edges */
edge_id eg;
if ( !equal_id(get_fe_tailv(next_fe),keepv) ) break;
eg = get_fe_edge(next_fe);
if ( get_next_facet(next_fe) != get_prev_facet(next_fe) )
{ /* have reached next triple edge */
if ( equal_id(eg,head_triples[(i+3)%4]) ) break;
if ( equal_element(eg,newe[0]) ) break;
if ( equal_element(eg,newe[1]) ) break;
if ( equal_element(eg,newe[2]) ) break;
if ( equal_element(eg,newe[3]) ) break;
else if ( equal_id(eg,head_triples[(i+1)%4]) )
{ /* all upper edges, so go back and split out to triangle edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(inverse_id(fa),newe[i]);
facetedge_id newefe = get_edge_fe(newe[i]);
while ( !equal_id(feb,next_fe) )
{ ee = get_fe_edge(feb);
remove_vertex_edge(keepv,ee);
set_edge_tailv(ee,newv[(i+1)%4]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,inverse_id(newfe));
set_prev_edge(inverse_id(newfe),fea);
set_prev_edge(fe,inverse_id(newfe));
set_next_edge(inverse_id(newfe),fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_prev_facet(newfe,get_next_facet(newefe));
set_next_facet(get_next_facet(newefe),newfe);
cross_cut(inverse_id(newfe),fe); /* triangulate */
}
else /* hit one of the head_triples */
{ /* vertical wall, but those already reconnected */
}
break; /* done with this way out of triple edge */
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
}
/* Spread new vertices */
for ( i = 0 ; i < 4 ; i++ ) /* the vertices */
{ REAL *x,side1[MAXCOORD],side2[MAXCOORD];
x = get_coord(newv[i]);
get_edge_side(tail_triples[i],side1);
get_edge_side(head_triples[i],side2);
for ( j = 0 ; j < SDIM ; j++ )
x[j] += (side1[j]+side2[j])/6;
}
/* Fix up facet edge orders */
for ( i = 0 ; i < 4 ; i++ )
{ facetedge_id next_fe;
int count;
vertex_id base_v;
fa = newfe[i];
fb = get_next_facet(fa);
fc = get_prev_facet(fa);
ea = get_fe_edge(fa);
eb = get_fe_edge(inverse_id(get_prev_edge(fa)));
base_v = get_edge_tailv(ea);
next_fe = inverse_id(get_prev_edge(fb));
for(count=0;count < 10000 ;count++)
{ ec = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ec),base_v) )
kb_error(4833,"pop_vertex_to_quad failure.\n",RECOVERABLE);
if ( equal_id(ec,ea) )
break; /* ok */
if ( equal_id(ec,eb) )
{ /* have to switch order around edge */
set_prev_facet(fa,fb);
set_prev_facet(fb,fc);
set_prev_facet(fc,fa);
set_next_facet(fa,fc);
set_next_facet(fc,fb);
set_next_facet(fb,fa);
break;
}
next_fe = inverse_id(get_prev_edge(get_prev_facet(next_fe)));
}
if ( count >= 10000 )
{ sprintf(errmsg,"Internal error after pop_vertex_to_quad edge %s, bad topology around vertex %s.\n",ELNAME(v_id),ELNAME1(get_edge_tailv(ea)));
kb_error(4832,errmsg,RECOVERABLE);
}
}
/* Fix up bodies on new facet */
fe = newfe[0];
set_facet_body(newf,
get_facet_body(inverse_id(get_fe_facet(get_prev_facet(fe)))));
set_facet_body(inverse_id(newf),
get_facet_body(get_fe_facet(get_next_facet(fe))));
if ( web.modeltype == QUADRATIC )
{ /* fix up edge midpoints */
int bailcount = 0;
for ( i = 0 ; i < 4 ; i++ )
{ edge_id start_e = get_vertex_edge(newv[i]);
edge_id ea;
ea = start_e;
do
{ new_vertex_average(get_edge_midv(ea),VOLKEEP);
ea = get_next_tail_edge(ea);
if ( bailcount++ > 1000 ) break;
} while ( !equal_id(ea,start_e));
}
}
/* divide central square */
cross_cut(newfe[0],newfe[1]);
return 1;
} /* end pop_vertex_to_quad */
/*****************************************************************************
*
* function: pop_quad_to_quad()
*
* purpose: Topology change of narrow quadrilateral to quad perpendicular to it.
* Implements pop_quad_to_quad command.
*
* return: 1 for success, 0 for failure.
*/
int pop_quad_to_quad(f_id)
facet_id f_id; /* one facet of the quadrilateral */
{ facetedge_id fe,next_fe,start_fe,quad_triples[4],newfe[4],fea,keepfe;
edge_id e_id,ee_id,eee_id,other_triples[4][2],ea,eb,ec,keepe,newe[4];
vertex_id newv[4];
facet_id newf,fa,fb,fc;
body_id b_id;
int i,j,k,ii,jj;
REAL len[4];
REAL sides[4][2][MAXCOORD];
REAL *x[4];
#define MAXQF 100
facet_id quadfacets[MAXQF];
int qfcount;
if ( (web.modeltype != LINEAR) && (web.modeltype != QUADRATIC) )
kb_error(2836,"pop_quad_to_quad only for LINEAR or QUADRATIC models.\n",
RECOVERABLE);
/* quad could be four facets or two, or more */
/* Check geometry and gather info about triple edges */
/* find triple edge on original facet */
fe = get_facet_fe(f_id);
for ( i = 0 ; i < 3 ; i++ )
{ edge_id e_id = get_fe_edge(fe);
if ( get_edge_valence(e_id) == 3 ) break;
fe = get_next_edge(fe);
}
if ( i == 3 ) /* couldn't find a triple edge */
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s since it doesn't have a triple edge.\n",ELNAME(f_id));
outstring(msg);
}
return 0;
}
/* march around inner quad */
start_fe = fe;
for ( i = 0 ; i < 4 ; i++ )
{
for(;;) /* seek next triple */
{ fe = inverse_id(get_prev_edge(fe));
if ( equal_id(fe,get_next_facet(fe)) ) /* valence 1 edge */
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s; edge %s has valence 1.\n",ELNAME(f_id),ELNAME1(get_fe_edge(fe)));
outstring(msg);
}
return 0;
}
if ( !equal_id(get_next_facet(fe),get_prev_facet(fe)) )
break; /* found triple */
fe = get_next_facet(fe);
}
/* now have next triple */
e_id = get_fe_edge(fe);
if ( get_edge_valence(e_id) != 3 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s; edge %s valence too high.\n",ELNAME(f_id),ELNAME1(e_id));
outstring(msg);
}
return 0;
}
quad_triples[i] = fe;
fe = inverse_id(fe); /* get ready for next triple line search */
}
if ( !equal_id(start_fe,fe) )
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s; didn't find quadrilateral of triple edges.\n",ELNAME(f_id));
outstring(msg);
}
return 0;
}
/* Find shorter pair of opposite edges, and swap if necessary
so quad_triples[1,3] has short edges */
for ( i = 0 ; i < 4 ; i++ )
{ e_id = get_fe_edge(quad_triples[i]);
calc_edge(e_id);
len[i] = get_edge_length(e_id);
}
if ( (len[0]+len[2]) < (len[1]+len[3]) )
{ facetedge_id temp_fe = quad_triples[0];
quad_triples[0] = quad_triples[1];
quad_triples[1] = quad_triples[2];
quad_triples[2] = quad_triples[3];
quad_triples[3] = temp_fe;
}
/* Find the other triple lines at each corner */
for ( i = 0 ; i < 4 ; i++ )
{ edge_id ee_id;
int val;
e_id = get_fe_edge(quad_triples[i]);
ee_id = e_id;
j = 0;
do
{ ee_id = get_next_tail_edge(ee_id);
val = get_edge_valence(ee_id);
if ( (val < 2) || (val > 3) )
{ if ( verbose_flag )
{ sprintf(msg,
"pop_quad_to_quad fails on facet %s since edge %s has valence %d.\n",
ELNAME(f_id),ELNAME1(ee_id),val);
outstring(msg);
}
return 0;
}
if ( val == 3 )
{ if ( equal_element(ee_id,e_id) ) continue;
if ( equal_element(ee_id,get_fe_edge(quad_triples[(i+3)%4])) )
continue;
if ( j >= 2 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s; too many triple edges on vertex %s.\n",ELNAME(f_id),ELNAME1(get_edge_tailv(ee_id)));
outstring(msg);
}
return 0;
}
other_triples[i][j++] = ee_id;
}
} while ( !equal_id(e_id,ee_id));
if ( j != 2 )
{ if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad fails on facet %s since vertex %s doesn't have enough triple edges.\n",ELNAME(f_id),ELNAME1(get_edge_tailv(e_id)));
outstring(msg);
}
return 0;
}
}
/* check outer triples for common endpoints, due to triangular
* prisms and pyramids.
*/
for ( i = 0 ; i < 4 ; i++ )
for ( j = 0 ; j < 2 ; j++ )
for ( ii = i ; ii < 4 ; ii++ )
for ( jj = 0 ; jj < 2 ; jj++ )
{ if ( (ii == i) && (jj == j) ) continue;
if ( equal_id(get_edge_headv(other_triples[i][j]),
get_edge_headv(other_triples[ii][jj])) )
{ sprintf(msg,"Pop_quad_to_quad fails on facet %s\n",ELNAME(f_id));
sprintf(msg+strlen(msg),
" since triple edges %s and %s have common far endpoint.\n",
ELNAME(other_triples[i][j]),ELNAME1(other_triples[ii][jj]));
strcat(msg," Probably a face of a pyramid or triangular prism.\n");
outstring(msg);
return 0;
}
}
if ( verbose_flag )
{ sprintf(msg,"pop_quad_to_quad on facet %s\n",ELNAME(f_id));
outstring(msg);
}
ea = get_fe_edge(quad_triples[0]); /* for identifying kept edge */
eb = get_fe_edge(quad_triples[2]);
/* use old facet to get attributes for new before deleting old */
/* newf = new_facet(); */
newf = dup_facet(f_id);
set_facet_body(newf,NULLID);
set_facet_body(inverse_id(newf),NULLID);
/* get list of the quadrilateral's facets, in case quad is subdivided
too much for simple edge deletion to take care of
*/
quadfacets[0] = f_id;
qfcount = 1;
for ( i = 0 ; i < qfcount ; i++ )
{ fa = quadfacets[i];
fea = get_facet_fe(fa);
for ( j = 0 ; j < 3 ; j++, fea = get_next_edge(fea) )
{ if ( equal_id(get_next_facet(fea),get_prev_facet(fea)) )
{ /* add neighbor facet to list if not already there */
fb = get_fe_facet(get_next_facet(fea));
for ( k = 0 ; k < qfcount ; k++ )
{ if ( equal_element(fb,quadfacets[k]) )
break;
}
if ( k == qfcount ) /* not found, so add to list */
{ if ( qfcount >= MAXQF )
{ kb_error(2840,"pop_quad_to_quad: over 100 facets in quadrilateral.\n", RECOVERABLE);
}
quadfacets[qfcount++] = fb;
}
}
}
}
/* Delete original quadrilateral by deleting the short edges */
keepfe = get_next_facet(quad_triples[0]);
e_id = get_fe_edge(quad_triples[1]);
eliminate_edge(e_id);
free_element(e_id);
e_id = get_fe_edge(quad_triples[3]);
eliminate_edge(e_id);
free_element(e_id);
/* now delete any leftover quadrilateral facets */
for ( i = 0 ; i < qfcount ; i++ )
if ( valid_element(quadfacets[i]) )
eliminate_facet(quadfacets[i]);
/* make sure all the triple lines are left */
for ( i = 0 ; i < 4 ; i++ )
for ( j = 0 ; j < 2 ; j++ )
if ( !valid_element(other_triples[i][j]) )
{ sprintf(errmsg,
"Unanticipated geometry after eliminating quad for facet %s.\n",
ELNAME(f_id));
strcat(errmsg,"New quad not created.\n");
kb_error(2828,errmsg,WARNING);
}
/* Identify the remaining edge */
keepe = get_fe_edge(keepfe);
/* Create new quad */
newv[0] = get_edge_tailv(keepe);
newv[1] = get_edge_headv(keepe);
newv[2] = dup_vertex(newv[1]);
newv[3] = dup_vertex(newv[0]);
newe[0] = keepe;
newe[1] = dup_edge(keepe);
set_edge_tailv(newe[1],newv[1]);
set_edge_headv(newe[1],newv[2]);
newe[2] = dup_edge(keepe);
set_edge_tailv(newe[2],newv[2]);
set_edge_headv(newe[2],newv[3]);
newe[3] = dup_edge(keepe);
set_edge_tailv(newe[3],newv[3]);
set_edge_headv(newe[3],newv[0]);
if ( web.symmetry_flag )
{ set_edge_wrap(newe[1],0);
set_edge_wrap(newe[2],(*sym_inverse)(get_edge_wrap(newe[0])));
set_edge_wrap(newe[3],0);
}
for ( i = 0 ; i < 4 ; i++ )
{ newfe[i] = new_facetedge(newf,newe[i]);
set_next_facet(newfe[i],newfe[i]);
set_prev_facet(newfe[i],newfe[i]);
set_edge_fe(newe[i],newfe[i]);
}
set_facet_fe(newf,newfe[0]);
for ( i = 0 ; i < 4 ; i++ )
{ set_next_edge(newfe[i],newfe[(i+1)%4]);
set_prev_edge(newfe[i],newfe[(i+3)%4]);
}
cross_cut(newfe[0],newfe[1]);
/* Connect in with old stuff */
/* start with first corner */
e_id = other_triples[0][0];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,keepe) )
{ /* everything already ok, but adjust facetedges */
fea = newfe[0];
set_next_facet(next_fe,fea);
set_prev_facet(fea,next_fe);
set_prev_facet(next_fe,fea);
set_next_facet(fea,next_fe);
/* and line up next corner */
for(;;)
{ next_fe = get_next_edge(next_fe);
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
eee_id = get_fe_edge(next_fe);
if ( equal_element(eee_id,other_triples[1][0]) )
{ /* all ok */
}
else if ( equal_element(eee_id,other_triples[1][1]) )
{ /* swap */
edge_id tempe = other_triples[1][0];
other_triples[1][0] = other_triples[1][1];
other_triples[1][1] = tempe;
}
break;
}
next_fe = inverse_id(get_next_facet(next_fe));
}
}
else if ( equal_id(ee_id,other_triples[0][1]) )
{ /* spread out with new edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,newe[3]);
facetedge_id newefe = get_edge_fe(newe[3]);
while ( !equal_id(feb,next_fe) )
{ eee_id = get_fe_edge(feb);
remove_vertex_edge(newv[0],eee_id);
set_edge_tailv(eee_id,newv[3]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_next_facet(newefe,newfe);
set_prev_facet(newfe,newefe);
cross_cut(newfe,fe);
}
else if ( equal_id(ee_id,other_triples[3][0]) )
{ /* everything ok */
}
else if ( equal_id(ee_id,other_triples[3][1]) )
{ /* swap */
edge_id tempe = other_triples[3][0];
other_triples[3][0] = other_triples[3][1];
other_triples[3][1] = tempe;
}
else /* shouldn't get here */
kb_error(2820,"Aborted pop_quad_to_quad halfway through.\n",
RECOVERABLE);
break;
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
/* other triple out of first corner */
e_id = other_triples[3][0];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,keepe) )
{ /* everything already ok, adjust facetedges */
fea = newfe[0];
set_next_facet(next_fe,fea);
set_prev_facet(fea,next_fe);
set_prev_facet(next_fe,get_next_facet(fea));
set_next_facet(get_next_facet(fea),next_fe);
/* and line up next corner */
for(;;)
{ next_fe = get_next_edge(next_fe);
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
eee_id = get_fe_edge(next_fe);
if ( equal_element(eee_id,other_triples[2][0]) )
{ /* all ok */
}
else if ( equal_element(eee_id,other_triples[2][1]) )
{ /* swap */
edge_id tempe = other_triples[2][0];
other_triples[2][0] = other_triples[2][1];
other_triples[2][1] = tempe;
}
break;
}
next_fe = inverse_id(get_next_facet(next_fe));
}
}
else if ( equal_id(ee_id,other_triples[3][1]) )
{ /* spread out with new edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,newe[3]);
facetedge_id newefe = get_edge_fe(newe[3]);
while ( !equal_id(feb,next_fe) )
{ eee_id = get_fe_edge(feb);
remove_vertex_edge(newv[0],eee_id);
set_edge_tailv(eee_id,newv[3]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_next_facet(get_next_facet(newefe),newfe);
set_prev_facet(newfe,get_next_facet(newefe));
cross_cut(newfe,fe);
}
else if ( equal_id(ee_id,other_triples[0][0]) )
{ /* everything ok */
}
else /* shouldn't get here */
kb_error(2821,"Aborted pop_quad_to_quad halfway through.\n",
RECOVERABLE);
break;
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
/* another corner, at end of short edge from previous */
e_id = other_triples[0][1];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = fe;
for (;;)
{ ee_id = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ee_id),newv[3]) )
{ remove_vertex_edge(newv[0],ee_id);
set_edge_tailv(ee_id,newv[3]);
}
next_fe = inverse_id(get_prev_edge(next_fe));
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,newe[0]) )
{ /* move fe to new edge */
set_fe_edge(next_fe,inverse_id(newe[2]));
fea = inverse_id(newfe[2]);
set_next_facet(next_fe,fea);
set_prev_facet(fea,next_fe);
set_prev_facet(next_fe,fea);
set_next_facet(fea,next_fe);
}
else if ( equal_element(ee_id,newe[3]) )
{ /* all ok */
}
else if ( equal_id(ee_id,other_triples[3][1]) )
{ /* everything ok */
}
else /* shouldn't get here */
kb_error(2822,"Aborted pop_quad_to_quad halfway through.\n",
WARNING);
break;
}
next_fe = get_next_facet(next_fe);
}
}
/* other part of same corner, at end of short edge from previous */
e_id = other_triples[3][1];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = fe;
for (;;)
{ ee_id = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ee_id),newv[3]) )
{ remove_vertex_edge(newv[0],ee_id);
set_edge_tailv(ee_id,newv[3]);
}
next_fe = inverse_id(get_prev_edge(next_fe));
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,newe[0]) )
{ /* move fe to new edge */
set_fe_edge(next_fe,inverse_id(newe[2]));
fea = inverse_id(newfe[2]);
set_next_facet(next_fe,get_prev_facet(fea));
set_prev_facet(get_prev_facet(fea),next_fe);
set_prev_facet(next_fe,fea);
set_next_facet(fea,next_fe);
}
else if ( equal_id(ee_id,other_triples[0][1]) )
{ /* all ok */
}
else if ( equal_element(ee_id,newe[3]) )
{ /* everything ok */
}
else /* shouldn't get here */
kb_error(2823,"Aborted pop_quad_to_quad halfway through.\n",
WARNING);
break;
}
next_fe = get_next_facet(next_fe);
}
}
/* corner at other end of long edge from first corner */
e_id = other_triples[1][0];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,keepe) )
{ /* everything already ok, but adjust facetedges */
}
else if ( equal_id(ee_id,other_triples[1][1]) )
{ /* spread out with new edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,inverse_id(newe[1]));
facetedge_id newefe = get_edge_fe(inverse_id(newe[1]));
while ( !equal_id(feb,next_fe) )
{ eee_id = get_fe_edge(feb);
remove_vertex_edge(newv[1],eee_id);
set_edge_tailv(eee_id,newv[2]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,newefe);
set_prev_facet(newefe,newfe);
set_next_facet(newefe,newfe);
set_prev_facet(newfe,newefe);
cross_cut(newfe,fe);
}
else if ( equal_id(ee_id,other_triples[2][0]) )
{ /* everything ok */
}
else /* shouldn't get here */
kb_error(2824,"Aborted pop_quad_to_quad halfway through.\n",
WARNING);
break;
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
/* other edge at corner at other end of long edge from first corner */
e_id = other_triples[2][0];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = inverse_id(get_prev_edge(fe));
for (;;)
{ if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
ee_id = get_fe_edge(next_fe);
if ( equal_element(ee_id,keepe) )
{ /* everything already ok, but adjust facetedges */
}
else if ( equal_id(ee_id,other_triples[2][1]) )
{ /* spread out with new edge */
facetedge_id feb = inverse_id(get_prev_edge(fe));
facetedge_id fea = get_prev_edge(fe);
facet_id fa = get_fe_facet(fe);
facetedge_id newfe = new_facetedge(fa,inverse_id(newe[1]));
facetedge_id newefe = get_edge_fe(inverse_id(newe[1]));
while ( !equal_id(feb,next_fe) )
{ eee_id = get_fe_edge(feb);
remove_vertex_edge(newv[1],eee_id);
set_edge_tailv(eee_id,newv[2]);
feb = get_next_facet(feb);
feb = inverse_id(get_prev_edge(feb));
}
set_next_edge(fea,newfe);
set_prev_edge(newfe,fea);
set_prev_edge(fe,newfe);
set_next_edge(newfe,fe);
set_next_facet(newfe,get_prev_facet(newefe));
set_prev_facet(get_prev_facet(newefe),newfe);
set_next_facet(newefe,newfe);
set_prev_facet(newfe,newefe);
cross_cut(newfe,fe);
}
else if ( equal_id(ee_id,other_triples[1][0]) )
{ /* everything ok */
}
else /* shouldn't get here */
kb_error(2825,"Aborted pop_quad_to_quad halfway through.\n",
WARNING);
break;
}
next_fe = get_next_facet(next_fe);
next_fe = inverse_id(get_prev_edge(next_fe));
}
}
/* final corner */
e_id = other_triples[1][1];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = fe;
for (;;)
{ ee_id = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ee_id),newv[2]) )
{ remove_vertex_edge(newv[1],ee_id);
set_edge_tailv(ee_id,newv[2]);
}
next_fe = inverse_id(get_prev_edge(next_fe));
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
break;
}
next_fe = get_next_facet(next_fe);
}
}
/* other part of final corner */
e_id = other_triples[2][1];
fe = get_edge_fe(e_id);
for ( k = 0 ; k < 3 ; k++ )
{ /* traverse fan in all three directions */
fe = get_next_facet(fe);
next_fe = fe;
for (;;)
{ ee_id = get_fe_edge(next_fe);
if ( !equal_id(get_edge_tailv(ee_id),newv[2]) )
{ remove_vertex_edge(newv[1],ee_id);
set_edge_tailv(ee_id,newv[2]);
}
next_fe = inverse_id(get_prev_edge(next_fe));
if ( !equal_id(get_next_facet(next_fe),get_prev_facet(next_fe)) )
{ /* have found next triple edge */
break;
}
next_fe = get_next_facet(next_fe);
}
}
/* move vertices apart */
for ( i = 0 ; i < 4 ; i++ )
{ x[i] = get_coord(newv[i]);
for ( j = 0 ; j < 2 ; j++ )
get_edge_side(other_triples[i][j],sides[i][j]);
}
for ( j = 0 ; j < SDIM ; j++ )
{ REAL d;
d = sides[0][0][j]+sides[1][0][j]+sides[2][0][j]+sides[3][0][j];
x[0][j] += d/12;
x[1][j] += d/12;
d = sides[0][1][j]+sides[1][1][j]+sides[2][1][j]+sides[3][1][j];
x[2][j] += d/12;
x[3][j] += d/12;
}
/* Fix up facet edge orders */
for ( i = 0 ; i < 4 ; i++ )
{ facetedge_id next_fe;
int count;
fa = newfe[i];
fb = get_next_facet(fa);
fc = get_prev_facet(fa);
ea = newe[i];
eb = newe[(i+3)%4];
next_fe = inverse_id(get_prev_edge(fb));
for(count=0;count < 10000 ;count++)
{ ec = get_fe_edge(next_fe);
if ( equal_element(ec,ea) )
break; /* ok */
if ( equal_element(ec,eb) )
{ /* have to switch order around edge */
set_prev_facet(fa,fb);
set_prev_facet(fb,fc);
set_prev_facet(fc,fa);
set_next_facet(fa,fc);
set_next_facet(fc,fb);
set_next_facet(fb,fa);
break;
}
next_fe = inverse_id(get_prev_edge(get_prev_facet(next_fe)));
}
if ( count >= 10000 )
{ sprintf(errmsg,"Internal error after pop_quad_to_quad facet %s, bad topology around vertex %s.\n",ELNAME(f_id),ELNAME1(get_edge_tailv(ea)));
kb_error(2831,errmsg,RECOVERABLE);
}
}
/* fix up new facet bodies */
fa = get_fe_facet(newfe[0]);
fe = get_prev_facet(newfe[0]); /* debugging */
fb = get_fe_facet(fe);
b_id = get_facet_body(inverse_id(fb));
set_facet_body(fa,b_id);
set_facet_body(inverse_id(get_fe_facet(newfe[0])),
get_facet_body(get_fe_facet(get_next_facet(newfe[0]))));
set_facet_body(get_fe_facet(newfe[2]),
get_facet_body(inverse_id(get_fe_facet(get_prev_facet(newfe[2])))));
set_facet_body(inverse_id(get_fe_facet(newfe[2])),
get_facet_body(get_fe_facet(get_next_facet(newfe[2]))));
if ( web.modeltype == QUADRATIC )
{ /* fix up edge midpoints */
int bailcount = 0;
for ( i = 0 ; i < 4 ; i++ )
{ edge_id start_e = get_vertex_edge(newv[i]);
edge_id ea;
ea = start_e;
do
{ new_vertex_average(get_edge_midv(ea),VOLKEEP);
ea = get_next_tail_edge(ea);
if ( bailcount++ > 1000 ) break;
} while ( !equal_id(ea,start_e));
}
}
return 1;
} /* end pop_quad_to_quad */
/*****************************************************************************
*
* function: pop_constrained_vertex()
*
* purpose: analyze and pop a vertex on at least one constraint.
*
* return: 1 if popped, 0 if not.
*/
int pop_constrained_vertex(v_id)
vertex_id v_id;
{
conmap_t *vmap = get_v_constraint_map(v_id);
int vhits = v_hit_constraint_count(v_id);
int kind_counts[5][4]; /* indexed by valence, constraints */
edge_id kind_lists[5][4][20]; /* actual edges, for easy reference */
int toohigh=0,triples=0;
unsigned int i,j,val;
edge_id e_id,start_e;
if ( vhits == 3 )
return triple_con_pop(v_id);
for ( i = 0; i < 5 ; i++ )
for ( j = 0 ; j < 4 ; j++ )
kind_counts[i][j] = 0;
/* detect types of edges */
e_id = start_e = get_vertex_edge(v_id);
do
{ int valence = get_edge_valence(e_id);
conmap_t *emap = get_e_constraint_map(e_id);
int hits = 0;
/* see if constraints are at most those of v_id */
for ( i = 1 ; i <= emap[0] ; i++ )
{ int found = 0;
for ( j = 1 ; j <= vmap[0] ; j++ )
if ( emap[i] == (vmap[j] & ~CON_HIT_BIT) )
{ if ( vmap[j] & CON_HIT_BIT )
hits++;
found = 1;
break;
}
if ( !found )
{ if ( verbose_flag )
{ sprintf(msg,"Pop vertex %s fails since constraints of edge %s are not a subset of those of the vertex.\n",ELNAME(v_id),ELNAME1(e_id));
outstring(msg);
}
return 0;
}
}
if ( valence > 3 ) { valence = 4; toohigh++; }
if ( valence == 3 ) triples++;
if ( hits > 3 ) hits = 4;
if ( kind_counts[valence][hits] > 20 )
{ sprintf(errmsg,"Too many edges around vertex %s for pop to handle.\n",
ELNAME(v_id));
kb_error(4001,errmsg,WARNING);
return 0;
}
kind_lists[valence][hits][kind_counts[valence][hits]++] = e_id;
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(e_id,start_e) );
/* see what we have */
if ( toohigh )
{ if ( verbose_flag )
{ sprintf(msg,
"Vertex %s has edges of valence more than 3, so pop edges first.\n",
ELNAME(v_id));
outstring(msg);
}
}
if ( (vhits == 2) && (triples == 1))
return double_con_pop(v_id,kind_lists[3][0][0],kind_lists[1][1]);
val = get_vertex_evalence(v_id);
if ( (vhits == 1) && (kind_counts[1][1]==4) &&
(kind_counts[2][0] == val-4) )
return one_con_pop_4(v_id,kind_lists[1][1],POP_TO_BETTER);
/* test for ok configurations */
if ( (vhits <= 2) && (triples == 0) )
return 0;
if ( triples <= 1 )
return 0;
/* so now have one constraint and at least two triple lines */
if ( (triples == 2) && (kind_counts[3][0] == 2) && (kind_counts[1][1]==4) )
{ /* common case of two unconstrained triple lines with 4 constrained edges */
return one_con_pop_2(v_id,kind_lists[3][0],kind_lists[1][1],POP_TO_BETTER);
}
if ( (triples >= 3) && (kind_counts[3][0] == triples)
&& (kind_counts[1][1]==triples) )
{ /* common case of N unconstrained triple lines with N constrained edges */
return one_con_pop_3(v_id,triples,kind_lists[3][0],kind_lists[1][1],
POP_TO_BETTER);
}
return 0;
}
/*****************************************************************************
*
* function: triple_con_pop()
*
* purpose: Move film out of corner where three constraints meet.
* Does nothing if one adjacent edge is on two constraints.
* Just frees vertex from constraint not used by edges,
* if not a one-sided constraint. Doesn't actually move vertex.
*
* return: 1 if successful, 0 if not
*/
int triple_con_pop(v_id)
vertex_id v_id;
{
conmap_t *vmap = get_v_constraint_map(v_id);
edge_id e_id, start_e;
/* edge_id conedges[2]; */
conmap_t cons[2];
unsigned int ehits=0; /* number of adjacent edges on constraints */
unsigned int i,j;
/* see if any adjacent edge is on two constraints */
/* and find out what constraints are involved */
e_id = start_e = get_vertex_edge(v_id);
do
{ conmap_t *emap = get_e_constraint_map(e_id);
int this_hits = 0;
for ( i = 1 ; i <= emap[0] ; i++ )
{
for ( j = 0 ; j <= vmap[0] ; j++ )
{ if ( (emap[j]==(vmap[j]&~CON_HIT_BIT)) && (vmap[j] & CON_HIT_BIT) )
{ if ( this_hits )
{ /* now second constraint on edge */
return 0;
}
/* conedges[ehits] = e_id; */
cons[ehits] = emap[j];
ehits++;
this_hits++;
}
}
}
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(e_id,start_e) );
/* see if constraint not used by edges is not one-sided */
for ( i = 1 ; i <= vmap[0] ; i++ )
{ if ( !(vmap[i] & CON_HIT_BIT) ) continue;
if ( get_constraint(vmap[i])->attr & (NONPOSITIVE|NONNEGATIVE) ) continue;
for ( j = 0 ; j < ehits ; j++ )
if ( cons[j] == (vmap[i] & ~CON_HIT_BIT) )
continue;
/* now have freeable constraint */
unset_v_constraint_map(v_id,vmap[i]);
return 1;
}
return 0;
}
/*****************************************************************************
*
* function: double_con_pop()
*
* purpose: Pop triple line coming into junction of two constraints.
* Moves triple line end to the constraint it is most
* parallel to. Presumably triple edge got there by deletion
* of a short edge, so probably wants to go on the constraint
* with the single edge.
*
* return: 1 if successful, 0 if not
*/
int double_con_pop(v_id,triple,con_edges)
vertex_id v_id;
edge_id triple; /* the triple edge */
edge_id *con_edges; /* the edges on constraints */
{
conmap_t *vmap = get_v_constraint_map(v_id);
conmap_t cons[2];
conmap_t concounts[2];
unsigned int count;
unsigned int i,j,k;
edge_id cedges[2][2];
REAL tripvec[MAXCOORD];
REAL con_normal[2][MAXCOORD];
REAL dummy;
if ( (get_vattr(v_id) & FIXED) || (get_eattr(con_edges[0]) & FIXED)
|| (get_eattr(con_edges[1]) & FIXED) || (get_eattr(con_edges[2]) & FIXED))
return 0;
concounts[0] = concounts[1] = count = 0;
/* find which constraint used twice */
for ( i = 0 ; i < 3 ; i++ )
{ conmap_t *emap = get_e_constraint_map(con_edges[i]);
for ( j = 1 ; j <= emap[0] ; j++ )
{ /* see if hit by vertex */
for ( k = 1 ; k <= vmap[0] ; k++ )
if ( (emap[j] == (vmap[k] & ~CON_HIT_BIT)) && (vmap[k] & CON_HIT_BIT) )
break;
if ( k > vmap[0] ) continue;
for ( k = 0 ; k < count ; k++ )
{ if ( emap[j] == cons[k] )
{
cedges[k][concounts[k]++] = con_edges[i];
break;
}
}
if ( k == count )
{ cons[k] = emap[j];
concounts[k] = 1;
cedges[k][0] = con_edges[i];
count++;
}
}
}
if ( concounts[0] == 1 )
{ /* swap */
edge_id tempe;
conmap_t temp;
tempe = cedges[0][0];
cedges[0][0] = cedges[1][0];
cedges[0][1] = cedges[1][1];
cedges[1][0] = tempe;
temp = cons[0];
cons[0] = cons[1];
cons[1] = temp;
concounts[0] = 2;
concounts[1] = 1;
}
/* calculate gradients */
for ( i = 0 ; i < 2 ; i++ )
eval_all(get_constraint(cons[i])->formula,get_coord(v_id),SDIM,
&dummy,con_normal[i],v_id);
if (fabs(dot(tripvec,con_normal[0],SDIM)) < fabs(dot(tripvec,con_normal[1],SDIM)))
{ /* v_id goes to single-edge constraint */
/* generated new vertices on junction by refining edges */
edge_refine(cedges[0][0]);
edge_refine(cedges[0][1]);
/* old edge is the one attached to v_id */
set_v_constraint_map(get_edge_headv(cedges[0][0]),cons[1]);
set_v_constraint_map(get_edge_headv(cedges[0][1]),cons[1]);
unset_v_constraint_map(v_id,cons[0]);
unset_e_constraint_map(cedges[0][0],cons[0]);
unset_e_constraint_map(cedges[0][1],cons[0]);
set_e_constraint_map(cedges[0][0],cons[1]);
set_e_constraint_map(cedges[0][1],cons[1]);
}
else
{ /* move to double-edge constraint */
edge_refine(cedges[1][0]);
/* old edge is the one attached to v_id */
set_v_constraint_map(get_edge_headv(cedges[1][0]),cons[0]);
unset_v_constraint_map(v_id,cons[1]);
unset_e_constraint_map(cedges[1][0],cons[1]);
set_e_constraint_map(cedges[1][0],cons[0]);
}
return 1;
}
/***************************************************************************
*
* function: one_con_pop_2()
*
* purpose: pop a specific configuration of two triple edges on vertex
* with one constraint. Favors simple pull apart of triple edges.
*
* return: 1 if successful
*/
int one_con_pop_2(v_id,triples,con_edges,mode)
vertex_id v_id;
edge_id *triples;
edge_id *con_edges;
int mode; /* POP_TO_OPEN or POP_TO_TWIST or POP_BETTER */
{ vertex_id newv;
edge_id newe,e_id;
facetedge_id fe,start_fe,newfe;
unsigned int i,j,k;
REAL sides[2][2][MAXCOORD];
REAL mag[2][2];
REAL *x;
edge_id attached[2][2]; /* which constraint edges attached to which trip */
int atcount[2];
conmap_t con=0,*vmap; /* which constraint involved */
int n;
REAL pull[2][MAXCOORD]; /* separating forces for the two ways */
if ( get_vattr(v_id) & FIXED ) return 0;
/* see which constraint edges attached to which triple, and get in order */
atcount[0] = atcount[1] = 0;
for ( k = 0 ; k < 2 ; k++ ) /* for each triple edge */
{ int triple_second_flag = 0;
start_fe = get_edge_fe(triples[k]);
for ( i = 0 ; i < 3 ; i++ )
{
fe = inverse_id(get_prev_edge(start_fe));
for(;;)
{
if ( equal_id(triples[1-k],get_fe_edge(fe)) )
{ if ( i == 1 )
triple_second_flag = 1;
break;
}
e_id = get_fe_edge(fe);
if ( equal_id(fe,get_next_facet(fe)) )
{ /* found valence 1 edge */
attached[k][atcount[k]++] = e_id;
break;
}
fe = inverse_id(get_prev_edge(get_next_facet(fe)));
}
start_fe = get_next_facet(start_fe);
}
if ( triple_second_flag )
{ /* swap into standard order */
edge_id temp = attached[k][0];
attached[k][0] = attached[k][1];
attached[k][1] = temp;
}
for ( i = 0 ; i < 2 ; i++ )
get_edge_side(attached[k][i],sides[k][i]);
}
/* see which constraint involved */
vmap = get_v_constraint_map(v_id);
for ( i = 1; i <= vmap[0] ; i++ )
if ( vmap[i] & CON_HIT_BIT )
{ con = vmap[i] & ~CON_HIT_BIT;
break;
}
/* figure out which way it should pop according to edges on constraints */
if ( mode == POP_TO_BETTER )
{ for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < 2 ; j++ )
mag[i][j] = dot(sides[i][j],sides[i][j],SDIM);
for ( n = 0 ; n < SDIM ; n++ )
{ pull[0][n] = sides[0][0][n]/mag[0][0]+sides[1][1][n]/mag[1][1]
-sides[0][1][n]/mag[0][1]-sides[1][0][n]/mag[1][0];
pull[1][n] = sides[0][0][n]/mag[0][0]+sides[0][1][n]/mag[0][1]
-sides[1][0][n]/mag[1][0]-sides[1][1][n]/mag[1][1];
}
if ( dot(pull[0],pull[0],SDIM) < 1.2*dot(pull[1],pull[1],SDIM) )
mode = POP_TO_OPEN;
else
mode = POP_TO_TWIST;
}
if ( mode == POP_TO_OPEN )
{ /* simple pull two triple edges apart */
newv = dup_vertex(v_id);
newe = new_edge(v_id,newv,NULLID);
set_e_conmap(newe,get_v_constraint_map(v_id));
/* move stuff around second triple edge to newv */
remove_vertex_edge(v_id,triples[1]);
set_edge_tailv(triples[1],newv);
start_fe = get_edge_fe(triples[1]);
for ( i = 0 ; i < 3 ; i++ )
{
fe = inverse_id(get_prev_edge(start_fe));
for(;;)
{
if ( equal_id(triples[0],get_fe_edge(fe)) )
{ /* take care of splitting facet(s) between triples */
facet_id f_id = inverse_id(get_fe_facet(fe));
newfe = new_facetedge(f_id,newe);
set_edge_fe(newe,newfe);
set_next_facet(newfe,newfe);
set_prev_facet(newfe,newfe);
set_prev_edge(newfe,inverse_id(fe));
set_next_edge(newfe,inverse_id(get_prev_edge(fe)));
set_prev_edge(inverse_id(get_prev_edge(fe)),newfe);
set_next_edge(inverse_id(fe),newfe);
cross_cut(inverse_id(fe),newfe);
break;
}
e_id = get_fe_edge(fe);
remove_vertex_edge(v_id,e_id);
set_edge_tailv(e_id,newv);
if ( equal_id(fe,get_next_facet(fe)) )
{ /* found valence 1 edge */
break;
}
fe = inverse_id(get_prev_edge(get_next_facet(fe)));
}
start_fe = get_next_facet(start_fe);
}
/* move vertices apart a bit */
x = get_coord(newv);
for ( n = 0 ; n < SDIM ; n++ )
x[n] += sides[0][0][n]/6 + sides[0][1][n]/6 + sides[1][0][n]/3
+ sides[1][1][n]/3;
x = get_coord(v_id);
for ( n = 0 ; n < SDIM ; n++ )
x[n] += sides[0][0][n]/3 + sides[0][1][n]/3 + sides[1][0][n]/6
+ sides[1][1][n]/6;
}
else
{ /* create twist facet in pull-apart */
vertex_id newv1,newv2;
edge_id newe1,newe2,newe3;
facet_id newf;
facetedge_id fe,prevfe,newfe1,newfe2,newfe3,newfe4,newfe5;
REAL tsides[2][MAXCOORD];
/* v_id will be released from constraint and moved off constraint */
newv1 = dup_vertex(v_id);
newv2 = dup_vertex(v_id);
newe1 = new_edge(v_id,newv1,triples[0]);
newe2 = new_edge(v_id,newv2,triples[0]);
newe3 = new_edge(newv1,newv2,NULLID);
set_e_conmap(newe3,get_v_constraint_map(v_id));
unset_v_constraint_map(v_id,con);
/* create twist facet */
newf = new_facet();
newfe1 = new_facetedge(newf,newe1);
newfe2 = new_facetedge(inverse_id(newf),newe2);
newfe3 = new_facetedge(newf,newe3);
set_edge_fe(newe1,newfe1);
set_edge_fe(newe2,newfe2);
set_edge_fe(newe3,newfe3);
set_facet_fe(newf,newfe1);
set_next_edge(newfe1,newfe3);
set_next_edge(newfe2,inverse_id(newfe3));
set_next_edge(newfe3,inverse_id(newfe2));
set_prev_edge(newfe1,inverse_id(newfe2));
set_prev_edge(newfe2,inverse_id(newfe1));
set_prev_edge(newfe3,newfe1);
set_next_facet(newfe3,newfe3);
set_prev_facet(newfe3,newfe3);
/* reconnect wings */
remove_vertex_edge(v_id,attached[0][0]);
remove_vertex_edge(v_id,attached[0][1]);
remove_vertex_edge(v_id,attached[1][0]);
remove_vertex_edge(v_id,attached[1][1]);
set_edge_tailv(attached[0][0],newv2);
set_edge_tailv(attached[0][1],newv1);
set_edge_tailv(attached[1][0],newv1);
set_edge_tailv(attached[1][1],newv2);
fe = get_edge_fe(attached[0][0]);
prevfe = get_prev_edge(fe);
newfe4 = new_facetedge(get_fe_facet(fe),newe2);
set_next_edge(prevfe,newfe4);
set_prev_edge(newfe4,prevfe);
set_next_edge(newfe4,fe);
set_prev_edge(fe,newfe4);
set_next_facet(newfe2,newfe4);
set_prev_facet(newfe4,newfe2);
cross_cut(newfe4,fe);
fe = get_edge_fe(attached[1][1]);
prevfe = get_prev_edge(fe);
newfe5 = new_facetedge(get_fe_facet(fe),newe2);
set_next_edge(prevfe,newfe5);
set_prev_edge(newfe5,prevfe);
set_next_edge(newfe5,fe);
set_prev_edge(fe,newfe5);
set_next_facet(newfe5,newfe2);
set_prev_facet(newfe2,newfe5);
set_next_facet(newfe4,newfe5);
set_prev_facet(newfe5,newfe4);
cross_cut(newfe5,fe);
fe = get_edge_fe(attached[1][0]);
prevfe = get_prev_edge(fe);
newfe4 = new_facetedge(get_fe_facet(fe),newe1);
set_next_edge(prevfe,newfe4);
set_prev_edge(newfe4,prevfe);
set_next_edge(newfe4,fe);
set_prev_edge(fe,newfe4);
set_next_facet(newfe1,newfe4);
set_prev_facet(newfe4,newfe1);
cross_cut(newfe4,fe);
fe = get_edge_fe(attached[0][1]);
prevfe = get_prev_edge(fe);
newfe5 = new_facetedge(get_fe_facet(fe),newe1);
set_next_edge(prevfe,newfe5);
set_prev_edge(newfe5,prevfe);
set_next_edge(newfe5,fe);
set_prev_edge(fe,newfe5);
set_next_facet(newfe5,newfe1);
set_prev_facet(newfe1,newfe5);
set_next_facet(newfe4,newfe5);
set_prev_facet(newfe5,newfe4);
cross_cut(newfe5,fe);
set_facet_body(newf,get_facet_body(inverse_id(get_fe_facet(newfe5))));
set_facet_body(inverse_id(newf),get_facet_body(get_fe_facet(newfe4)));
/* move vertices */
x = get_coord(newv1);
for ( n = 0 ; n < SDIM ; n++ )
x[n] += sides[1][0][n]/3 + sides[0][1][n]/3 + sides[0][0][n]/6
+ sides[1][1][n]/6;
x = get_coord(newv2);
for ( n = 0 ; n < SDIM ; n++ )
x[n] += sides[1][0][n]/6 + sides[0][1][n]/6 + sides[0][0][n]/3
+ sides[1][1][n]/3;
x = get_coord(v_id);
get_edge_side(triples[0],tsides[0]);
get_edge_side(triples[1],tsides[1]);
for ( n = 0 ; n < SDIM ; n++ )
x[n] += 0.15*tsides[0][n] + 0.15*tsides[1][n];
}
return 1;
}
/***************************************************************************
*
* function: one_con_pop_3()
*
* purpose: pop a specific configuration of N triple edges on vertex
* with one constraint. Each triple edge is on a fin with
* one constrained edge.
*
* return: 1 if successful
*/
#define MAXTRIPS 20
int one_con_pop_3(v_id,tripcount,triples,con_edges,mode)
vertex_id v_id;
int tripcount;
edge_id *triples;
edge_id *con_edges;
int mode; /* POP_TO_OPEN or POP_TO_TRIPLE or POP_BETTER */
{
edge_id e_id;
unsigned int i;
REAL sides[MAXTRIPS][MAXCOORD];
REAL tsides[MAXTRIPS][MAXCOORD];
REAL mag[MAXTRIPS];
REAL net[MAXCOORD];
REAL *x;
conmap_t con=0,*vmap; /* which constraint involved */
int j,n,m;
facetedge_id fe;
if ( get_vattr(v_id) & FIXED ) return 0;
/* see which constraint involved */
vmap = get_v_constraint_map(v_id);
for ( i = 1; i <= vmap[0] ; i++ )
if ( vmap[i] & CON_HIT_BIT )
{ con = vmap[i] & ~CON_HIT_BIT;
break;
}
/* get triple edges and constrained edges lined up */
fe = get_edge_fe(con_edges[0]);
fe = inverse_id(get_prev_edge(fe));
while ( equal_id(get_next_facet(fe),get_prev_facet(fe)) )
fe = inverse_id(get_prev_edge(get_next_facet(fe)));
fe = get_prev_facet(fe);
for ( m = 0 ; m < tripcount ; m++ )
{ facetedge_id ffe;
triples[m] = get_fe_edge(fe);
/* seek down to corresponding constrained edge */
ffe = get_next_facet(fe);
ffe = inverse_id(get_prev_edge(ffe));
while ( !equal_id(get_next_facet(ffe),ffe) )
ffe = inverse_id(get_prev_edge(get_next_facet(ffe)));
con_edges[m] = get_fe_edge(ffe);
/* now over to next triple */
fe = get_prev_facet(fe);
fe = inverse_id(get_prev_edge(fe));
while ( equal_id(get_next_facet(fe),get_prev_facet(fe)) )
fe = inverse_id(get_prev_edge(get_next_facet(fe)));
}
for ( m = 0 ; m < tripcount ; m++ )
get_edge_side(triples[m],tsides[m]);
for ( m = 0 ; m < tripcount ; m++ )
{ get_edge_side(con_edges[m],sides[m]);
mag[m] = sqrt(dot(tsides[m],tsides[m],SDIM));
}
/* figure out which way it should pop according to edges on constraints */
if ( mode == POP_TO_BETTER )
{ for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0, net[n] = 0.0 ; m < tripcount ; m++ )
net[n] += tsides[m][n]/mag[m];
if ( sqrt(dot(net,net,SDIM)) < 0.7*tripcount )
mode = POP_TO_OPEN;
else
mode = POP_TO_TRIPLE;
}
/* do the pop */
if ( mode == POP_TO_OPEN )
{ /* make open triangle */
vertex_id newv[MAXTRIPS];
edge_id newe[MAXTRIPS];
facetedge_id next_fe,fe,start_fe,newfe;
newv[0] = v_id;
for ( m = 1 ; m < tripcount ; m++ )
newv[m] = dup_vertex(v_id);
for ( m = 0 ; m < tripcount ; m++ )
{ newe[m] = new_edge(newv[m],newv[(m+1)%tripcount],NULLID);
set_e_conmap(newe[m],get_v_constraint_map(v_id));
}
/* move stuff around last two constraint edges to new vertices */
/* and putting in new edges */
for ( m = 0 ; m < tripcount ; m++ )
{ int found_triple;
if ( m > 0 )
{ remove_vertex_edge(v_id,con_edges[m]);
set_edge_tailv(con_edges[m],newv[m]);
}
start_fe = get_edge_fe(con_edges[m]);
fe = inverse_id(get_prev_edge(start_fe));
for( found_triple = 0 ; !found_triple ; fe = next_fe )
{
next_fe = inverse_id(get_prev_edge(get_next_facet(fe)));
if ( !equal_id(get_next_facet(fe),get_prev_facet(fe)) )
{ /* take care of splitting facet(s) between triples */
facet_id f_id;
facetedge_id ffe,prevfe;
ffe = get_next_facet(fe);
f_id = inverse_id(get_fe_facet(ffe));
newfe = new_facetedge(f_id,newe[m]);
set_edge_fe(newe[m],newfe);
set_next_facet(newfe,newfe);
set_prev_facet(newfe,newfe);
prevfe = inverse_id(get_prev_edge(ffe));
set_prev_edge(newfe,inverse_id(ffe));
set_next_edge(newfe,prevfe);
set_prev_edge(prevfe,newfe);
set_next_edge(inverse_id(ffe),newfe);
/* continue on, resetting endpoints on crossing face */
if ( m != tripcount-1 )
while (equal_id(get_next_facet(prevfe),get_prev_facet(prevfe)))
{ e_id = get_fe_edge(prevfe);
remove_vertex_edge(v_id,e_id);
set_edge_tailv(e_id,newv[m+1]);
prevfe = inverse_id(get_prev_edge(get_next_facet(prevfe)));
}
cross_cut(newfe,get_next_edge(newfe));
found_triple = 1;
}
e_id = get_fe_edge(fe);
if ( m > 0 )
{ remove_vertex_edge(v_id,e_id);
set_edge_tailv(e_id,newv[m]);
}
}
}
/* move vertices apart a bit */
for ( m = 0 ; m < tripcount ; m++ )
{ x = get_coord(newv[m]);
for ( n = 0 ; n < SDIM ; n++ )
{ x[n] += 0.5*sides[m][n];
for ( j = 0 ; j < tripcount ; j++ )
x[n] += 0.5*sides[j][n]/tripcount;
}
}
}
else
{ /* create pulled-out triple edge */
vertex_id newv;
edge_id newe;
facetedge_id fe,prevfe,newfe[MAXTRIPS];
/* v_id will be released from constraint and moved off constraint */
newv = dup_vertex(v_id);
newe = new_edge(v_id,newv,triples[0]);
unset_v_constraint_map(v_id,con);
/* reconnect wings */
for ( m = 0 ; m < tripcount ; m++ )
{ remove_vertex_edge(v_id,con_edges[m]);
set_edge_tailv(con_edges[m],newv);
fe = get_edge_fe(con_edges[m]);
prevfe = get_prev_edge(fe);
newfe[m] = new_facetedge(get_fe_facet(fe),newe);
set_next_edge(prevfe,newfe[m]);
set_prev_edge(newfe[m],prevfe);
set_next_edge(newfe[m],fe);
set_prev_edge(fe,newfe[m]);
cross_cut(newfe[m],fe);
}
set_edge_fe(newe,newfe[0]);
for ( m = 0 ; m < tripcount ; m++ )
{ set_next_facet(newfe[m],newfe[(m+1)%tripcount]);
set_prev_facet(newfe[(m+1)%tripcount],newfe[m]);
}
fe_reorder(newe); /* make sure in proper geometric order */
/* move vertex */
x = get_coord(v_id);
for ( n = 0 ; n < SDIM ; n++ )
{ for ( m= 0 ; m < tripcount ; m++ )
x[n] += 0.3*tsides[m][n]/tripcount;
}
}
return 1;
}
/***************************************************************************
*
* function: one_con_pop_4()
*
* purpose: pop a specific configuration of two films meeting at a
* point on a constraint, i.e. parting mounds.
* Or joining mounds that are touching at one vertex.
*
* return: 1 if successful
*/
int one_con_pop_4(v_id,con_edges,mode)
vertex_id v_id;
edge_id *con_edges;
int mode; /* POP_TO_OPEN or POP_TO_TRIANGLE or POP_TO_BETTER */
{
vertex_id newv[2];
int i;
REAL sides[4][MAXCOORD];
REAL mag[4];
facetedge_id fe,next_fe;
if ( get_vattr(v_id) & FIXED ) return 0;
/* see which constraint edges belong together */
fe = get_edge_fe(con_edges[0]);
do
{ fe = inverse_id(get_prev_edge(fe));
next_fe = get_next_facet(fe);
if ( equal_id(fe,next_fe) )
{ /* found it */
edge_id other_e = get_fe_edge(fe);
for ( i = 2 ; i < 4 ; i++ ) /* get in second spot */
if ( equal_id(other_e,con_edges[i]) )
{ con_edges[i] = con_edges[1];
con_edges[1] = other_e;
}
break;
}
fe = next_fe;
} while (1);
/* get side vectors */
for ( i = 0 ; i < 4 ; i++ )
{ get_edge_side(con_edges[i],sides[i]);
mag[i] = sqrt(dot(sides[i],sides[i],SDIM));
}
/* figure out which way it should pop according to edges on constraints */
if ( mode == POP_TO_BETTER )
{ if ( pop_disjoin_flag )
mode = POP_TO_OPEN;
/* if included angles bigger than exterior, then merge */
else if ( acos(dot(sides[0],sides[1],SDIM)/mag[0]/mag[1])
+ acos(dot(sides[2],sides[3],SDIM)/mag[2]/mag[3]) > M_PI )
mode = POP_TO_TRIANGLE;
else
mode = POP_TO_OPEN;
}
/* do the pop */
if ( mode == POP_TO_OPEN )
{ /* make separate vertices */
edge_id other_e;
newv[0] = v_id;
newv[1] = dup_vertex(v_id);
/* reconnect edges */
next_fe = get_edge_fe(con_edges[2]);
do
{
fe = next_fe;
other_e = get_fe_edge(fe);
remove_vertex_edge(v_id,other_e);
set_edge_tailv(other_e,newv[1]);
fe = inverse_id(get_prev_edge(fe));
next_fe = get_next_facet(fe);
} while ( !equal_id(other_e,con_edges[3]) );
set_vertex_edge(newv[0],con_edges[0]);
set_vertex_edge(newv[1],con_edges[2]);
/* no reason to move vertices apart a bit */
}
else
{ /* create pulled-out triangle */
facetedge_id fe1,fe2,newfe1,newfe2,prev1,prev2;
REAL *xold,*xnew;
edge_id newe;
facet_id f1,f2;
facetedge_id fe_a,fe_b,cc_fe;
body_id b1f,b1b,b2f,b2b;
/* get con_edges in canonical order */
if ( dot(sides[0],sides[3],SDIM)*mag[1]*mag[2]
+ dot(sides[1],sides[2],SDIM)*mag[0]*mag[3]
< dot(sides[0],sides[2],SDIM)*mag[1]*mag[3]
+ dot(sides[1],sides[3],SDIM)*mag[0]*mag[2])
{ edge_id tmpe = con_edges[2]; con_edges[2] = con_edges[3];
con_edges[3] = tmpe;
for ( i = 0 ; i < SDIM ; i++ )
{ REAL t = sides[2][i]; sides[2][i] = sides[3][i]; sides[3][i] = t; }
}
/* first, split vertex and put edge between */
newv[0] = v_id;
newv[1] = dup_vertex(v_id);
newe = new_edge(newv[0],newv[1],NULLID);
f1 = get_fe_facet(get_edge_fe(con_edges[1]));
f2 = get_fe_facet(get_edge_fe(con_edges[2]));
newfe1 = new_facetedge(f1,newe);
newfe2 = new_facetedge(f2,newe);
set_edge_fe(newe,newfe1);
set_next_facet(newfe1,newfe2);
set_prev_facet(newfe1,newfe2);
set_next_facet(newfe2,newfe1);
set_prev_facet(newfe2,newfe1);
/* reconnect edges */
remove_vertex_edge(v_id,con_edges[1]);
set_edge_tailv(con_edges[1],newv[1]);
remove_vertex_edge(v_id,con_edges[2]);
set_edge_tailv(con_edges[2],newv[1]);
fe1 = get_edge_fe(con_edges[1]);
prev1 = get_prev_edge(fe1);
set_prev_edge(newfe1,prev1);
set_next_edge(prev1,newfe1);
set_next_edge(newfe1,fe1);
set_prev_edge(fe1,newfe1);
fe2 = get_edge_fe(con_edges[2]);
prev2 = get_prev_edge(fe2);
set_prev_edge(newfe2,prev2);
set_next_edge(prev2,newfe2);
set_next_edge(newfe2,fe2);
set_prev_edge(fe2,newfe2);
cross_cut(prev1,newfe1);
cross_cut(prev2,newfe2);
/* move vertices apart a bit */
xold = get_coord(v_id);
xnew = get_coord(newv[1]);
for ( i = 0 ; i < SDIM ; i++ )
{ xold[i] += 0.1 * sides[0][i] + 0.1 * sides[3][i];
xnew[i] += 0.1 * sides[1][i] + 0.1 * sides[2][i];
}
/* refine the new edge */
cc_fe = get_next_edge(newfe1); /* need to save for later */
edge_refine(newe);
/* Septum if bodies disagree */
b1f = get_facet_body(f1);
b1b = get_facet_body(inverse_id(f1));
b2f = get_facet_body(f2);
b2b = get_facet_body(inverse_id(f2));
/* figure out which side needs the septum, if any */
fe_a = fe_b = NULLID;
if ( !equal_id(b1b,b2f) )
{ fe_a = newfe1;
fe_b = get_prev_edge(cc_fe);
}
else if ( !equal_id(b1f,b2b) )
{ fe_a = inverse_id(get_prev_edge(cc_fe));
fe_b = inverse_id(newfe1);
}
if ( valid_id(fe_a) )
{ /* put in new facet */
edge_id span_e = new_edge( get_fe_headv(fe_b),get_fe_tailv(fe_a),v_id);
facet_id span_f = new_facet();
facetedge_id span_fe = new_facetedge(span_f,span_e);
facetedge_id fe_a_new = new_facetedge(span_f,get_fe_edge(fe_a));
facetedge_id fe_b_new = new_facetedge(span_f,get_fe_edge(fe_b));
facetedge_id fe_c,fe_d;
set_facet_fe(span_f,span_fe);
set_edge_fe(span_e,span_fe);
set_facet_density(span_f,1.0);
set_next_edge(span_fe,fe_a_new);
set_next_edge(fe_a_new,fe_b_new);
set_next_edge(fe_b_new,span_fe);
set_prev_edge(span_fe,fe_b_new);
set_prev_edge(fe_b_new,fe_a_new);
set_prev_edge(fe_a_new,span_fe);
set_next_facet(span_fe,span_fe);
set_prev_facet(span_fe,span_fe);
fe_c = get_next_facet(fe_a);
fe_d = get_next_facet(fe_b);
set_next_facet(fe_a,fe_a_new);
set_next_facet(fe_a_new,fe_c);
set_prev_facet(fe_c,fe_a_new);
set_prev_facet(fe_a_new,fe_a);
set_next_facet(fe_b,fe_b_new);
set_next_facet(fe_b_new,fe_d);
set_prev_facet(fe_d,fe_b_new);
set_prev_facet(fe_b_new,fe_b);
set_facet_body(span_f,get_facet_body(inverse_id(get_fe_facet(fe_a))));
set_facet_body(inverse_id(span_f),get_facet_body(get_fe_facet(fe_c)));
}
} /* end pulled-out triangle */
return 1;
}
/**************************************************************************
*
* function: pop_tri_to_edge_con()
*
* purpose: Implement pop_tri_to_edge for triple edge with tail on constraint.
* Algorithm: deletes edge, calls one_con_pop_3 in proper mode.
* Called from pop_tri_to_edge(), which has checked valence and
* number of triple edges at head.
*
* return: 1 if successful, 0 if not.
*/
int pop_edge_to_tri_con(e_id)
edge_id e_id;
{ vertex_id v_id = get_edge_tailv(e_id);
edge_id ee_id, start_e;
int retval;
int concount = 0,tripcount = 0;
edge_id triples[20];
edge_id con_edges[20];
retval = eliminate_edge(e_id);
if ( retval == 0 )
return 0;
free_element(e_id); /* quirk of eliminate_edge */
/* gather data for one_con_pop_3 */
ee_id = start_e = get_vertex_edge(v_id);
do
{ int valence = get_edge_valence(ee_id);
if ( valence == 3 )
triples[tripcount++] = ee_id;
if ( valence == 1 )
con_edges[concount++] = ee_id;
ee_id = get_next_tail_edge(ee_id);
if ( tripcount >= 20 || concount >= 20 )
{ if ( verbose_flag )
{ sprintf(msg,"Can't handle over 20-valence edge %s! Sorry.\n",
ELNAME(e_id));
outstring(msg);
}
return 0;
}
} while ( !equal_id(ee_id,start_e) );
if ( tripcount != concount )
{ if ( verbose_flag )
{ sprintf(msg,"Pop_edge_to_tri not applicable to edge %s.\n",ELNAME(e_id));
outstring(msg);
}
return 0;
}
return one_con_pop_3(v_id,tripcount,triples,con_edges,POP_TO_OPEN);
}
evolver-2.30c.dfsg/src/web.h 0000644 0001753 0001753 00000022311 11410765113 016142 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* The ultimate structure for a whole surface , including all global
* variables needed to export for distributed computing.
*/
#ifdef __cplusplus
extern "C" {
#endif
/* structure type name different from structure variable name since
Visual C is incompetent at distinguishing in debugger. */
struct webstruct {
struct skeleton skel[NUMELEMENTS];
int sizes[NUMELEMENTS]; /* allocated space for element structure */
int usedsizes[NUMELEMENTS]; /* used space for element structure */
struct element **elhashtable; /* id hash list of element pointers */
int elhashcount; /* actual number of live entries */
int elhashmask; /* for picking off index bits of id hash */
int elhashsize; /* size of hash table; power of 2 */
int sdim; /* dimension of ambient space */
int dimension; /* where tension resides */
int representation; /* STRING, SOAPFILM, or SIMPLEX */
int modeltype; /* QUADRATIC, LINEAR, or LAGRANGE; see defines below */
int lagrange_order; /* polynomial order of elements */
int headvnum; /* number of head vertex in edge list */
int maxparam; /* maximum number of parameters in any boundary */
int maxcon; /* number of constraint structures allocated */
int highcon; /* highest constraint number used */
struct constraint *constraints; /* constraint definitions */
conmap_t con_global_map[MAXCONPER]; /* global vertex constraints */
int con_global_count; /* number of global vertex constraints */
REAL tolerance; /* constraint error tolerance */
REAL target_tolerance; /* error tolerance for extensive constraints */
int bdrymax; /* number of boundary structures allocated */
int highbdry; /* highest boundary number used */
struct boundary *boundaries; /* for free boundaries */
int diffusion_flag; /* whether diffusion in effect */
REAL diffusion_const; /* coefficient for diffusion */
REAL simplex_factorial; /* content correction factor for determinant */
int torus_clip_flag;
int torus_body_flag;
int symmetric_content; /* 1 if volumes use symmetric divergence */
int h_inverse_metric_flag; /* for laplacian of curvature */
REAL meritfactor; /* for multiplying figure of merit */
int gravflag; /* whether gravity is on */
REAL grav_const; /* multiplier for gravitational force */
int convex_flag; /* whether any convex boundaries present */
int pressflag; /* whether prescribed pressures present */
int constr_flag; /* set if there are any one-sided constraints */
int hide_flag; /* set for hidden surface removal */
int motion_flag; /* set for fixed scale of motion;
otherwise seek minimum. */
int symmetry_flag; /* whether symmetry group in effect */
int torus_flag; /* whether working in toroidal domain */
int full_flag; /* whether torus solidly packed with bodies */
int pressure_flag; /* whether pressure used dynamically */
int projection_flag; /* whether to project */
int area_norm_flag; /* whether to normalize force by area surrounding vertex */
int norm_check_flag; /* whether area normalization checks normal deviation */
REAL norm_check_max; /* maximum allowable deviation */
int vol_flag; /* whether body volumes up to date */
int jiggle_flag; /* whether to jiggle vertices at each move */
int homothety; /* flag for homothety adjustment each iteration */
int wulff_flag; /* whether we are using wulff shapes for energy */
int wulff_count; /* number of Wulff vectors read in */
char wulff_name[60]; /* Wulff file or keyword */
vertex_id zoom_v; /* vertex to zoom on */
REAL zoom_radius; /* current zoom radius */
REAL total_area;
REAL total_area_addends[MAXADDENDS]; /* for binary tree addition */
REAL total_energy;
REAL total_energy_addends[MAXADDENDS]; /* for binary tree addition */
REAL spring_energy;
int total_facets;
int bodycount; /* number of bodies */
body_id outside_body; /* a body surrounding all others */
REAL scale; /* force to motion scale factor */
REAL scale_scale; /* over-relaxation factor */
REAL maxscale; /* upper limit on scale factor */
REAL pressure; /* ambient pressure */
REAL min_area; /* criterion on weeding out small triangles */
REAL min_length; /* criterion on weeding out small triangles */
REAL max_len; /* criterion for dividing long edges */
REAL max_angle; /* max allowed deviation from parallelism */
REAL temperature; /* "temperature" for jiggling */
REAL spring_constant; /* for forcing edges to conform to boundary */
int gauss1D_order; /* order for gaussian 1D integration */
int gauss2D_order; /* order for gaussian 2D integration */
REAL torusv; /* unit cell volume or area */
REAL **torus_period;
REAL **inverse_periods;/* inverse matrix of torus periods */
REAL **torus_display_period;
REAL display_origin[MAXCOORD];
REAL **inverse_display_periods;/* inverse of torus display periods */
int metric_flag; /* set if background metric in force */
int conformal_flag; /* set for conformal metrics */
struct expnode metric[MAXCOORD][MAXCOORD]; /* metric component functions */
/* Some counters. New scheme: Using word of flag bits for having-been-
reported status and needing-reported status, so exec() doesn't have
to zero these for each call to exec. */
/* Counts that are the result of mass action only are reported
immediately */
int equi_count;
int edge_delete_count;
int facet_delete_count;
int edge_refine_count;
int facet_refine_count;
int vertex_dissolve_count;
int edge_dissolve_count;
int facet_dissolve_count;
int body_dissolve_count;
int edge_reverse_count;
int facet_reverse_count;
int vertex_pop_count;
int edge_pop_count;
int pop_tri_to_edge_count;
int pop_edge_to_tri_count;
int pop_quad_to_quad_count;
int where_count;
int edgeswap_count;
int t1_edgeswap_count;
int fix_count;
int unfix_count;
int notch_count;
/* flag words and bits */
int counts_reported;
int counts_changed;
#define equi_count_bit 0x00000001
#define weed_count_bit 0x00000002
#define edge_delete_count_bit 0x00000004
#define facet_delete_count_bit 0x00000008
#define edge_refine_count_bit 0x00000010
#define facet_refine_count_bit 0x00000020
#define notch_count_bit 0x00000040
#define vertex_dissolve_count_bit 0x00000080
#define edge_dissolve_count_bit 0x00000100
#define facet_dissolve_count_bit 0x00000200
#define body_dissolve_count_bit 0x00000400
#define vertex_pop_count_bit 0x00000800
#define edge_pop_count_bit 0x00001000
#define pop_tri_to_edge_count_bit 0x00004000
#define pop_edge_to_tri_count_bit 0x00008000
#define pop_quad_to_quad_count_bit 0x00010000
#define where_count_bit 0x00020000
#define edgeswap_count_bit 0x00040000
#define fix_count_bit 0x00080000
#define unfix_count_bit 0x00100000
#define t1_edgeswap_count_bit 0x00200000
#define edge_reverse_count_bit 0x00400000
#define facet_reverse_count_bit 0x00800000
/* here follows stuff moved from independent globals to inside web
so as to be easily exported. Previous global names are defined
to web fields elsewhere.
*/
DY_OFFSET dy_gen_quants_w;
int gen_quant_count_w;
int gen_quant_alloc_w;
int global_count;
int maxglobals; /* number allocated */
int perm_global_count;
int max_perm_globals; /* number allocated */
DY_OFFSET dy_meth_inst_w; /* for storing instance structures */
int meth_inst_alloc_w; /* number allocated */
int meth_inst_count_w; /* number defined */
/* global method instances, applying to every element of type */
int global_meth_inst_w[NUMELEMENTS][MAXGLOBINST]; /* lists */
int global_meth_inst_count_w[NUMELEMENTS];
/* flags telling which quantity calculations necessary */
/* flag set for Q_ENERGY,Q_FIXED, or Q_INFO if any element
needs a quantity calculated */
int quant_flags_w[NUMELEMENTS];
DY_OFFSET dy_freestart_w; /* initial block of freelist, 0 if none */
#define dy_freestart web.dy_freestart_w
DY_OFFSET dy_globals_w; /* global variable table */
struct global *dy_perm_globals_w;
DY_OFFSET dy_globalshash_w; /* hash list for global variables */
/* common */
int meth_attr[NUMELEMENTS] ; /* method instances list */
int mpi_export_attr[NUMELEMENTS] ; /* method instances list */
};
extern struct webstruct web;
#ifdef __cplusplus
}
#endif
evolver-2.30c.dfsg/src/softimag.c 0000644 0001753 0001753 00000004721 11410765113 017176 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: softimag.c
*
* Purpose: Triangle list file output for Softimage input.
*/
#include "include.h"
static FILE *fd;
/*****************************************************************
*
* Function: softimage()
*
* Purpose: Write Softimage format files.
*/
void softimage()
{
char file_name[100];
char name[100];
vertex_id v_id;
facet_id f_id;
int *vnumber;
int n;
prompt("Enter file name (no suffix): ",name,sizeof(name));
/* model file */
strcpy(file_name,name);
strcat(file_name,".mdl");
fd = fopen(file_name,"w");
if ( fd == NULL )
{ perror(file_name);
return;
}
fprintf(fd,"SOFTIMAGE 4D Creative Environment v 1.6 \"ASCII\"\n\n\n");
fprintf(fd," MODL \"%s\"\n {\n type PMSH\n",name);
fprintf(fd," nbdef 1\n");
fprintf(fd," scal 1.000000 1.000000 1.000000\n");
fprintf(fd," rot 0.000000 0.000000 0.000000\n");
fprintf(fd," trans 0.000000 0.000000 0.000000\n");
fprintf(fd," }\n");
fclose(fd);
strcpy(file_name,name);
strcat(file_name,".def");
fd = fopen(file_name,"w");
if ( fd == NULL )
{ perror(file_name);
return;
}
fprintf(fd,"SOFTIMAGE 4D Creative Environment v 1.6 \"ASCII\"\n\n");
fprintf(fd,"PMSH \"%s\"\n {\n ",name);
/* vertex list */
vnumber = (int*)temp_calloc(web.skel[VERTEX].max_ord+1,sizeof(int*));
fprintf(fd," vertex %ld\n",web.skel[VERTEX].count);
n = 1;
FOR_ALL_VERTICES(v_id)
{ REAL *x = get_coord(v_id);
fprintf(fd,"%12d %14.12f %14.12f %14.12f\n",n,
(DOUBLE)x[0],(DOUBLE)x[1],(DOUBLE)x[2]);
vnumber[loc_ordinal(v_id)] = n;
n++;
}
/* triangle list */
fprintf(fd,"\n polygon %ld\n",web.skel[FACET].count);
FOR_ALL_FACETS(f_id)
{ facetedge_id fe = get_facet_fe(f_id);
facetedge_id next_fe = get_next_edge(fe);
int oh = vnumber[loc_ordinal(get_fe_headv(fe))];
fprintf(fd," %10d %10d %10d %10d\n",oh,
vnumber[loc_ordinal(get_fe_headv(next_fe))],
vnumber[loc_ordinal(get_fe_tailv(fe))],
vnumber[loc_ordinal(get_fe_tailv(fe))]);
}
fprintf(fd," }\n\n");
fclose(fd);
temp_free((char*)vnumber);
}
evolver-2.30c.dfsg/src/evaltree.c 0000644 0001753 0001753 00000625721 11410765113 017205 0 ustar hazelsct hazelsct /************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
************************************************************/
/*****************************************************************
*
* File: evaltree.c
*
* Purpose: To execute expression and command trees.
* Tree nodes are stored in postorder linear form
* for fast postorder execution.
*
*/
#include "include.h"
#include "ytab.h"
/* for breakpoints */
#define BREAKMAX 100
struct breakinfo { int name_id; int line; } breaklist[BREAKMAX];
int breakcount;
struct eval_frame *subshell_frame[100];
/*****************************************************************
*
* Function eval()
*
* Purpose: runtime evaluation of expressions and commands.
* The big switch statement is split between two functions to
* get functions small enough for DOS compilers. All nodes
* manipulating the stack are in the eval() function, and
* others in other_stuff(). This should not impose any speed
* penalty on expressions.
*
* Notes: The evaluation stack is a local variable, to permit
* parallel evaluations on shared memory machines. To prevent
* eval() from getting too long, many cases have been moved
* to evalmore(), which is called by the default case of eval().
* But for efficiency, most frequently evaluated cases should
* be in eval().
*
* Uses one permanent stack per thread. Recursive calls to eval()
* wind up using same stack (but progressively, of course).
*/
int current_debug_line;
int debugging_flag;
/* Number of stack slots occupied by a frame structure */
#define FRAME_SPACE ((int)((sizeof(struct eval_frame)+sizeof(REAL)-1)/sizeof(REAL)))
REAL eval ARGS4((ex_original,params,self_id,parent_frame),
struct expnode *ex_original, /* expression tree */
REAL *params, /* vector of parameters */
element_id self_id, /* reference element, if any */
struct eval_frame *parent_frame) /* not used anymore */
{
struct treenode *node; /* currently executing node */
struct thread_data *td = GET_THREAD_DATA;
#define newstack (td->eval_stack)
#define stackmax (td->eval_stack_size)
#define stacktop (td->stack_top)
#define this_frame ((struct eval_frame*)(newstack + td->frame_spot))
int entry_flag = BASE_OF_EVAL; /* so can set frame flag marking entry to eval() */
/* variables that act like registers for stack gymnastics */
struct expnode *ex = ex_original;
struct locallist_t *localbase;
int localcount;
element_id q_id = self_id; /* innermost loop element */
REAL return_value;
struct treenode *return_node = NULL;
REAL *localstack; /* base of local stack, after frame structure */
/* miscellaneous local variables useful in executing nodes */
int k,n,i;
REAL x,y;
element_id id;
REAL *bins;
REAL hi;
REAL lo;
REAL val;
int old_flag = iterate_flag;
facet_id f_id;
REAL vect[MAXCOORD];
facetedge_id fe;
vertex_id v_id;
int recalc_flag = 0;
int update_display_flag = 0;
struct boundary *bdry;
REAL *histo_data;
int histo_max;
int histo_count;
struct global *g;
int oldquiet;
int eval_elapsed_time[2];
if ( ex == NULL ) return 0.0;
if ( ex->start == NULL )
{ sprintf(errmsg,"Trying to evaluate null expression for %s.\n",ex->name);
kb_error(1253,errmsg,WARNING);
return 0.0;
}
PROF_EVAL_START(ex);
if ( !breakflag ) iterate_flag = 2; /* for interrupt handler */
if ( ex->start[1].type != SETUP_FRAME_ )
kb_error(3987,"no frame setup\n",RECOVERABLE);
for ( node = ex->start+1 ; ; node++ )
{
if ( single_step_debugging && (node->line_no != current_debug_line) )
{ char prompt_string[100];
current_debug_line = node->line_no;
subshell_depth++;
subshell_frame[subshell_depth] = this_frame;
setjmp(jumpbuf[subshell_depth]);
if ( subshell_depth == 1 )
sprintf(prompt_string,"Debug (\"%s\" line %d): ",ex->name,node->line_no);
else
{ sprintf(prompt_string,"Debug command(%d): ",subshell_depth);
}
/* command read and execute loop */
debugging_flag = 1;
single_step_debugging = 0;
exec_commands(NULL,prompt_string);
subshell_depth--;
debugging_flag = 0;
}
else
/* have reached node set to a breakpoint */
if ( node->flags & BREAKPOINT_NODE )
{ char prompt_string[100];
current_debug_line = node->line_no;
subshell_depth++;
subshell_frame[subshell_depth] = this_frame;
setjmp(jumpbuf[subshell_depth]);
if ( subshell_depth == 1 )
sprintf(prompt_string,"Debug (\"%s\" line %d): ",ex->name,node->line_no);
else
{ sprintf(prompt_string,"Debug command(%d): ",subshell_depth);
}
/* command read and execute loop */
debugging_flag = 1;
exec_commands(NULL,prompt_string);
subshell_depth--;
debugging_flag = 0;
}
switch ( node->type )
{
struct treenode *where,*enode,*eroot;
case SETUP_FRAME_: /* first node of any procedure */
{ int parent_frame_spot;
int stackused = stacktop-newstack;
/* check stack space */
localbase = ex->locals;
if ( ex->locals )
localcount = ex->locals->totalsize;
else localcount = 0;
if ( stackmax < stackused + localcount + ex->stack_max + FRAME_SPACE + 20 )
{
stackmax = stackused + localcount + ex->stack_max + FRAME_SPACE + 300;
newstack = (REAL*)realloc(newstack,stackmax*sizeof(REAL) );
stacktop = newstack + stackused;
newstack[stackmax-1] = STACKMAGIC; /* sentinel */
}
/* find parent frame, if any */
parent_frame_spot = td->frame_spot;
if ( stacktop == newstack )
parent_frame = NULL;
else
parent_frame = (struct eval_frame*)(newstack + parent_frame_spot);
stacktop++;
/* Set up first frame at current stack position */
td->frame_spot = stacktop - newstack; /* sets this_frame by macro */
stacktop += FRAME_SPACE-1;
this_frame->base_ex = ex;
this_frame->basenode = &node;
this_frame->parent_frame_spot = parent_frame_spot;
td->frame_spot = (REAL*)this_frame - newstack; // redundant?
this_frame->self_id = self_id;
this_frame->return_node = return_node;
this_frame->flags = entry_flag;
entry_flag = 0;
if ( parent_frame )
{ this_frame->flags |= parent_frame->flags & IN_ELEMENT_LOOP;
if ( return_node )
this_frame->flags |= return_node->flags & IN_ELEMENT_LOOP;
}
localstack = stacktop + 1;
/* local variables after frame */
if ( localcount )
{ stacktop++;
memset((char*)stacktop,0,localcount*sizeof(REAL));
stacktop += localcount-1; /* room for local variables */
}
}
break; /* end SETUP_FRAME_ */
case ABORT_:
/*
if ( subshell_depth )
{ exit_flag = 1;
break;
}
*/
breakflag = BREAKABORT;
break;
case SUBCOMMAND_:
{ char prompt_string[100];
char *pmpt;
subshell_depth++;
subshell_frame[subshell_depth] = this_frame;
setjmp(jumpbuf[subshell_depth]);
if ( subshell_depth == 1 )
pmpt = "Subcommand: ";
else
{ sprintf(prompt_string,"Subcommand(%d): ",subshell_depth);
pmpt = prompt_string;
}
/* command read and execute loop */
exec_commands(NULL,pmpt);
subshell_depth--;
break;
}
case SET_BREAKPOINT_:
{ int breakline = (int)(*stacktop--);
struct expnode *proc;
struct treenode *nodespot;
int found = 0;
/* now set flag bit in first node on line */
proc = &(globals(node->op1.name_id)->value.proc);
for ( nodespot = proc->start+1 ; nodespot != proc->root ; nodespot++ )
if ( nodespot->line_no == breakline )
{ nodespot->flags |= BREAKPOINT_NODE;
/* record for unset */
breaklist[breakcount].name_id = node->op1.name_id;
breaklist[breakcount].line = breakline;
breakcount++;
found = 1;
break;
}
if ( !found )
{ sprintf(msg,"Cannot find instruction on line %d of \"%s\".\n",
breakline,&globals(node->op1.name_id)->name);
outstring(msg);
}
break;
}
case UNSET_BREAKPOINT_:
{
struct expnode *proc;
struct treenode *nodespot;
if ( node->left ) /* particular */
{
int breakline = (int)(*stacktop--);
/* unmark breakpoint node */
proc = &(globals(node->op1.name_id)->value.proc);
for ( nodespot = proc->start ; nodespot != proc->root ; nodespot++ )
if ( nodespot->line_no == breakline )
nodespot->flags &= ~BREAKPOINT_NODE;
/* remove from breakpoint list */
for ( i = 0 ; i < breakcount ; i++ )
if ( (breaklist[i].name_id == node->op1.name_id) &&
(breaklist[i].line == breakline) )
{ breaklist[i] = breaklist[--breakcount];
}
}
else /* all */
{
for ( i = 0 ; i < breakcount ; i++ )
{ proc = &(globals(breaklist[i].name_id)->value.proc);
for ( nodespot = proc->start ; nodespot != proc->root ; nodespot++ )
nodespot->flags &= ~BREAKPOINT_NODE;
}
breakcount = 0;
}
break;
}
case WHEREAMI_COMMAND_: /* for use in debugging or subshells */
{ struct eval_frame *frame = subshell_frame[subshell_depth];
while ( frame )
{ sprintf(msg," %s:%d\n",frame->base_ex->name,frame->return_node->line_no);
outstring(msg);
if ( frame->flags & BASE_OF_WHOLE_STACK )
frame = NULL;
else
frame = (struct eval_frame*)(newstack + frame->parent_frame_spot);
};
break;
}
case FREE_DISCARDS_:
if ( (node->flags & IN_ELEMENT_LOOP) ||
( this_frame->flags & IN_ELEMENT_LOOP ) )
kb_error(1904,"free_discards called inside element loop. Ignored.",
WARNING);
else
free_discards(DISCARDS_ALL);
break;
case SINGLE_LETTER_:
if ( debugging_flag && node->op1.letter == 'n' ) /* special for debugging prompt */
{ single_step_debugging = 1;
exit_flag = 1;
goto the_exit;
break;
}
if ( !(node->flags & IN_ELEMENT_LOOP) &&
!(this_frame->flags & IN_ELEMENT_LOOP) )
free_discards(DISCARDS_SOME);
letter_command(node->op1.letter);
break;
case LINEAR_:
if ( web.modeltype == QUADRATIC )
{ quad_to_linear(); recalc(); break; }
else if ( web.modeltype == LAGRANGE )
lagrange_to_linear();
break;
case QUADRATIC_:
if ( !(node->flags & IN_ELEMENT_LOOP) &&
!(this_frame->flags & IN_ELEMENT_LOOP) )
free_discards(DISCARDS_SOME);
if ( web.modeltype == LINEAR )
{ linear_to_quad(); recalc(); break; }
else if ( web.modeltype == LAGRANGE )
lagrange_to_quad();
break;
case LAGRANGE_:
if ( !(node->flags & IN_ELEMENT_LOOP) &&
!(this_frame->flags & IN_ELEMENT_LOOP) )
free_discards(DISCARDS_SOME);
if ( web.modeltype == LINEAR )
linear_to_lagrange((int)(*stacktop--));
else if ( web.modeltype == QUADRATIC )
quad_to_lagrange((int)(*stacktop--));
else
lagrange_to_lagrange((int)(*stacktop--));
break;
case ELINDEX_: /* id possibly with mpi task number */
/* creates typeless valid id */
{ int task;
if ( node->right )
task = (int)(*stacktop--);
else task = this_task;
if ( *stacktop == 0 )
id = NULLID;
else
{ if ( *stacktop > 0.0 )
id = ((int)(*stacktop)-1);
else
{ id = -((int)(*stacktop)+1);
invert(id);
}
id |= VALIDMASK;
}
#ifdef MPI_EVOLVER
if ( task < 0 || task >= mpi_nprocs )
{ sprintf(errmsg,
"Illegal task number %d. Must be between 1 and %d.\n",task,mpi_nprocs);
kb_error(4324,errmsg,RECOVERABLE);
}
id |= (element_id)task << TASK_ID_SHIFT;
#endif
*(element_id *)stacktop = id;
break;
}
case PUSH_ELEMENT_ID_:
*(element_id *)(++stacktop) = node->op1.id;
break;
case VALID_ELEMENT_:
id = get_full_id(node->op1.eltype,*(element_id*)stacktop);
*stacktop = valid_element(id) ? 1.0 : 0.0;
break;
case VALID_CONSTRAINT_:
{ int connum = (int)*stacktop;
if ( (connum<0) || (connum>=web.maxcon) || !(get_constraint(connum)->attr & IN_USE))
*stacktop = 0.0;
else
*stacktop = 1.0;
break;
}
case VALID_BOUNDARY_:
{ int bnum = (int)*stacktop;
if ( (bnum<0) || (bnum>=web.bdrymax) || !(web.boundaries[bnum].attr & IN_USE))
*stacktop = 0.0;
else
*stacktop = 1.0;
break;
}
case LOAD_:
if ( subshell_depth )
{ kb_error(3634,"Can't reload in a subcommand.\n",WARNING);
stacktop--;
break;
}
strncpy(loadfilename,*(char**)(stacktop--),sizeof(loadfilename));
#ifdef __cplusplus
loadstub(); /* indirect throw of exception */
#else
longjmp(loadjumpbuf,1);
#endif
break;
case ADDLOAD_:
{ FILE *newfd;
int old_read_depth;
char *name = *(char**)(stacktop--);
newfd = path_open(name,NOTDATAFILENAME);
if (newfd == NULL)
{ if ( name[0] )
{
sprintf(errmsg,"Cannot open datafile %s.\n",name);
kb_error(5432,errmsg,RECOVERABLE);
}
break; /* continue with old */
}
ENTER_GRAPH_MUTEX;
push_commandfd(newfd,name); /* start #include stack */
datafile_flag = 1; /* so parser knows */
addload_flag = 1;
datafile_input_flag = 1; /* so lex input knows */
cmdptr = 0;
old_read_depth = read_depth;
initialize();
if ( read_depth >= old_read_depth )
pop_commandfd();
datafile_flag = 0;
addload_flag = 0;
if ( fabs(view[0][0])+fabs(view[1][1])+fabs(view[2][2]) < 1e-25 )
resize();
LEAVE_GRAPH_MUTEX;
recalc();
break;
}
case PERMLOAD_: /* keep going with same command */
/* with contortions to preserve current list */
{ struct expnode keeplist;
struct eval_frame *fr;
size_t spot;
if ( subshell_depth )
{ kb_error(3635,"Can't reload in a subcommand.\n",WARNING);
stacktop--;
break;
}
/* make sure all parent frames permanent (except very first frame
corresponding to original user command */
for ( fr = this_frame; fr != NULL ;
fr = (struct eval_frame*)(newstack + this_frame->parent_frame_spot) )
{ if ( !(fr->flags & BASE_OF_WHOLE_STACK) && !(fr->base_ex->start->flags & PERMNODE) )
{ strcpy(errmsg, "Calling permload in non-permanent command.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3364,errmsg, RECOVERABLE);
}
if ( fr->flags & BASE_OF_WHOLE_STACK ) break;
}
if ( !(fr->base_ex->start->flags & PERMNODE) )
{ /* have to kludge to preserve current command list */
memset(&keeplist,0,sizeof(keeplist));
perm_tree_copy(&keeplist,fr->base_ex->root);
spot = (*(fr->basenode) - (fr->base_ex->start));
*(fr->basenode) = keeplist.start + spot;
memset(fr->base_ex,0,sizeof(struct expnode)); /* so doesn't do free_expr()later */
fr->base_ex = &keeplist;
}
strncpy(loadfilename,*(char**)(stacktop--),sizeof(loadfilename));
startup(loadfilename);
exec_commands(commandfd,"Enter command: "); /* from end of datafile */
/* keeplist permanently allocated, but we'll live with memory leak
as price for not doing shenanigans every eval() just to avoid leak. */
}
break;
case FUNCTION_CALL_:
{ struct global *g = globals(node->op1.name_id);
if ( g->value.proc.root == NULL )
{ sprintf(errmsg,
"Function \"%s\" definition has not been executed yet.\n",g->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2621,errmsg,RECOVERABLE);
}
PROF_EVAL_END(ex);
ex = &g->value.proc;
PROF_EVAL_START(ex);
return_node = node;
node = g->value.proc.start;
break;
}
case FUNCTION_CALL_RETURN_:
{
stacktop -= node->op2.argcount; /* pop arguments */
*(++stacktop) = return_value;
break;
}
case PROCEDURE_CALL_: /* with arguments */
{ struct global *g = globals(node->op1.name_id);
if ( g->value.proc.root == NULL )
{ sprintf(errmsg,
"Procedure \"%s\" definition has not been executed yet.\n",g->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2622,errmsg,RECOVERABLE);
}
PROF_EVAL_END(ex);
ex = &g->value.proc;
PROF_EVAL_START(ex);
return_node = node;
node = g->value.proc.start;
break;
}
case PROCEDURE_CALL_RETURN_:
stacktop -= node->op2.argcount; /* pop arguments */
break;
case PROCEDURE_:
PROF_EVAL_END(ex);
eval(&globals(node->op1.name_id)->value.proc,NULL,NULLID,NULL);
PROF_EVAL_START(ex);
break;
case PERM_PROCEDURE_:
PROF_EVAL_END(ex);
eval(&perm_globals(node->op1.name_id)->value.proc,NULL,NULLID,NULL);
PROF_EVAL_START(ex);
break;
case CMDLIST_: case COMMAND_BLOCK_:
/* no action, just holds tree together */
break;
case DECLARE_LOCAL_: break;
case LOCAL_LIST_START_: break;
case SINGLE_REDEFD_:
if ( single_redefine[node->op1.letter].start )
{
PROF_EVAL_END(ex);
eval(&single_redefine[node->op1.letter],NULL,NULLID,NULL);
PROF_EVAL_START(ex);
}
else letter_command(node->op1.letter);
break;
case MATRIX_INVERSE_:
{ REAL *datastart2 = *(REAL**)(stacktop--);
REAL *datastart1 = *(REAL**)(stacktop--);
struct array *a = get_name_arrayptr(node->op1.name_id,localstack,localbase);
struct array *b = get_name_arrayptr(node->op2.name_id,localstack,localbase);
*(++stacktop) = (REAL)matrix_inverse_command(a,
b,datastart1,datastart2);
}
break;
case MATRIX_MULTIPLY_:
{ REAL *datastart3 = *(REAL**)(stacktop--);
REAL *datastart2 = *(REAL**)(stacktop--);
REAL *datastart1 = *(REAL**)(stacktop--);
struct array *a = get_name_arrayptr(node->op1.name_id,localstack,localbase);
struct array *b = get_name_arrayptr(node->op2.name_id,localstack,localbase);
struct array *c = get_name_arrayptr(node->op3.name_id,localstack,localbase);
matrix_multiply_command(a,b,c,datastart1,datastart2,datastart3);
}
break;
case MATRIX_DETERMINANT_:
{ REAL *datastart1 = *(REAL**)(stacktop--);
struct array *a = get_name_arrayptr(node->op1.name_id,localstack,localbase);
*(++stacktop) = matrix_determinant_command(a,datastart1);
}
break;
case BACKQUOTE_START_:
{ struct expnode bqnode = *ex;
bqnode.start = node;
bqnode.root = node+node->op1.skipsize;
bqnode.locals = localbase;
PROF_EVAL_END(ex);
eval(&bqnode,params,self_id,this_frame);
PROF_EVAL_START(ex);
node += node->op1.skipsize-1; /* skip what was evaluated */
}
break;
case BACKQUOTE_END_ : break; /* just a placeholder */
case ACOMMANDEXPR_: /* backquoted command at start of expression */
break;
case INDEXSET_: break; /* just accumulate index values */
case DIMENSIONSET_: break; /* just accumulate index values */
case DEFINE_FIXED_LOCAL_ARRAY_: break; /* was allocated on stack */
case SHOW_:
case SHOW_EXPR_:
{ int etype; /* element type */
where = node + node->op1.skipsize;
if ( where->type == WHERE_ ) /* condition */
{ /* copy over expression */
enode = where + where->left; /* NEXT */
eroot = where + where->right;
etype = enode[enode->left].op1.eltype;
show_expr[etype] = show_expr_table + etype;
tree_copy(show_expr[etype],eroot);
sprintf(show_expr[etype]->name,"show expression for %s.",
typenames[etype]);
/* can use first slot to record type of element */
/* element location */
show_expr[etype]->start->op2.eltype = enode->op2.eltype;
enode += enode->left; /* INIT */
show_expr[etype]->start->op1.eltype = enode->op1.eltype;
show_expr[etype]->locals = (struct locallist_t*)mycalloc(1,sizeof(struct locallist_t));
*(show_expr[etype]->locals) = *(ex->locals);
}
else
{ etype = where[where->left].op1.eltype;
tree_copy(show_expr[etype],NULL);
show_expr[etype] = NULL;
}
/* save for dump */
tree_copy(show_command+etype,node+node->op1.skipsize+1);
if ( (node->type == SHOW_) && !OOGL_flag && !go_display_flag)
do_show();
else update_display();
node += node->op1.skipsize; /* skip over expression */
break;
}
case UNREDEFINE_SINGLE_:
free_expr(&single_redefine[node->op1.letter]);
break;
case REDEFINE_SINGLE_:
tree_copy(&single_redefine[node->op1.letter],node+node->op2.jumpsize);
sprintf(single_redefine[node->op1.letter].name,"redefined command '%c'",
node->op1.letter);
single_redefine[node->op1.letter].flag = USERCOPY;
locals_copy(&(single_redefine[node->op1.letter].locals),
node->op5.locals);
node += node->op2.jumpsize; /* skip over procedure */
break;
case SET_PROCEDURE_:
g = globals(node->op1.name_id);
free_expr(&g->value.proc);
tree_copy(&g->value.proc, node+node->op2.jumpsize);
strcpy(g->value.proc.name, g->name);
g->attr.procstuff.proc_timestamp = proc_timestamp++;
locals_copy(&(g->value.proc.locals),node->op5.locals);
node += node->op2.jumpsize; /* skip over procedure */
break;
case SET_PERM_PROCEDURE_:
g = perm_globals(node->op1.name_id);
perm_free_expr(&g->value.proc);
perm_tree_copy(&g->value.proc, node+node->op2.jumpsize);
strcpy(g->value.proc.name, g->name);
g->attr.procstuff.proc_timestamp = proc_timestamp++;
locals_copy_perm(&(g->value.proc.locals),node->op5.locals);
node += node->op2.jumpsize; /* skip over procedure */
break;
case SET_FUNCTION_: break;
case FUNCTION_HEAD_ : break;
case ARGLIST_ : break;
case FUNCTION_DEF_START_ :
g = globals(node->op1.name_id);
free_expr(&g->value.proc);
tree_copy(&g->value.proc, node+node->op2.jumpsize);
g->value.proc.start[2].type = FUNCTION_START_;
strcpy(g->value.proc.name, g->name);
g->attr.procstuff.proc_timestamp = proc_timestamp++;
locals_copy(&(g->value.proc.locals),node->op5.locals);
node += node->op2.jumpsize; /* skip over procedure */
break;
case FUNCTION_PROTO_START_:
node += node->op2.jumpsize; /* skip over stuff */
break;
case FUNCTION_START_: /* function entry code */
/* copy arguments over to local variable space */
memcpy((char*)(stacktop-localcount+1),
(char*)(((REAL*)this_frame)-node->op3.argcount),
node->op3.argcount*sizeof(REAL));
break;
case SET_ARGSPROC_: break;
case PROCEDURE_HEAD_ : break;
case PROCEDURE_DEF_START_ :
g = globals(node->op1.name_id);
free_expr(&g->value.proc);
tree_copy(&g->value.proc, node+node->op2.jumpsize);
g->value.proc.start[2].type = PROCEDURE_START_;
strcpy(g->value.proc.name, g->name);
g->attr.procstuff.proc_timestamp = proc_timestamp++;
locals_copy(&(g->value.proc.locals),node->op5.locals);
node += node->op2.jumpsize; /* skip over procedure */
break;
case PROCEDURE_PROTO_START_:
node += node->op2.jumpsize; /* skip over stuff */
break;
case PROCEDURE_START_: /* function entry code */
/* copy arguments over to local variable space */
if ( node->op3.argcount )
memcpy((char*)(stacktop-localcount+1),
(char*)(((REAL*)this_frame)-node->op3.argcount),
node->op3.argcount*sizeof(REAL));
break;
case RETURN_:
if ( node->left )
{ localstack[localbase->totalsize] = *stacktop;
stacktop = localstack + localbase->totalsize;
}
else
stacktop = localstack + localbase->totalsize - 1;
node = ex->root; /* since next node should be FINISHED */
if ( node[1].type != FINISHED )
kb_error(4578,"Internal error: no FINISH node after RETURN\n", RECOVERABLE);
break;
/********************/
/* repeated command */
/********************/
case REPEAT_INIT_:
/* target on stack, then iteration count */
gocount = (int)*stacktop;
*(++stacktop) = 0; /* iterations done */
if ( gocount <= 0 )
{ stacktop -= 2; /* pop counts */
node += node->op1.skipsize; /* skip loop */
gocount = 1;
}
break;
case REPEAT_:
{ struct treenode *rnode = node + node->left;
stacktop[0] += 1;
gocount = (int)(stacktop[-1] - stacktop[0]);
#if defined(MAC_APP) || defined(MAC_CW)
break_check();
#endif
if ( breakflag )
{ stacktop -= 2; breakflag = 0; break; }
if ( (gocount > 0) && !breakflag )
{ node = rnode; /* do again */
/* loop increment will step over REPEAT_INIT_ node */
}
else
{ stacktop -= 2; /* pop gocount and total count */
gocount = 1; /* so prints as 1 when no count given */
}
}
break;
/*******************/
/* flow of control */
/*******************/
case IFTEST_:
case COND_TEST_:
if ( *(stacktop--) == 0. )
{ /* jump */
node += node->op1.skipsize;
}
break;
case IF_:
case COND_EXPR_:
/* did first command, so skip second */
node += node->op1.skipsize;
break;
case CONTINUE_:
node += node->op1.skipsize; /* back to loop top */
stacktop = localstack + *(size_t*)(localstack+node->stackpos);
node += node->op4.contjump; /* jump to expr */
break;
case BREAK_:
node += node->op1.skipsize; /* back to loop top */
stacktop = localstack + *(size_t*)(localstack+node->stackpos);
node += node->op3.breakjump; /* jump to end */
break;
case WHILE_TOP_:
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack - 1;
/* jumptest if expr false */
if ( (*(stacktop--) == 0.) || breakflag )
node += node->op1.skipsize;
break;
case WHILE_END_:
/* loop back */
node += node->op1.skipsize;
break;
case DO_TOP_:
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack;
break;
case DO_ENTRY_:
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack;
break;
case DO_END_:
/* loop back if true */
if ( *(stacktop--) && !breakflag )
node += node->op1.skipsize;
break;
case FOR_ENTRY_:
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack;
break;
case FOR_HEAD_:
if ( *(stacktop--) && !breakflag )
node += node->op1.skipsize; /* loop body */
else
node += node->op2.jumpsize; /* break out of loop */
break;
case FOR_TOP_:
node += node->op1.skipsize; /* jump to test expr */
break;
case FOR_END_:
node += node->op1.skipsize; /* jump to increment command */
break;
/*******************/
/* aggregate verbs */
/*******************/
case LIST_:
oldquiet = quiet_flag; quiet_flag = 0;
switch ( node->op2.eltype )
{
case VERTEX:
vertex_dump(positive_id(q_id),outfd);
break;
case EDGE:
edge_dump(positive_id(q_id),outfd);
break;
case FACET:
facet_dump(positive_id(q_id),outfd);
break;
case BODY:
body_dump(positive_id(q_id),outfd);
break;
case FACETEDGE:
facetedge_dump(positive_id(q_id),outfd);
break;
default:
sprintf(errmsg,"Bad LIST element type in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
quiet_flag = oldquiet;
kb_error(1255,errmsg,RECOVERABLE);
}
quiet_flag = oldquiet;
node += node->op1.skipsize - 1; /* back to start of loop */
break;
/***********************
* commands with counts *
***********************/
case REFINE_:
switch ( node->op2.eltype )
{
case EDGE:
n = valid_id(edge_refine(q_id));
if ( web.counts_reported & edge_refine_count_bit )
{ web.edge_refine_count = 0;
web.counts_reported &= ~edge_refine_count_bit;
}
if ( n )
{ web.edge_refine_count += n;
web.counts_changed |= edge_refine_count_bit;
recalc_flag = 1;
}
break;
case FACET:
face_triangulate(q_id,FACET_EDGES);
n = 1;
if ( web.counts_reported & facet_refine_count_bit )
{ web.facet_refine_count = 0;
web.counts_reported &= ~facet_refine_count_bit;
}
if ( n )
{ web.facet_refine_count += n;
web.counts_changed |= facet_refine_count_bit;
recalc_flag = 1;
}
break;
default:
sprintf(errmsg,"Bad refine element type in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1256,errmsg, RECOVERABLE);
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case POP_:
n = 0;
if ( id_type(q_id) == EDGE )
{ n = pop_one_edge(q_id);
if ( web.counts_reported & edge_pop_count_bit )
{ web.edge_pop_count = 0;
web.counts_reported &= ~edge_pop_count_bit;
}
if ( n )
{ web.edge_pop_count += n;
web.counts_changed |= edge_pop_count_bit;
}
}
else if ( id_type(q_id) == VERTEX )
{ n = pop_given_vertex(q_id);
if ( web.counts_reported & vertex_pop_count_bit )
{ web.vertex_pop_count = 0;
web.counts_reported &= ~vertex_pop_count_bit;
}
if ( n )
{ web.vertex_pop_count += n;
web.counts_changed |= vertex_pop_count_bit;
}
}
else
{ sprintf(errmsg,"Only vertices and edges poppable.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3356,errmsg, RECOVERABLE);
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case POP_TRI_TO_EDGE_:
n = pop_tri_to_edge(q_id);
if ( web.counts_reported & pop_tri_to_edge_count_bit )
{ web.pop_tri_to_edge_count = 0;
web.counts_reported &= ~pop_tri_to_edge_count_bit;
}
if ( n )
{ web.pop_tri_to_edge_count += n;
web.counts_changed |= pop_tri_to_edge_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case POP_EDGE_TO_TRI_:
n = pop_edge_to_tri(q_id);
if ( web.counts_reported & pop_edge_to_tri_count_bit )
{ web.pop_edge_to_tri_count = 0;
web.counts_reported &= ~pop_edge_to_tri_count_bit;
}
if ( n )
{ web.pop_edge_to_tri_count += n;
web.counts_changed |= pop_edge_to_tri_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case POP_QUAD_TO_QUAD_:
n = pop_quad_to_quad(q_id);
if ( web.counts_reported & pop_quad_to_quad_count_bit )
{ web.pop_quad_to_quad_count = 0;
web.counts_reported &= ~pop_quad_to_quad_count_bit;
}
if ( n )
{ web.pop_quad_to_quad_count += n;
web.counts_changed |= pop_quad_to_quad_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case EDGESWAP_:
n = edgeswap(q_id);
if ( web.counts_reported & edgeswap_count_bit )
{ web.edgeswap_count = 0;
web.counts_reported &= ~edgeswap_count_bit;
}
if ( n )
{ web.edgeswap_count += n;
web.counts_changed |= edgeswap_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case T1_EDGESWAP_:
n = t1_edgeswap(q_id);
if ( web.counts_reported & t1_edgeswap_count_bit )
{ web.t1_edgeswap_count = 0;
web.counts_reported &= ~t1_edgeswap_count_bit;
}
if ( n )
{ web.t1_edgeswap_count += n;
web.counts_changed |= t1_edgeswap_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case EQUIANGULATE_:
n = equiangulate_edge(q_id);
if ( web.counts_reported & equi_count_bit )
{ web.equi_count = 0;
web.counts_reported &= ~equi_count_bit;
}
if ( n )
{ web.equi_count += n;
web.counts_changed |= equi_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
if ( n ) recalc_flag = 1;
break;
case DISSOLVE_:
switch ( node->op2.eltype )
{ case VERTEX:
n = dissolve_vertex(q_id);
if ( web.counts_reported & vertex_dissolve_count_bit )
{ web.vertex_dissolve_count = 0;
web.counts_reported &= ~vertex_dissolve_count_bit;
}
if ( n )
{ web.vertex_dissolve_count += n;
web.counts_changed |= vertex_dissolve_count_bit;
recalc_flag = 1;
}
break;
case EDGE:
n = dissolve_edge(q_id);
if ( web.counts_reported & edge_dissolve_count_bit )
{ web.edge_dissolve_count = 0;
web.counts_reported &= ~edge_dissolve_count_bit;
}
if ( n )
{ web.edge_dissolve_count += n;
web.counts_changed |= edge_dissolve_count_bit;
recalc_flag = 1;
}
break;
case FACET:
n = dissolve_facet(q_id);
if ( web.counts_reported & facet_dissolve_count_bit )
{ web.facet_dissolve_count = 0;
web.counts_reported &= ~facet_dissolve_count_bit;
}
if ( n )
{ web.facet_dissolve_count += n;
web.counts_changed |= facet_dissolve_count_bit;
recalc_flag = 1;
}
break;
case BODY:
n = dissolve_body(q_id);
if ( web.counts_reported & body_dissolve_count_bit )
{ web.body_dissolve_count = 0;
web.counts_reported &= ~body_dissolve_count_bit;
}
if ( n )
{ web.body_dissolve_count += n;
web.counts_changed |= body_dissolve_count_bit;
recalc_flag = 1;
}
break;
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case REVERSE_ORIENTATION_:
switch ( node->op2.eltype )
{
case EDGE:
reverse_orientation_edge(q_id);
if ( web.counts_reported & edge_reverse_count_bit )
{ web.edge_reverse_count = 0;
web.counts_reported &= ~edge_reverse_count_bit;
}
web.edge_reverse_count += 1;
web.counts_changed |= edge_reverse_count_bit;
recalc_flag = 1;
break;
case FACET:
reverse_orientation_facet(q_id);
if ( web.counts_reported & facet_reverse_count_bit )
{ web.facet_reverse_count = 0;
web.counts_reported &= ~facet_reverse_count_bit;
}
web.facet_reverse_count += 1;
web.counts_changed |= facet_reverse_count_bit;
recalc_flag = 1;
break;
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case FIX_:
if ( web.counts_reported & fix_count_bit )
{ web.fix_count = 0;
web.counts_reported &= ~fix_count_bit;
}
if ( !(get_attr(q_id)&FIXED) )
{ set_attr(q_id,FIXED);
web.fix_count += 1;
web.counts_changed |= fix_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNFIX_:
if ( web.counts_reported & unfix_count_bit )
{ web.unfix_count = 0;
web.counts_reported &= ~unfix_count_bit;
}
if ( get_attr(q_id) & FIXED )
{ unset_attr(q_id,FIXED);
web.unfix_count += 1;
web.counts_changed |= unfix_count_bit;
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case VERTEX_AVERAGE_:
if ( new_vertex_average(q_id,VOLKEEP) ) recalc_flag = 1;
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case RAW_VERTEX_AVERAGE_:
if ( new_vertex_average(q_id,NOVOLKEEP) ) recalc_flag = 1;
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case RAWEST_VERTEX_AVERAGE_:
if ( new_vertex_average(q_id,RAWEST) ) recalc_flag = 1;
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case DELETE_:
switch ( node->op2.eltype )
{
case EDGE:
n = eliminate_edge(q_id);
if ( n ) free_element(q_id);
if ( web.counts_reported & edge_delete_count_bit )
{ web.edge_delete_count = 0;
web.counts_reported &= ~edge_delete_count_bit;
}
if ( n )
{ web.edge_delete_count += n;
web.counts_changed |= edge_delete_count_bit;
recalc_flag = 1;
}
break;
case FACET:
n = eliminate_facet(q_id);
if ( web.counts_reported & facet_delete_count_bit )
{ web.facet_delete_count = 0;
web.counts_reported &= ~facet_delete_count_bit;
}
if ( n > 0 )
{ web.facet_delete_count += n;
web.counts_changed |= facet_delete_count_bit;
recalc_flag = 1;
}
if ( n < 0 ) /* from string_eliminate_edge, partial elim */
{ web.edge_delete_count += -n;
web.counts_reported &= ~edge_delete_count_bit;
recalc_flag = 1;
}
break;
default:
sprintf(errmsg,"Bad delete element type in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1257,errmsg, RECOVERABLE);
}
node += node->op1.skipsize - 1; /* back to start of loop */
break;
/***************/
/* expressions */
/***************/
case REPLACECONST:
*stacktop = node->op1.real;
break;
case PUSHCONST:
*++stacktop = node->op1.real;
break;
case PUSHDELTA_:
{ struct global *g = globals(node->op1.name_id);
*++stacktop = g->attr.varstuff.delta;
break;
}
case PUSH_PARAM_SCALE:
{ struct global *g = globals(node->op1.name_id);
*++stacktop = g->attr.varstuff.pscale;
break;
}
case PUSH_PARAM_FIXED:
{ struct global *g = globals(node->op1.name_id);
*++stacktop = (g->flags & OPTIMIZING_PARAMETER)?0.0:1.0;
break;
}
case PUSH_PARAM_EXTRA_:
{ int i;
for ( i = 0 ; i < optparamcount ; i++ )
if ( optparam[i].pnum == node->op1.name_id )
{ switch ( node->op2.extranum )
{ case V_VELOCITY_ATTR:
*++stacktop = optparam[i].velocity;
break;
case V_FORCE_ATTR:
*++stacktop = optparam[i].grad;
break;
}
break;
}
if ( i == optparamcount ) *++stacktop = 0.0;
break;
}
case PUSHGLOBAL_:
case STRINGGLOBAL_:
case PUSH_PERM_GLOBAL_:
case PERM_STRINGGLOBAL_:
{ struct global *g = globals(node->op1.name_id);
if ( g->flags & GLOB_LOCALVAR )
*++stacktop = localstack[g->value.offset];
else if ( g->flags & FILE_VALUES )
*++stacktop = g->value.file.values[int_val];
else if ( g->flags & STRINGVAL )
{ int pp = (sizeof(REAL)+sizeof(char*)-1)/sizeof(char*);
int nn;
stacktop++;
for ( nn = 0 ; nn < pp ; nn++ )
((char **)stacktop)[nn] = g->value.string;
}
else if ( g->flags & INTERNAL_NAME )
{ if ( g->flags & INTVAL )
*++stacktop = *(int*)(g->value.dataptr);
else if ( g->flags & REALVAL )
*++stacktop = *(REAL*)(g->value.dataptr);
else
{ sprintf(errmsg,
"Internal error: Internal variable %s type not set.\n",g->name);
kb_error(2851,errmsg,RECOVERABLE);
}
}
else
*++stacktop = g->value.real;
}
break;
case PUSHPI:
*++stacktop = M_PI;
break;
case PUSHE:
*++stacktop = M_E;
break;
case PUSHG:
*++stacktop = web.gravflag ? web.grav_const : 0.0;
break;
case PUSHPARAM:
*++stacktop = params[node->op1.coordnum];
break;
case USERFUNC:
*++stacktop = (*userfunc[node->op1.userfunc])(params);
break;
case DYNAMIC_LOAD_FUNC_:
if ( ! params )
{ sprintf(errmsg,
"Must use dynamic load function %s in context with parameters.\n",
globals(node->op2.name_id)->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2059,errmsg,RECOVERABLE);
} else
(*node->op1.funcptr)(FUNC_VALUE,params,(struct dstack*)(++stacktop));
break;
case GT_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] > stacktop[1]);
break;
case LT_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] < stacktop[1]);
break;
case LE_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] <= stacktop[1]);
break;
case GE_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] >= stacktop[1]);
break;
case NE_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] != stacktop[1]);
break;
case EQ_:
stacktop--;
stacktop[0] = (REAL)(stacktop[0] == stacktop[1]);
break;
case AND_: /* short-circuit */
if ( *stacktop == 0.0 )
{ *(++stacktop) = 0.0;
node += node->op1.skipsize; /* leave 0 as result */
}
break;
case CONJUNCTION_END:
/* short-circuiting results in second arg being answer */
/* get proper 1 for true */
stacktop--;
*stacktop = stacktop[1];
if ( *stacktop ) *stacktop = 1.0;
break;
case OR_: /* short-circuit */
if ( *stacktop != 0.0 )
{ *(++stacktop) = 1.0;
node += node->op1.skipsize; /* leave as result */
}
break;
case NOT_:
stacktop[0] = (REAL)(!stacktop[0]);
break;
case PLUS:
stacktop--;
stacktop[0] += stacktop[1];
break;
case MINUS:
case EQUATE:
stacktop--;
stacktop[0] -= stacktop[1];
break;
case TIMES:
stacktop--;
stacktop[0] *= stacktop[1];
break;
case DIVIDE:
stacktop--;
if ( stacktop[1] == 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Division by zero in %s, %s %s.\n",ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Division by zero in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1258,errmsg,RECOVERABLE);
}
stacktop[0] /= stacktop[1];
break;
case REALMOD:
stacktop--;
if ( stacktop[1] == 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Modulus base zero in %s, %s %s.\n",ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Modulus base zero in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1259,errmsg,RECOVERABLE);
}
stacktop[0] = stacktop[0] - floor(stacktop[0]/stacktop[1])
*stacktop[1];
break;
case IMOD_:
stacktop--;
if ( stacktop[1] == 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Modulus base zero in %s, %s %s.\n",ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Modulus base zero in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1260,errmsg,RECOVERABLE);
}
stacktop[0] = floor(stacktop[0]) -
floor(floor(stacktop[0])/floor(stacktop[1]))
*floor(stacktop[1]);
break;
case IDIV_:
stacktop--;
if ( (int)stacktop[1] == 0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Division by zero in %s, %s %s.\n",ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Division by zero in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1261,errmsg,RECOVERABLE);
}
stacktop[0] = (REAL)((int)(stacktop[0])/(int)(stacktop[1]));
break;
case INTPOW:
/* cases n = 0,1,2 taken care of in parsing */
x = *stacktop;
k = node->op1.intpow < 0 ? -node->op1.intpow : node->op1.intpow;
for ( n = 1 ; n < k ; n++ )
*stacktop *= x;
if ( node->op1.intpow < 0 )
{ if ( *stacktop == 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Negative power (%d) of zero in %s, %s %s.\n",
node->op1.intpow,ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Negative power (%d) of zero in %s.\n",
node->op1.intpow,ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1262,errmsg,RECOVERABLE);
}
else
*stacktop = 1/(*stacktop);
}
break;
case POW:
stacktop--;
if ( (stacktop[0] < 0.0) && (floor(stacktop[1]) != stacktop[1]) )
{ if ( valid_id(self_id) )
sprintf(errmsg,
"Non-integer power of a negative number in %s, %s %s.\n",
ex->name, typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Non-integer power of a negative number in %s.\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2060,errmsg,RECOVERABLE);
}
if ( stacktop[0] == 0.0 )
{ if ( stacktop[1] >= 0.0 ) *stacktop = 0.0;
else *stacktop = 1e30;
}
else *stacktop = pow(stacktop[0],stacktop[1]);
/* Note: pow recognizes integer powers, so OK for neg x */
break;
case MAXIMUM_:
stacktop--;
*stacktop = (stacktop[0] > stacktop[1]) ? stacktop[0] : stacktop[1];
break;
case MINIMUM_:
stacktop--;
*stacktop = (stacktop[0] < stacktop[1]) ? stacktop[0] : stacktop[1];
break;
case WRAP_COMPOSE_:
stacktop--;
if ( sym_compose )
*stacktop = (REAL)(*sym_compose)((unsigned int)stacktop[0],(unsigned int)stacktop[1]);
break;
case WRAP_INVERSE_:
if ( sym_compose )
*stacktop = (REAL)(*sym_inverse)((unsigned int)stacktop[0]);
break;
case ATAN2_:
stacktop--;
*stacktop = atan2(stacktop[0],stacktop[1]);
break;
case SQR:
*stacktop *= *stacktop;
break;
case SQRT:
if ( *stacktop < 0.0 )
{ if ( *stacktop > -100*machine_eps ) *stacktop = 0.0;
else
{ if ( valid_id(self_id) )
sprintf(errmsg,"Square root of negative number in %s, %s %s.\n",
ex->name,typenames[id_type(self_id)],ELNAME(self_id));
else
sprintf(errmsg,"Square root of negative number in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1263,errmsg,RECOVERABLE);
}
}
else *stacktop = sqrt(*stacktop);
break;
case CEIL_:
*stacktop = ceil(*stacktop);
break;
case FLOOR_:
*stacktop = floor(*stacktop);
break;
case ABS:
*stacktop = fabs(*stacktop);
break;
case SIN:
*stacktop = sin(*stacktop);
break;
case COS:
*stacktop = cos(*stacktop);
break;
case TAN:
*stacktop = tan(*stacktop);
break;
case EXP:
*stacktop = exp(*stacktop);
break;
case SINH:
*stacktop = (exp(*stacktop)-exp(-*stacktop))/2;
break;
case COSH:
*stacktop = (exp(*stacktop)+exp(-*stacktop))/2;
break;
case TANH:
y = exp(*stacktop);
*stacktop = (y*y-1)/(y*y+1) ;
break;
case ASINH:
*stacktop = log(*stacktop + sqrt(*stacktop*(*stacktop) + 1));
break;
case ACOSH:
if ( *stacktop < 1.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Acosh argument less than 1 in %s, %s %s.\n",
ex->name,typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Acosh argument less than 1 in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2557,errmsg,RECOVERABLE);
}
*stacktop = 2*log(sqrt(*stacktop+1) + sqrt(*stacktop - 1)) - log(2.0);
break;
case ATANH:
if ( fabs(*stacktop) >= 1.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,
"Atanh argument magnitude not less than 1 in %s, %s %s.\n",
ex->name,typenames[id_type(self_id)],ELNAME(self_id));
else
sprintf(errmsg,"Atanh argument magnitude not less than 1 in %s.\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2559,errmsg, RECOVERABLE);
}
*stacktop = log(*stacktop+1)/2 - log(1-*stacktop)/2;
break;
case LOG:
if ( *stacktop <= 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Log of zero or negative number in %s, %s %s.\n",
ex->name,typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Log of zero or negative number in %s.\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1264,errmsg, RECOVERABLE );
}
*stacktop = log(*stacktop);
break;
case ASIN:
if ( *stacktop > 1.0 ) *stacktop = asin(1.0);
else if ( *stacktop < -1.0 ) *stacktop = asin(-1.0);
else *stacktop = asin(*stacktop);
break;
case ACOS:
if ( *stacktop > 1.0 ) *stacktop = 0.0;
else if ( *stacktop < -1.0 ) *stacktop = M_PI;
else *stacktop = acos(*stacktop);
break;
case ATAN:
*stacktop = atan(*stacktop);
break;
case ELLIPTICK:
*stacktop = ellipticK(*stacktop);
break;
case ELLIPTICE:
*stacktop = ellipticE(*stacktop);
break;
case INCOMPLETE_ELLIPTICF:
stacktop--;
*stacktop = incompleteEllipticF(stacktop[0],stacktop[1]);
break;
case INCOMPLETE_ELLIPTICE:
stacktop--;
*stacktop = incompleteEllipticE(stacktop[0],stacktop[1]);
break;
case CHS:
*stacktop = -*stacktop;
break;
case INV:
if ( *stacktop == 0.0 )
{ if ( valid_id(self_id) )
sprintf(errmsg,"Division by zero in %s, %s %s.\n",ex->name,
typenames[id_type(self_id)],ELNAME(self_id));
else sprintf(errmsg,"Division by zero in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2560,errmsg,RECOVERABLE);
}
*stacktop = 1/(*stacktop);
break;
/* here are attributes for queries */
case COORD_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case VERTEX:
*++stacktop = get_coord(id)[node->op2.coordnum];
break;
case EDGE:
get_edge_side(id,vect);
*++stacktop = vect[node->op2.coordnum];
break;
case FACET:
get_facet_normal(id,vect);
*++stacktop = vect[node->op2.coordnum];
break;
}
break;
case INDEXED_COORD_:
{ int k = (int)*stacktop - 1; /* 1 based indexing */
if ( k < 0 || k >= SDIM )
{ sprintf(errmsg,
"Invalid index %d for x in %s; must be between 1 and %d, inclusive.\n",
k+1,ex->name,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2061,errmsg,RECOVERABLE );
}
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch( id_type(id) )
{ case VERTEX:
*stacktop = get_coord(id)[k];
break;
case EDGE:
get_edge_side(id,vect);
*stacktop = vect[k];
break;
case FACET:
get_facet_normal(id,vect);
*stacktop = vect[k];
break;
default:
sprintf(errmsg,"Can't have indexed x on %s, in %s.\n",
typenames[id_type(id)], ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2062,errmsg,RECOVERABLE);
}
}
break;
case PRINT_VERTEXNORMAL_:
{ MAT2D(normal,MAXCOORD,MAXCOORD);
REAL mag;
int i;
int normcount;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
normcount = new_calc_vertex_normal(id,normal);
project_vertex_normals(id,normal,normcount);
mag = sqrt(SDIM_dot(normal[0],normal[0]));
if ( mag == 0.0 )
{ mag = 1; memset(normal[0],0,SDIM*sizeof(REAL));}
sprintf(msg,"{");
for ( i = 0 ; i < SDIM ; i++ )
{ if ( i > 0 ) strcat(msg,",");
#ifdef LONGDOUBLE
sprintf(msg+strlen(msg),"%#*.*L",DWIDTH,DPREC,normal[0][i]/mag);
#else
sprintf(msg+strlen(msg),"%17.15g",normal[0][i]/mag);
#endif
}
strcat(msg,"}\n");
outstring(msg);
break;
}
case GET_VERTEXNORMAL_:
{ MAT2D(normal,MAXCOORD,MAXCOORD);
int k = (int)*stacktop - 1; /* 1 based indexing */
REAL mag;
int normcount;
if ( k < 0 || k >= SDIM )
{ sprintf(errmsg,
"Invalid index %d for vertexnormal in %s; must be between 1 and %d.\n",
k+1,ex->name,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2063,errmsg,RECOVERABLE );
}
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
normcount = new_calc_vertex_normal(id,normal);
project_vertex_normals(id,normal,normcount);
mag = sqrt(SDIM_dot(normal[0],normal[0]));
*stacktop = mag == 0.0 ? 0.0 : normal[0][k]/mag;
}
break;
case PARAM_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_param(id)[node->op2.coordnum];
break;
case GET_SQ_MEAN_CURV_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = vertex_sq_mean_curvature(id);
break;
case GET_FIXEDVOL_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_battr(id)&FIXEDVOL ? 1.0 : 0.0;
break;
case GET_MEANCURV_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = vertex_mean_curvature(id);
break;
case GET_LENGTH_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( web.representation != STRING ) calc_edge(id);
*++stacktop = get_edge_length(id);
break;
case GET_DIHEDRAL_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( id_type(id) == EDGE ) *++stacktop = dihedral(id);
else if ( id_type(id) == VERTEX ) *++stacktop = vertex_angle(id);
else *++stacktop = 0.0;
break;
case GET_ORIENTATION_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & NEGBOUNDARY) ? -1.0 : 1.0;
break;
case VALENCE_:
case GET_VALENCE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case VERTEX:
if ( web.representation == SIMPLEX )
*++stacktop = (REAL)get_vertex_fvalence(id);
else
*++stacktop = (REAL)get_vertex_evalence(id);
break;
case EDGE:
*++stacktop = (REAL)get_edge_valence(id);
break;
case FACET:
*++stacktop = (REAL)get_facet_valence(id);
break;
case BODY:
*++stacktop = (REAL)get_body_valence(id);
break;
}
break;
case GET_EDGE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (REAL)(ordinal(get_fe_edge(id))+1);
break;
case GET_FACET_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (REAL)(ordinal(get_fe_facet(id))+1);
break;
case AREA_:
case GET_AREA_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_facet_area(id);
break;
case GET_MID_EDGE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_vattr(id) & (Q_MIDEDGE|Q_MIDPOINT) ? 1.0 : 0.0;
break;
case GET_MID_FACET_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_vattr(id) & Q_MIDFACET ? 1.0 : 0.0;
break;
case GET_WRAP_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = web.symmetry_flag ? (REAL)get_edge_wrap(id) : 0;
break;
case GET_PRESSURE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{
case BODY: *++stacktop = get_body_pressure(id); break;
default:
sprintf(errmsg,"Pressure only for bodies, in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1267,errmsg,RECOVERABLE);
}
break;
case GET_USERATTR_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = user_attribute(id);
break;
case GET_QUANTITY_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( !valid_id(id) )
{ sprintf(errmsg,
"Quantity name '%s' needs attribute like .value (in %s)\n",
GEN_QUANT(node->op2.quant_id)->name,ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2064,errmsg, RECOVERABLE);
}
*++stacktop = quantity_attribute(id,node->op2.quant_id);
break;
case GET_INSTANCE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( !valid_id(id) )
{ sprintf(errmsg,
"Instance name '%s' needs attribute like .value (in %s)\n",
METH_INSTANCE(node->op2.meth_id)->name,ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2065,errmsg, RECOVERABLE);
}
*++stacktop = instance_attribute(id,node->op2.meth_id);
break;
case GET_PHASE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{
case FACET: *++stacktop = (REAL)get_f_phase(id); break;
case BODY: *++stacktop = (REAL)get_b_phase(id); break;
default:
sprintf(errmsg,"Phase of wrong type element in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1268,errmsg,RECOVERABLE);
}
break;
case DENSITY_:
case GET_DENSITY_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case EDGE: *++stacktop = get_edge_density(id); break;
case FACET: *++stacktop = get_facet_density(id); break;
case BODY: *++stacktop = get_body_density(id); break;
default:
sprintf(errmsg,"Density of wrong type element in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1269,errmsg,RECOVERABLE);
}
break;
case GET_STAR_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case VERTEX: *++stacktop = get_vertex_star(id); break;
case EDGE: *++stacktop = get_edge_star(id); break;
default: *++stacktop = 0.0; break;
}
break;
case VOLUME_:
case GET_VOLUME_:
{ int attr;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
attr = get_battr(id);
if ( attr & FIXEDVOL )
{ if (fixed_volume_timestamp < global_timestamp)
calc_content(Q_FIXED);
}
else
if ( (info_volume_timestamp < global_timestamp) )
calc_content(Q_INFO|Q_ENERGY);
*++stacktop = get_body_volume(id);
break;
}
case GET_VOLCONST_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_body_volconst(id);
break;
case GET_TARGET_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = get_body_fixvol(id);
break;
case ID_:
case GET_ID_:
case GET_OID_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( (node->type == GET_OID_) && inverted(id) )
*++stacktop = -(REAL)(ordinal(id)+1);
else *++stacktop = (REAL)(ordinal(id)+1);
break;
case ORIGINAL_:
case GET_ORIGINAL_: /* as user's element id number */
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = valid_id(id) ? (REAL)ordinal(get_original(id))+1 : 0;
break;
case GET_MPI_TASK_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = id_task(id);
break;
case GET_COLOR_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case EDGE: *++stacktop = (REAL)get_edge_color(id); break;
case FACET: *++stacktop = (REAL)get_facet_color(id); break;
default: *++stacktop = 0.0;
}
break;
case GET_FRONTCOLOR_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case FACET: *++stacktop = (REAL)get_facet_frontcolor(id); break;
default: *++stacktop = 0.0;
}
break;
case GET_BACKCOLOR_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case FACET: *++stacktop = (REAL)get_facet_backcolor(id); break;
default: *++stacktop = 0.0;
}
break;
case GET_FRONTBODY_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case EDGE:
fe = get_edge_fe(id);
if ( !valid_id(fe) ) {*++stacktop = 0.0; break;}
f_id = get_fe_facet(fe);
if ( inverted(f_id) ) f_id = get_fe_facet(get_next_facet(fe));
if ( inverted(f_id) ) { *++stacktop = 0.0; break;}
*++stacktop = (REAL)ordinal(get_facet_body(f_id))+1;
break;
case FACET:
*++stacktop = (REAL)ordinal(get_facet_body(id))+1;
break;
default: *++stacktop = 0.0;
}
break;
case GET_BACKBODY_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( id_type(id) )
{ case FACET: *++stacktop =
(REAL)ordinal(get_facet_body(inverse_id(id)))+1;
break;
case EDGE:
fe = get_edge_fe(id);
if ( !valid_id(fe) ) {*++stacktop = 0.0; break;}
f_id = get_fe_facet(fe);
if ( !inverted(f_id) ) f_id = get_fe_facet(get_next_facet(fe));
if ( !inverted(f_id) ) { *++stacktop = 0.0; break;}
*++stacktop = (REAL)ordinal(get_facet_body(inverse_id(f_id)))+1;
break;
default: *++stacktop = 0.0;
}
break;
case TAG_:
case GET_TAG_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (REAL)get_tag(id);
break;
case GET_BARE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & BARE_NAKED) ? 1.0 : 0.0;
break;
case GET_MIDV_:
if ( web.modeltype != QUADRATIC )
{ sprintf(errmsg,"Cannot do MIDV except in QUADRATIC model (in %s).\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2066,errmsg,RECOVERABLE);
}
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = ordinal(get_edge_midv(id)) + 1.0;
break;
case FIXED_:
case GET_FIXED_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( id_type(id) == BODY )
*++stacktop = get_battr(id)&FIXEDVOL ? 1.0 : 0.0;
else *++stacktop = (get_attr(id) & FIXED) ? 1.0 : 0.0;
break;
case GET_NO_DISPLAY_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & NODISPLAY) ? 1.0 : 0.0;
break;
case GET_NONCONTENT_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & NONCONTENT) ? 1.0 : 0.0;
break;
case GET_HIT_PARTNER_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & HIT_PARTNER) ? 1.0 : 0.0;
break;
case GET_NO_REFINE_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & NO_REFINE) ? 1.0 : 0.0;
break;
case GET_TRIPLE_PT_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & TRIPLE_PT) ? 1.0 : 0.0;
break;
case GET_TETRA_PT_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & TETRA_PT) ? 1.0 : 0.0;
break;
case GET_AXIAL_POINT_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*++stacktop = (get_attr(id) & AXIAL_POINT) ? 1.0 : 0.0;
break;
case GET_SHOW_:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
if ( id_type(id) == EDGE )
{ int eattr = get_eattr(id);
int showflag = 0;
facetedge_id fe_id = get_edge_fe(id);
if ( eattr & BOUNDARY ) showflag = 1;
if ( equal_id(get_next_facet(fe_id),fe_id) ) /* valence 1 */
showflag = 1;
else if ( !equal_id(get_next_facet(fe_id),get_prev_facet(fe_id)) )
showflag = 1;
if ( eattr & HIT_WALL ) showflag = 1;
if ( eattr & FIXED ) showflag = 1;
if ( show_expr[EDGE] && show_expr[EDGE]->start )
{
PROF_EVAL_END(ex);
showflag = eval(show_expr[EDGE],NULL,id,NULL) ? 1 : 0;
PROF_EVAL_START(ex);
}
if ( get_edge_color(id) == CLEAR ) showflag = 0;
*++stacktop = showflag;
}
else if ( id_type(id) == FACET )
{ int fattr = get_fattr(id);
int showflag = 1;
if ( (fattr & (BOUNDARY|CONSTRAINT)) && !bdry_showflag )
showflag = 0;
if ( fattr & NODISPLAY )
showflag = 0;
if ( no_wall_flag )
{ /* skip facets with all three vertices on walls */
fe = get_facet_fe(id);
if ( get_vattr(get_fe_headv(fe)) & (HIT_WALL|CONSTRAINT) )
if ( get_vattr(get_fe_tailv(fe)) & (HIT_WALL|CONSTRAINT) )
{ fe = get_next_edge(fe);
if ( get_vattr(get_fe_headv(fe)) & (HIT_WALL|CONSTRAINT) )
showflag = 0;
}
}
if ( show_expr[FACET] && show_expr[FACET]->start )
{
PROF_EVAL_END(ex);
if ( !eval(show_expr[FACET],NULL,id,NULL) )
showflag = 0;
PROF_EVAL_START(ex);
}
*++stacktop = showflag;
}
else
{ sprintf(errmsg,
"\"show\" attribute applied to wrong type of element in %s.\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2067,errmsg,RECOVERABLE);
}
break;
case ATTR_FUNCTION_:
node += node->op1.skipsize - 1;
break;
case ATTR_FUNCTION_END_:
{ struct extra *ext = EXTRAS(node->op2.eltype) + node->op1.extranum;
ext->flags |= FUNCTION_ATTR;
tree_copy(&ext->code,node + node->right);
break;
}
case GET_EXTRA_ATTR_:
{ struct extra *ext;
int spot;
n = node->op3.extranum; /* attribute number */
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
ext = EXTRAS(node->op2.eltype) + n;
/* get index */
spot = 0;
for ( k = 0 ; k < ext->array_spec.dim ; k++ )
{ int j = (int)(stacktop[-ext->array_spec.dim+k+1]);
spot *= ext->array_spec.sizes[k];
if ( (j < 1) || (j > ext->array_spec.sizes[k]) )
{ sprintf(errmsg,
"Attribute %s index %d is %d; maximum is %d (in %s).\n",
ext->name,k+1,j,ext->array_spec.sizes[k],ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1270,errmsg,RECOVERABLE);
}
spot += (int)(stacktop[-ext->array_spec.dim+k+1]) - 1;
}
stacktop -= ext->array_spec.dim;
if ( id_type(id) != node->op2.eltype )
{ if ( (id_type(id)==EDGE) && (node->op2.eltype==VERTEX) && params )
{ ext = EXTRAS(VERTEX) + n;
*++stacktop = interp_edge_attribute(id,ext,spot,(int)params[2*SDIM]);
break;
}
else
if ( (id_type(id)==FACET) && (node->op2.eltype==VERTEX) && params )
{ ext = EXTRAS(VERTEX) + n;
*++stacktop = interp_facet_attribute(id,ext,spot,(int)params[2*SDIM]);
break;
}
else
{ sprintf(errmsg,
"Attribute %s is %s attribute, not %s attribute (in %s).\n",
EXTRAS(node->op2.eltype)[n].name,
typenames[node->op2.eltype], typenames[id_type(id)],ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2068,errmsg,RECOVERABLE);
}
}
if ( ext->code.start )
{ int oldflag = autorecalc_flag;
autorecalc_flag = 0;
PROF_EVAL_END(ex);
eval(&ext->code,NULL,id,NULL); /* side-effect fills in values */
PROF_EVAL_START(ex);
autorecalc_flag = oldflag;
}
switch ( ext->type )
{ case REAL_TYPE: *++stacktop = ((REAL*)get_extra(id,n))[spot];
break;
case INTEGER_TYPE:
case CONSTRAINT_TYPE:
case BOUNDARY_TYPE:
case QUANTITY_TYPE:
case INSTANCE_TYPE:
case PROCEDURE_TYPE:
*++stacktop = (REAL)((int*)get_extra(id,n))[spot];
break;
case UINT_TYPE:
*++stacktop = (REAL)((unsigned int*)get_extra(id,n))[spot];
break;
case ULONG_TYPE:
*++stacktop = (REAL)((unsigned long*)get_extra(id,n))[spot];
break;
case LONG_TYPE:
*++stacktop = (REAL)((long*)get_extra(id,n))[spot];
break;
case UCHAR_TYPE:
*++stacktop = (REAL)((unsigned char*)get_extra(id,n))[spot];
break;
case CHAR_TYPE:
*++stacktop = (REAL)((char*)get_extra(id,n))[spot];
break;
case SHORT_TYPE:
*++stacktop = (REAL)((short int*)get_extra(id,n))[spot];
break;
case USHORT_TYPE:
*++stacktop = (REAL)((unsigned short int*)get_extra(id,n))[spot];
break;
case ELEMENTID_TYPE:
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
*(element_id*)(++stacktop) =
((element_id*)get_extra(id,n))[spot];
break;
case PTR_TYPE:
*((char**)++stacktop) = (((char**)get_extra(id,n))[spot]);
break;
}
}
break;
case ON_CONSTRAINT_:
case ON_CONSTRAINT_NAME:
{ int testcon = (node->type == ON_CONSTRAINT_) ? (int)*(stacktop--)
: node->op3.connum;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch(id_type(id))
{ case VERTEX: *++stacktop = (REAL)v_on_constraint(id,testcon); break;
case EDGE : *++stacktop = (REAL)e_on_constraint(id,testcon); break;
case FACET : *++stacktop = (REAL)f_on_constraint(id,testcon); break;
default:
sprintf(errmsg,
"Can't do constraints on this type element (in %s).\n",
ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1272,errmsg,RECOVERABLE);
}
}
break;
case HIT_CONSTRAINT_:
case HIT_CONSTRAINT_NAME:
{ int testcon = (node->type == HIT_CONSTRAINT_) ? (int)*(stacktop--)
: node->op3.connum;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch(id_type(id))
{ case VERTEX: *++stacktop = (REAL)get_v_constraint_status(id,testcon);
break;
default:
sprintf(errmsg,
"Can do hit_constraints only on vertices (in %s).\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1273,errmsg,RECOVERABLE);
}
}
break;
case ON_BOUNDARY_:
case ON_BOUNDARY_NAME:
{ struct boundary *b=NULL;
int testb = (node->type == ON_BOUNDARY_) ? (int)*(stacktop--)
: node->op3.bdrynum;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch(id_type(id))
{ case VERTEX: b = get_boundary(id); break;
case EDGE : b = get_edge_boundary(id); break;
case FACET : b = get_facet_boundary(id); break;
default:
sprintf(errmsg,
"Can't do boundary on a %s (in %s).\n",
typenames[id_type(id)],ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1274,errmsg,RECOVERABLE);
}
*++stacktop = (b == web.boundaries+testb) ? 1.0 : 0.0;
}
break;
case ON_METHOD_INSTANCE_:
{ struct element *eptr;
int *mptr;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
eptr = elptr(id);
mptr = (int*)((char*)eptr+get_meth_offset(id_type(id)));
for ( i = 0 ; i < eptr->method_count ; i++ )
if ( abs(node->op2.meth_id) == abs(mptr[i]) )
{ *++stacktop = 1.0;
break;
}
if ( i == eptr->method_count )
*++stacktop = 0.0;
break;
}
case ON_QUANTITY_:
{ struct element *eptr;
int *mptr;
struct method_instance *mi;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
eptr = elptr(id);
mptr = (int*)((char*)eptr+get_meth_offset(id_type(id)));
for ( i = 0 ; i < eptr->method_count ; i++ )
{ mi = METH_INSTANCE(abs(mptr[i]));
if ( mi->quant == node->op2.quant_id )
{ *++stacktop = 1.0;
break;
}
}
if ( i == eptr->method_count )
*++stacktop = 0.0;
break;
}
case SELF_ELEMENT_:
if ( !valid_id(self_id) )
{ sprintf(errmsg,"No element for SELF to refer to in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2069,errmsg,RECOVERABLE);
}
*(element_id*)get_localp(node->op2.localnum) = self_id;
break;
case SYMBOL_ELEMENT_:
break;
case SINGLE_ELEMENT_EXPR_:
*(element_id*)(++stacktop) =
*(element_id*)get_localp(node[node->left].op2.localnum);
break;
case ELEMENT_IDENT_:
*(element_id*)get_localp(node->op2.localnum)
= globals(node->op3.name_id)->value.id;
break;
case INDEXED_SUBTYPE_: /* like ee.vertex[1] */
{ element_id next_id = NULLID;
int ord = (int)*(stacktop--) - 1; /* which one */
element_id parent = node[node->left].op2.localnum ?
*(element_id*)get_localp(node[node->left].op2.localnum) : q_id;
int ptype = id_type(parent);
element_id first; /* sentinel for looping */
if ( ord < 0 )
{ sprintf(errmsg,"Element index must be positive in %s.\n",ex->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1275,errmsg,RECOVERABLE);
}
id=NULLID;
switch ( ptype )
{
case VERTEX:
switch ( node->op1.eltype )/* subtype */
{
case EDGE: /* indexed edge of vertex */
id = first = get_vertex_edge(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Vertex %s has no edges.\n",ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1276,errmsg,RECOVERABLE);
}
for ( n = 1 ; n <= ord ; n++ )
{ id = get_next_tail_edge(id);
if ( equal_id(id,first) )
{ sprintf(errmsg,"Edge index %d exceeds valence of vertex %s.\n",
ord+1,ELNAME(id));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1277,errmsg,RECOVERABLE);
}
}
next_id = id;
break;
case FACET: /* indexed facet of vertex */
id = first = get_vertex_first_facet(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Vertex %s has no facets.\n",ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1278,errmsg,RECOVERABLE);
}
for ( n = 1 ; n <= ord ; n++ )
{ id = get_next_vertex_facet(parent,id);
if ( equal_id(id,first) )
{ sprintf(errmsg,
"Facet index %d exceeds facet valence of vertex %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1279,errmsg,RECOVERABLE);
}
}
if ( id_type(id) == FACETEDGE )
id = get_fe_facet(id);
next_id = positive_id(id);
break;
}
break;
case EDGE:
switch ( node->op1.eltype /* subtype */ )
{ case VERTEX:
if ( ord >= web.skel[EDGE].ctrlpts )
{ sprintf(errmsg,
"Index, %d, exceeds the number of vertices on an edge, %d.\n",
ord+1,web.skel[EDGE].ctrlpts);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1280,errmsg, RECOVERABLE);
}
if ( web.modeltype == LAGRANGE )
{ next_id = get_edge_vertices(parent)
[inverted(parent) ? web.skel[EDGE].ctrlpts-ord-1 : ord];
}
else
switch ( ord )
{ case 0: next_id = get_edge_tailv(parent); break;
case 1: next_id = get_edge_headv(parent); break;
case 2: next_id = get_edge_midv(parent); break;
}
break;
case FACET:
id = first = get_edge_fe(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Edge %s has no facets.\n",ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1176,errmsg,RECOVERABLE);
}
for ( n = 1 ; n <= ord ; n++ )
{ id = get_next_facet(id);
if ( equal_id(id,first) )
{ sprintf(errmsg,
"Facet index, %d, exceeds number of facets on edge %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1186,errmsg,RECOVERABLE);
}
}
next_id = get_fe_facet(id);
break;
case FACETEDGE:
id = first = get_edge_fe(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Edge %s has no facets.\n",ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1281,errmsg,RECOVERABLE);
}
for ( n = 1 ; n <= ord ; n++ )
{ id = get_next_facet(id);
if ( equal_id(id,first) )
{ sprintf(errmsg,
"Facetedge index, %d, exceeds valence on edge %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1282,errmsg,RECOVERABLE);
}
}
next_id = id;
break;
}
break;
case FACET:
switch ( node->op1.eltype /* subtype */ )
{ case VERTEX:
if ( (web.representation == SIMPLEX) ||
(web.modeltype == LAGRANGE) )
{ if ( ord >= web.skel[FACET].ctrlpts )
{ sprintf(errmsg,
"Vertex index, %d, exceeds number of vertices on facet %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3503,errmsg,RECOVERABLE);
}
next_id = get_facet_vertices(parent)[ord];
break;
}
if ( (web.modeltype == QUADRATIC) &&
(web.representation == SOAPFILM) )
{ if ( ord >= web.skel[FACET].ctrlpts )
{ sprintf(errmsg,
"Vertex index, %d, exceeds number of vertices on facet %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3504,errmsg,RECOVERABLE);
}
fe = get_facet_fe(parent);
if ( ord < 3 )
{ for ( i = 0 ; i < ord ; i++ )
fe = get_next_edge(fe);
next_id = get_fe_tailv(fe);
}
else
{ for ( i = 3 ; i < ord ; i++ )
fe = get_next_edge(fe);
next_id = get_fe_midv(fe);
}
break;
}
/* now string */
id = first = get_facet_fe(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Facet has no edges.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1283,errmsg,RECOVERABLE);
}
if ( inverted(parent) )
{ facetedge_id nextfe=id,startfe=id;
/* go back round to find start */
do
{ id = nextfe;
nextfe = get_prev_edge(id);
} while ( valid_id(nextfe) && !equal_id(nextfe,startfe) );
first = id;
}
for ( n = 1 ; n <= ord ; n++ )
{ edge_id next_edge = get_next_edge(id);
if ( !valid_id(next_edge) && n == ord )
{ next_id = get_fe_headv(id);
id = NULLID;
break;
}
id = next_edge;
if ( !valid_id(id) || equal_id(id,first) )
{ sprintf(errmsg,
"Vertex index, %d, exceeds number of vertices on facet %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1284,errmsg,RECOVERABLE);
}
}
if ( valid_id(id) )
next_id = get_fe_tailv(id);
break;
case EDGE:
id = first = get_facet_fe(parent);
if ( !valid_element(id) )
{ sprintf(errmsg,"Facet has no edges.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1285,errmsg,RECOVERABLE);
}
if ( inverted(parent) )
{ facetedge_id nextfe=id,startfe=id;
/* go back round to find start */
do
{ id = nextfe;
nextfe = get_prev_edge(id);
} while ( valid_id(nextfe) && !equal_id(nextfe,startfe) );
first = id;
}
for ( n = 1 ; n <= ord ; n++ )
{ id = get_next_edge(id);
if ( !valid_id(id) || equal_id(id,first) )
{ sprintf(errmsg,
"Edge index, %d, exceeds number of vertices on facet %s.\n",
ord+1,ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1286,errmsg,RECOVERABLE);
}
}
next_id = get_fe_edge(id);
break;
case BODY:
switch ( ord )
{ case 0: next_id = get_facet_body(parent); break;
case 1: next_id = get_facet_body(inverse_id(parent));
break;
default:
sprintf(errmsg,
"Illegal facet body index %d; must be 1 or 2.\n",ord+1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1287,errmsg, RECOVERABLE);
break;
}
if ( !valid_id(next_id) )
{ sprintf(errmsg,"Facet %d does not have body of index %d.\n",
oid(parent),ord+1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2070,errmsg,RECOVERABLE);
}
break;
}
break;
case BODY:
switch ( node->op1.eltype /* subtype */ )
{ case FACET:
/*
if ( bfacet_timestamp < top_timestamp ) make_bfacet_lists();
*/
id = first = get_body_facet(parent);
for ( n = 1 ; n <= ord ; n++ )
{
id = get_next_body_facet(id);
if ( equal_id(id,first) )
{ id = NULLID;
break;
}
}
if ( !valid_id(id) )
{ sprintf(errmsg,
"Facet index, %d, exceeds number of facets on body %s.\n",
ord+1, ELNAME(parent));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1288,errmsg,RECOVERABLE);
}
next_id = id;
break;
}
break;
case FACETEDGE:
switch ( node->op1.eltype /* subtype */ )
{ case EDGE: next_id = get_fe_edge(parent); break;
case FACET: next_id = get_fe_facet(parent); break;
}
break;
}
*(element_id*)get_localp(node->op2.localnum) = next_id;
} break; /* end INDEXED_SUBTYPE */
case INDEXED_ELEMENT_:
{ element_id partid = *(element_id*)(stacktop--);
element_id id;
id = get_full_id(node->op1.eltype,partid);
if ( !valid_id(id) )
{ sprintf(errmsg,"%s index %d is not valid.\n",
typenames[node->op1.eltype],
valid_id(partid) ? (int)(partid & OFFSETMASK)+1 : 0);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1200,errmsg,RECOVERABLE);
}
*(element_id *)get_localp(node->op2.localnum) = id;
break;
}
case QUALIFIED_ATTRIBUTE:
break; /* just a no-op in execution */
/****************************/
/* aggregate initialization */
/****************************/
case SET_INIT_:
web.where_count = 0;
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack + 3;
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_subtask_command_flag = 1;
mpi_aggregate(node,ex->locals->count);
}
#endif
break;
case AGGREGATE_INIT_:
aggregate_depth++;
web.where_count = 0;
/* break and continue jumps */
*(size_t*)(localstack + node->stackpos) = stacktop - localstack + 3;
switch ( node->op1.aggrtype )
{ case FOREACH_:
case SET_ATTRIBUTE_LOOP_:
break;
case MAX_:
*++stacktop = -MAXDOUBLE; /* max of empty set */
break;
case MIN_:
*++stacktop = MAXDOUBLE; /* min of empty set */
break;
case SUM_:
*++stacktop = 0.0; /* sum */
break;
case AVG_:
*++stacktop = 0.0; /* count */
*++stacktop = 0.0; /* sum */
break;
case COUNT_:
*++stacktop = 0.0; /* count */
break;
case HISTOGRAM_:
case LOGHISTOGRAM_:
*++stacktop = 0.0; /* first phase counter */
*++stacktop = MAXDOUBLE; /* min */
*++stacktop = -MAXDOUBLE; /* max */
for ( n = 0 ; n < HISTBINS+1 ; n++ )
*++stacktop = 0.0;
histo_max = web.skel[node->op2.eltype].count + 5;
histo_data = (REAL*)temp_calloc(histo_max,sizeof(REAL));
histo_count = 0;
break;
case LIST_: /* print column headers */
#ifdef MPI_EVOLVER
if ( (this_task == MASTER_TASK) || !mpi_subtask_command_flag )
#endif
switch ( node->op2.eltype )
{ case VERTEX:
if ( SDIM == 2 )
outstring("// Id X Y\n");
else
outstring("// Id X Y Z\n");
break;
case EDGE:
outstring("// Id endpoints\n");
break;
case FACET:
if ( web.representation == SIMPLEX )
outstring("// Id vertices\n");
else outstring("// Id edges\n");
break;
case BODY:
outstring("// Id facets\n");
break;
case FACETEDGE:
outstring("// id edge facet prevedge nextedge prevfacet nextfacet\n");
break;
}
break;
case REFINE_:
#ifdef MPI_EVOLVER
if ( (this_task != MASTER_TASK) && mpi_subtask_command_flag
&& node->op2.eltype == EDGE )
mpi_edge_refine_init();
#endif
break;
case DISSOLVE_:
break;
case DELETE_:
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
mpi_set_corona(THIN_CORONA);
if ( (this_task != MASTER_TASK) && mpi_subtask_command_flag )
mpi_delete_init();
#endif
break;
case FIX_:
break;
case UNFIX_:
break;
case REVERSE_ORIENTATION_: break;
case EDGESWAP_: break;
case T1_EDGESWAP_: break;
case EQUIANGULATE_: break;
case POP_: case POP_TRI_TO_EDGE_:
case POP_EDGE_TO_TRI_: case POP_QUAD_TO_QUAD_:
break;
case VERTEX_AVERAGE_: break;
case RAW_VERTEX_AVERAGE_: break;
case RAWEST_VERTEX_AVERAGE_: break;
default:
sprintf(errmsg,"Internal error: Bad aggregate type %d.\n",
node->op1.aggrtype);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1290,errmsg, RECOVERABLE);
break;
}
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_subtask_command_flag = 1;
mpi_aggregate(node,ex->locals->count);
}
#endif
break;
/* end case AGGREGATE_INIT */
/************************/
/* next element in loop */
/************************/
case SINGLE_ELEMENT_:
q_id = *(element_id*)get_localp(node[node->left].op2.localnum);
if ( stacktop[-1] > 0.0 ) /* done */
node += node->op1.skipsize;
else stacktop[-1] = 1.0;
break;
case NEXT_VERTEX_: /* all vertices */
{
vertex_id *vp;
vp = (element_id *)(stacktop - 0);
if ( !valid_id(*vp) || breakflag )
{ /* done */
node += node->op1.skipsize - 1;
break;
}
q_id = *vp;
*(element_id*)get_localp(node->op2.localnum) = q_id;
/* check sentinel; set for next time around */
if ( equal_id(*vp,*(vertex_id*)(stacktop-1)) ) *vp = NULLID;
else *vp = vptr(*vp)->forechain;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign vertices in global aggregate */
#endif
}
break;
case NEXT_EDGE_VERTEX_: /* edge vertices */
{
int *numptr;
vertex_id *vp;
numptr = (int *)(stacktop - 1);
if ( *numptr== web.skel[EDGE].ctrlpts )
{ /* done */
node += node->op1.skipsize - 1;
break;
}
vp = *(element_id **)(stacktop - 0);
q_id = vp[*numptr];
*(element_id*)get_localp(node->op2.localnum) = q_id;
(*numptr)++;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_FACET_VERTEX_: /* facet vertices */
{
facetedge_id *fe_ptr;
facet_id *f_ptr;
if ( (web.representation == SIMPLEX) ||
(web.modeltype==LAGRANGE) )
{ int *numptr = (int *)(stacktop - 1);
if ( *numptr > web.skel[FACET].ctrlpts )
{ node += node->op1.skipsize - 1;
break;
}
f_ptr = (facet_id *)(stacktop);
q_id = get_facet_vertices(*f_ptr)[*numptr];
(*numptr)++;
}
else if ( (web.modeltype == QUADRATIC)
&& (web.representation == SOAPFILM) )
{ int *numptr = (int *)(stacktop - 1);
if ( *numptr >= web.skel[FACET].ctrlpts ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
f_id = *(facet_id *)(stacktop);
fe = get_facet_fe(f_id);
if ( *numptr < 3 )
{ for ( i = 0 ; i < *numptr ; i++ )
fe = get_next_edge(fe);
q_id = get_fe_tailv(fe);
}
else
{ for ( i = 3 ; i < *numptr ; i++ )
fe = get_next_edge(fe);
q_id = get_fe_midv(fe);
}
(*numptr)++;
}
else
{ fe_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*fe_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
if ( id_type(*fe_ptr) == VERTEX )
{ /* last vertex in string unclosed facet */
q_id = *fe_ptr; *fe_ptr = NULLID;
}
else
{ edge_id e_id = get_fe_edge(*fe_ptr);
q_id = get_edge_tailv(e_id);
*fe_ptr = get_next_edge(*fe_ptr);
if ( !valid_id(*fe_ptr) )
*fe_ptr = get_edge_headv(e_id); /* end of string facet */
else if ( !valid_element(*fe_ptr)
|| equal_id(*fe_ptr,*(element_id *)(stacktop-1)))
*fe_ptr = NULLID; /* last one */
}
}
*(element_id*)get_localp(node->op2.localnum) = q_id;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_BODY_VERTEX_: /* body vertices */
break;
case NEXT_EDGE_: /* all edges */
{
edge_id *ep;
ep = (element_id *)(stacktop - 0);
if ( !valid_id(*ep) || breakflag )
{ /* done */
node += node->op1.skipsize - 1;
break;
}
q_id = *ep;
*(element_id*)get_localp(node->op2.localnum) = q_id;
/* check sentinel; set for next time around */
if ( equal_id(*ep,*(edge_id*)(stacktop-1)) ) *ep = NULLID;
else *ep = eptr(*ep)->forechain;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_VERTEX_EDGE_: /* vertex edges */
{ edge_id *e_ptr;
e_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*e_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = *e_ptr;
*(element_id*)get_localp(node->op2.localnum) = q_id;
if ( get_attr(*(element_id *)(stacktop-2)) & (Q_MIDPOINT|Q_MIDEDGE) )
*e_ptr = NULLID; /* last one */
else
{ *e_ptr = get_next_tail_edge(*e_ptr);
if ( !valid_element(*e_ptr)
|| equal_id(*e_ptr,get_vertex_edge(get_edge_tailv(*e_ptr))))
*e_ptr = NULLID; /* last one */
}
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_FACET_EDGE_: /* facet edges */
{
facetedge_id *fe_ptr;
fe_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*fe_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = get_fe_edge(*fe_ptr);
*(element_id*)get_localp(node->op2.localnum) = q_id;
*fe_ptr = get_next_edge(*fe_ptr);
if ( web.representation == STRING )
{
if ( !valid_element(*fe_ptr)
|| equal_id(*fe_ptr,*(element_id *)(stacktop-1)))
*fe_ptr = NULLID; /* last one */
}
else
{ if ( ++(*(int*)(stacktop-1)) == FACET_VERTS )
*fe_ptr = NULLID; /* last one */
}
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_BODY_EDGE_: /* body edges */
break;
case NEXT_FACET_: /* all facets */
{
facet_id *fp;
fp = (element_id *)(stacktop - 0);
if ( !valid_id(*fp)|| breakflag )
{ node += node->op1.skipsize - 1; /* skip to end */
break;
}
q_id = *fp;
*(element_id*)get_localp(node->op2.localnum) = q_id;
/* check sentinel; set for next time around */
if ( equal_id(*fp,*(facet_id*)(stacktop-1)) ) *fp = NULLID;
else *fp = fptr(*fp)->forechain;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_EDGE_FACET_: /* all facets on edge */
{
facetedge_id *fe_ptr;
fe_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*fe_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = get_fe_facet(*fe_ptr);
*(element_id*)get_localp(node->op2.localnum) = q_id;
*fe_ptr = get_next_facet(*fe_ptr);
if ( !valid_element(*fe_ptr) ||
equal_element(*fe_ptr,get_edge_fe(get_fe_edge(*fe_ptr))))
*fe_ptr = NULLID; /* last one */
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_EDGE_FACETEDGE_: /* all facetedges on edge */
{
facetedge_id *fe_ptr;
fe_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*fe_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = *fe_ptr;
*(element_id*)get_localp(node->op2.localnum) = q_id;
*fe_ptr = get_next_facet(*fe_ptr);
if ( !valid_element(*fe_ptr) ||
equal_element(*fe_ptr,get_edge_fe(get_fe_edge(*fe_ptr))))
*fe_ptr = NULLID; /* last one */
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
break;
}
case NEXT_VERTEX_FACET_: /* facets adjacent to vertex */
{
facet_id *f_ptr;
f_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*f_ptr) ) /* see if done */
{
node += node->op1.skipsize - 1;
break;
}
q_id = *f_ptr;
if ( id_type(q_id) == FACETEDGE )
q_id = get_fe_facet(q_id);
q_id = positive_id(q_id);
*(element_id*)get_localp(node->op2.localnum) = q_id;
v_id = *(vertex_id*)(stacktop-2);
*f_ptr=get_next_vertex_facet(v_id,*f_ptr);
if ( equal_id(*f_ptr,*(element_id*)(stacktop-1)) )
*f_ptr = NULLID;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_BODY_FACET_: /* facets on body */
{
facet_id *f_ptr;
f_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*f_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = *f_ptr;
*(element_id*)get_localp(node->op2.localnum) = q_id;
*f_ptr = get_next_body_facet(*f_ptr);
if ( (get_fattr(*f_ptr)& (inverted(*f_ptr)?DID_BODYBACKFACET:DID_BODYFRONTFACET))
|| equal_id(*f_ptr,q_id) ||
equal_id(*f_ptr,*(element_id *)(stacktop-1)))
*f_ptr = NULLID; /* last one */
else set_attr(*f_ptr,
(inverted(*f_ptr) ? DID_BODYBACKFACET : DID_BODYFRONTFACET) );
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_BODY_: /* all bodies */
{
body_id *bp;
bp = (element_id *)(stacktop - 0);
if ( !valid_id(*bp)|| breakflag )
{ node += node->op1.skipsize - 1;
break;
}
q_id = *bp;
*(element_id*)get_localp(node->op2.localnum) = q_id;
/* check sentinel; set for next time around */
if ( equal_id(*bp,*(body_id*)(stacktop-1)) ) *bp = NULLID;
else *bp = bptr(*bp)->forechain;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_FACET_BODY_: /* both bodies on facet */
{
int *numptr = (int *)(stacktop - 1);
f_id = *(facet_id *)(stacktop - 2); /* facet */
(*numptr)++;
if ( *numptr == 3 ) /* see if done */
{ /* done */
node += node->op1.skipsize - 1;
break;
}
if ( *numptr == 1 ) /* first */
{
q_id = get_facet_body(f_id);
*(element_id*)get_localp(node->op2.localnum) = q_id;
if ( !valid_id(q_id) )
node--; /* try again */
}
else /* *numptr == 2 */
{ q_id = get_facet_body(inverse_id(f_id));
*(element_id*)get_localp(node->op2.localnum) = q_id;
if ( !valid_id(q_id) )
node--; /* try again */
}
break;
}
case NEXT_VERTEX_BODY_: /* bodies adjacent to vertex */
break;
case NEXT_EDGE_BODY_: /* bodies adjacent to edge */
break;
case NEXT_FACETEDGE_: /* all facetedges */
{
facetedge_id *fep;
fep = (element_id *)(stacktop - 0);
if ( !valid_id(*fep)|| breakflag )
{ /* done */
node += node->op1.skipsize - 1;
break;
}
q_id = *fep;
*(element_id*)get_localp(node->op2.localnum) = q_id;
/* check sentinel; set for next time around */
if ( equal_id(*fep,*(facetedge_id*)(stacktop-1)) ) *fep = NULLID;
else *fep = feptr(*fep)->forechain;
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_FACETEDGE_EDGE_: /* edge on facetedge */
{
edge_id *e_ptr;
e_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*e_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = *e_ptr;
*(element_id*)get_localp(node->op2.localnum) = q_id;
*e_ptr = NULLID; /* last one */
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
case NEXT_FACETEDGE_FACET_: /* facet on facetedge */
{
facet_id *f_ptr;
f_ptr = (element_id *)(stacktop - 0);
if ( !valid_id(*f_ptr) ) /* see if done */
{ node += node->op1.skipsize - 1;
break;
}
q_id = *f_ptr;
*(element_id*)get_localp(node->op2.localnum) = q_id;
*f_ptr = NULLID; /* last one */
if ( !valid_element(q_id) ) node--; /* skip body of loop */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (id_task(q_id) != this_task) )
node--; /* don't count foreign elements in global aggregate */
#endif
}
break;
/***********************/
/* aggregate condition */
/***********************/
case WHERE_: /* see if element qualifies */
if ( *(stacktop--) == 0.0 )
node += node->left-1; /* no, go back to generator */
else node->op1.wherecount++; /* where count NONREENTRANT */
break; /* else continue with current element */
case SINGLE_ASSIGN_:
/* restore old q_id */
q_id = *(element_id *)(stacktop - 2);
stacktop -= 3; /* erase locals */
break;
/*****************/
/* aggregate end */
/*****************/
case AGGREGATE_END_:
aggregate_depth--;
/* restore old q_id */
q_id = *(element_id *)(stacktop - 2);
where = node+node->right;
where = where+where->left;
if ( where->type == WHERE_ )
{ web.where_count = where->op1.wherecount;
where->op1.wherecount = 0; /* reset where count */
}
switch ( node->op1.aggrtype )
{
case FOREACH_:
case SET_ATTRIBUTE_LOOP_:
stacktop -= 3; /* erase locals */
break;
case MAX_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ MPI_Reduce(stacktop,stacktop+1,1,MPI_REAL,MPI_MAX,
MASTER_TASK,MPI_COMM_WORLD);
stacktop[0] = stacktop[1];
}
#endif
break;
case MIN_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ MPI_Reduce(stacktop,stacktop+1,1,MPI_REAL,MPI_MIN,
MASTER_TASK,MPI_COMM_WORLD);
stacktop[0] = stacktop[1];
}
#endif
break;
case SUM_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ MPI_Reduce(stacktop,stacktop+1,1,MPI_REAL,MPI_SUM,
MASTER_TASK,MPI_COMM_WORLD);
stacktop[0] = stacktop[1];
}
#endif
break;
case COUNT_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ MPI_Reduce(stacktop,stacktop+1,1,MPI_REAL,MPI_SUM,
MASTER_TASK,MPI_COMM_WORLD);
stacktop[0] = stacktop[1];
}
#endif
break;
case AVG_:
stacktop -= 4; /* erase locals */
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0) )
{ MPI_Reduce(stacktop,stacktop+2,2,MPI_REAL,MPI_SUM,
MASTER_TASK,MPI_COMM_WORLD);
stacktop[0] = stacktop[2];
stacktop[1] = stacktop[3];
}
#endif
if ( stacktop[0] > 0.0 )
stacktop[0] = stacktop[1]/stacktop[0];
/* else leave avg as 0 */
break;
case LOGHISTOGRAM_:
case HISTOGRAM_:
{ int i;
REAL binsize;
int one_bin_flag = 0;
bins = stacktop - (HISTBINS+1) + 1 - 3;
/* find hi and lo */
hi = -MAXDOUBLE; lo = MAXDOUBLE;
for ( i = 0 ; i < histo_count ; i++ )
{ if ( histo_data[i] < lo )
if ( (node->op1.aggrtype == HISTOGRAM_) || ( histo_data[i] > 0.0) )
lo = histo_data[i];
if ( histo_data[i] > hi ) hi = histo_data[i];
}
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ /* synchronize max-min values */
DOUBLE localhi = hi,locallo = lo;
DOUBLE globalhi,globallo;
MPI_Allreduce(&localhi,&globalhi,1,MPI_REAL,MPI_MAX,
MPI_COMM_WORLD);
hi = globalhi;
MPI_Allreduce(&locallo,&globallo,1,MPI_REAL,MPI_MIN,
MPI_COMM_WORLD);
lo = globallo;
}
#endif
if (node->op1.aggrtype == HISTOGRAM_ )
{ if ( hi == lo )
{ binsize = 1.0; /* will put everything in first bin */
one_bin_flag = 1;
}
else binsize = (hi-lo)/HISTBINS;/* binsize */
}
else /* first bin for 0 values for log histogram */
{ if ( hi <= 0.0 ) binsize = 0.0;
else
{ hi = log(hi);
if ( lo <= 0.0 )
{ binsize = 1.0; lo = hi-(HISTBINS-1); }
else
{ lo = log(lo);
if ( hi == lo )
{ binsize = 1.0;
one_bin_flag = 1;
}
else
binsize = (hi-lo)/(HISTBINS-1);
}
}
}
binsize *= 1+10*machine_eps; /* for rounding margin */
if ( lo != 0.0 ) lo -= 10*machine_eps*binsize;
/* construct histogram */
for ( i = 0 ; i < histo_count ; i++ )
{ val = histo_data[i];
if ( !is_finite(val) )
k = HISTBINS; /* NaN */
else if ( node->op1.aggrtype == HISTOGRAM_ )
k = (int)((val-lo)/binsize);
else if ( val <= 0.0 ) k = 0;
else
{ val = log(val);
k = (int)((val-lo)/binsize)+1;
}
bins[k] += 1.0;
}
#ifdef MPI_EVOLVER
if ( mpi_subtask_command_flag && (aggregate_depth==0))
{ /* accumulate histogram data on master */
REAL recvbuf[HISTBINS+1];
MPI_Reduce(bins,recvbuf,HISTBINS+1,MPI_REAL,MPI_SUM,
MASTER_TASK, MPI_COMM_WORLD);
if ( this_task == MASTER_TASK )
for ( k = 0, histo_count = 0 ; k <= HISTBINS ; k++ )
{ bins[k] = recvbuf[k];
histo_count += (int)bins[k];
}
}
#endif
/* print histogram */
#ifdef MPI_EVOLVER
if ( (this_task == MASTER_TASK) || !mpi_subtask_command_flag )
#endif
{
if ( histo_count == 0 )
{
outstring("No qualifying values.\n");
stacktop -= HISTBINS+1 + 3 + 3;
break;
}
if ( one_bin_flag )
{ if (node->op1.aggrtype == HISTOGRAM_ )
sprintf(msg,"%10.5g - %10.5g %d\n",
(DOUBLE)hi,(DOUBLE)hi,histo_count);
else sprintf(msg,"%10.5g - %10.5g %d\n",
(DOUBLE)exp(hi),(DOUBLE)exp(hi),histo_count);
outstring(msg);
stacktop -= HISTBINS+1 + 3 + 3;
break;
}
if (node->op1.aggrtype == HISTOGRAM_ )
for ( n = 0 ; n < HISTBINS ; n++ )
{ sprintf(msg,"%10.5g - %10.5g %d\n",
(DOUBLE)(lo + n*binsize),(DOUBLE)(lo + (n+1)*binsize),
(int)bins[n]);
outstring(msg);
}
else /* log histogram */
{ int zeroes = (int)bins[0];
if ( zeroes )
{ sprintf(msg," <= 0.0 %d\n",zeroes);
outstring(msg);
}
if ( hi > 0 )
for ( n = 1 ; n < HISTBINS ; n++ )
{ sprintf(msg,"%10.5g - %10.5g %d\n",
(DOUBLE)(exp(lo + (n-1)*binsize)),
(DOUBLE)(exp(lo + n*binsize)),
(int)bins[n]);
outstring(msg);
}
}
if ( bins[HISTBINS] > 0.0 )
{ sprintf(msg,"NaN %d\n",(int)bins[HISTBINS]);
outstring(msg);
}
}
temp_free((char*)histo_data);
stacktop -= HISTBINS+1 + 3 + 3; /* erase locals */
mpi_subtask_command_flag = 0;
break;
}
case LIST_:
stacktop -= 3; /* erase locals */
break;
case SET_COLOR_:
case SET_FRONTCOLOR_:
case SET_BACKCOLOR_:
case SET_OPACITY_:
stacktop -= 3; /* erase locals */
update_display_flag = 1;
break;
case SET_FIXED_: case SET_NO_REFINE_: case SET_NO_DISPLAY_:
case SET_DENSITY_: case UNSET_DENSITY_: case SET_BARE_:
case SET_CONSTRAINT_: case UNSET_CONSTRAINT_:
case SET_CONSTRAINT_NAME: case UNSET_CONSTRAINT_NAME:
case SET_VOLUME_: case SET_PRESSURE_: case SET_NONCONTENT_:
case UNSET_BOUNDARY_: case UNSET_BOUNDARY_NAME:
case UNSET_FIXED_: case UNSET_PRESSURE_: case UNSET_VOLUME_:
case SET_NAMED_QUANTITY_: case UNSET_NO_REFINE_: case UNSET_BARE_:
case UNSET_NAMED_QUANTITY_: case UNSET_NO_DISPLAY_:
case SET_METHOD_INSTANCE_: case UNSET_METHOD_INSTANCE_:
case UNSET_TRIPLE_PT_: case UNSET_TETRA_PT_:
case UNSET_NONCONTENT_: case SET_BOUNDARY_:
case SET_HIT_PARTNER_: case UNSET_HIT_PARTNER_:
stacktop -= 3; /* erase locals */
recalc_flag = 1;
break;
case SET_FRONTBODY_:
case SET_BACKBODY_:
case UNSET_FRONTBODY_:
case UNSET_BACKBODY_:
case UNSET_FACET_BODY_:
/*make_bfacet_lists(); */ /* so lists legal */
stacktop -= 3; /* erase locals */
recalc_flag = 1;
break;
case REFINE_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( (this_task != MASTER_TASK) && mpi_subtask_command_flag )
mpi_task_edge_refine_wrapup();
#endif
break;
case DISSOLVE_:
stacktop -= 3; /* erase locals */
break;
case DELETE_:
stacktop -= 3; /* erase locals */
#ifdef MPI_EVOLVER
if ( (this_task != MASTER_TASK) && mpi_subtask_command_flag )
mpi_task_delete_wrapup();
#endif
break;
case FIX_:
stacktop -= 3; /* erase locals */
break;
case UNFIX_:
stacktop -= 3; /* erase locals */
break;
default:
stacktop -= 3; /* erase locals */
break;
} break; /* end AGGREGATE_END */
/*********************/
/* attribute setting */
/* aggregate verbs */
/*********************/
case SET_FIXED_:
set_attr(q_id,FIXED);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_FIXED_:
unset_attr(q_id,FIXED);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_BARE_:
set_attr(q_id,BARE_NAKED);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_BARE_:
unset_attr(q_id,BARE_NAKED);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_NO_DISPLAY_:
set_attr(q_id,NODISPLAY);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_NO_DISPLAY_:
unset_attr(q_id,NODISPLAY);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_NONCONTENT_:
if ( everything_quantities_flag )
kb_error(2484,
"Changing NONCONTENT not implemented for everything_quantities mode yet.\n",
RECOVERABLE);
set_attr(q_id,NONCONTENT);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_NONCONTENT_:
if ( everything_quantities_flag )
kb_error(2595,
"Changing NONCONTENT not implemented for everything_quantities mode yet.\n",
RECOVERABLE);
unset_attr(q_id,NONCONTENT);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_HIT_PARTNER_:
set_attr(q_id,HIT_PARTNER);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_HIT_PARTNER_:
unset_attr(q_id,HIT_PARTNER);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_NO_REFINE_:
set_attr(q_id,NO_REFINE);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_NO_REFINE_:
unset_attr(q_id,NO_REFINE);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_PRESSURE_:
unset_attr(q_id,PRESSURE);
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(q_id));
q->modulus = 1;
q->flags &= ~(Q_ENERGY|Q_FIXED|Q_CONSERVED);
q->flags |= Q_INFO;
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_CONSTRAINT_:
case UNSET_CONSTRAINT_NAME:
if (node->type == UNSET_CONSTRAINT_)
k = (int)*(stacktop--);
else
k = node->op3.connum;
k &= CONMASK; /* so will ignore hit bit */
if ( k < web.maxcon )
switch ( id_type(q_id) )
{ case VERTEX:
unset_v_constraint_map(q_id,k);
break;
case EDGE:
unset_e_constraint_map(q_id,k);
break;
case FACET:
unset_f_constraint_map(q_id,k);
break;
default:
sprintf(errmsg,"Bad element type for constraint.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1292,errmsg, RECOVERABLE);
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_BOUNDARY_:
k = (int)*(stacktop--); /* boundary number */
bdry = web.boundaries+abs(k);
if ( (abs(k) >= web.bdrymax) || !(bdry->attr&IN_USE) )
{ sprintf(errmsg,"Boundary %d is not valid.\n",k);
kb_error(2998,errmsg,RECOVERABLE);
}
if ( get_attr(q_id) & BOUNDARY )
{ struct boundary *qbdry;
switch ( id_type(q_id) )
{ case VERTEX: qbdry = get_boundary(q_id); break;
case EDGE: qbdry = get_edge_boundary(q_id); break;
case FACET: qbdry = get_facet_boundary(q_id); break;
default: qbdry = NULL; /* error message below */
}
if ( qbdry == bdry ) break;
sprintf(errmsg,"%s %s already on a different boundary.\n",
typenames[id_type(q_id)],ELNAME(q_id));
kb_error(2999,errmsg,RECOVERABLE);
}
set_attr(q_id,BOUNDARY);
if ( k < 0 )
set_attr(q_id,NEGBOUNDARY);
switch(id_type(q_id))
{ case VERTEX:
{ REAL *x = get_coord(q_id);
int n;
set_boundary_num(q_id,abs(k));
for ( n = 0 ; n < SDIM ; n++ )
if ( bdry->coordf[n]->root != NULL )
{ PROF_EVAL_END(ex);
x[n] = eval(bdry->coordf[n],get_param(q_id),q_id,NULL);
PROF_EVAL_START(ex);
}
break;
}
case EDGE:
set_edge_boundary_num(q_id,abs(k));
break;
case FACET:
set_facet_boundary_num(q_id,abs(k));
break;
default:
sprintf(errmsg,"Bad element type for boundary.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3000,errmsg, RECOVERABLE);
}
if ( bdry->attr & CON_ENERGY )
apply_method_num(q_id,bdry->energy_method);
if ( bdry->attr & CON_CONTENT )
{ if ( (web.representation == STRING) && (id_type(q_id) == VERTEX) )
fixup_vertex_content_meths(q_id);
else if ( (web.representation == SOAPFILM) && (id_type(q_id) == EDGE) )
fixup_edge_content_meths(q_id);
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_BOUNDARY_:
case UNSET_BOUNDARY_NAME:
k = (node->type == UNSET_BOUNDARY_) ? (int)*(stacktop--)
: node->op3.bdrynum;
if ( k >= web.bdrymax ) break;
bdry = web.boundaries+k;
if ( get_attr(q_id) & BOUNDARY )
{
switch ( id_type(q_id) )
{ case VERTEX:
if ( get_boundary(q_id) == bdry )
{ set_boundary_num(q_id,0);
unset_attr(q_id,BOUNDARY|HIT_PARTNER);
}
break;
case EDGE:
if ( get_edge_boundary(q_id) == bdry )
{ set_edge_boundary_num(q_id,0);
unset_attr(q_id,BOUNDARY);
}
break;
case FACET:
if ( get_facet_boundary(q_id) == bdry )
{ set_facet_boundary_num(q_id,0);
unset_attr(q_id,BOUNDARY);
}
break;
default:
sprintf(errmsg,"Bad element type for boundary.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1293,errmsg, RECOVERABLE);
}
if ( bdry->attr & CON_ENERGY )
unapply_method(q_id,bdry->energy_method);
if ( bdry->attr & CON_CONTENT )
{ if ( (web.representation == STRING) && (id_type(q_id) == VERTEX) )
fixup_vertex_content_meths(q_id);
else if ( (web.representation == SOAPFILM) && (id_type(q_id) == EDGE) )
fixup_edge_content_meths(q_id);
}
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_VOLUME_:
case UNSET_TARGET_:
if ( get_attr(q_id) & FIXEDVOL)
{ unset_attr(q_id,FIXEDVOL);
if (everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(q_id));
q->target = 0.0;
if ( !(q->flags & Q_INFO) )
{ q->flags &= ~(Q_FIXED|Q_ENERGY|Q_CONSERVED);
q->flags |= Q_INFO;
}
if ( web.pressure_flag )
{ q = GEN_QUANT(get_body_ambquant(q_id));
q->flags &= ~(Q_FIXED|Q_ENERGY|Q_CONSERVED);
q->flags |= Q_INFO;
}
}
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_FACET_BODY_:
if ( id_type(q_id) != FACET )
{ sprintf(errmsg,"Trying to unset body of non-facet.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1294,errmsg, RECOVERABLE);
}
set_facet_body(q_id,NULLID);
set_facet_body(inverse_id(q_id),NULLID);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_FRONTBODY_:
case UNSET_BACKBODY_:
set_body(node->type==UNSET_FRONTBODY_?q_id:inverse_id(q_id),NULLID);
recalc_flag = 1;
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_DENSITY_:
unset_attr(q_id,DENSITY);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_TRIPLE_PT_:
unset_attr(q_id,TRIPLE_PT);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_TETRA_PT_:
unset_attr(q_id,TETRA_PT);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case UNSET_AXIAL_POINT_:
unset_attr(q_id,AXIAL_POINT);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_DENSITY_:
{ REAL density = *(stacktop--);
if ( density != 1.0 ) set_attr(q_id,DENSITY);
switch ( node->op2.eltype )
{ case EDGE: set_edge_density(q_id,density); break;
case FACET: set_facet_density(q_id,density); break;
case BODY: set_body_density(q_id,density); break;
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SET_VOLUME_:
{ REAL v = *(stacktop--);
if ( get_attr(q_id) & PRESSURE )
{ sprintf(errmsg,"Must unset body pressure before fixing target.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2071,errmsg, RECOVERABLE);
}
set_attr(q_id,FIXEDVOL);
set_body_fixvol(q_id,v);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
}
case SET_PRESSURE_:
{ REAL p = *(stacktop--);
if ( get_attr(q_id) & FIXEDVOL )
{ sprintf(errmsg,"Must unset body target before fixing pressure.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2521,errmsg, RECOVERABLE);
}
set_attr(q_id,PRESSURE);
set_body_pressure(q_id,p);
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(q_id));
q->modulus = -p;
if ( !(q->flags & Q_ENERGY) )
{ q->flags &= ~(Q_INFO|Q_FIXED|Q_CONSERVED);
q->flags |= Q_ENERGY;
}
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
}
case SET_OPACITY_:
facet_alpha = *(stacktop)--;
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_CONSTRAINT_:
case SET_CONSTRAINT_NAME:
{ int con = (node->type==SET_CONSTRAINT_) ? (int)*(stacktop--)
: node->op3.connum;
if ( (con<0) || (con>=web.maxcon) || !(get_constraint(con)->attr & IN_USE))
{ sprintf(errmsg,"Illegal constraint number: %d.\n",con);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1295,errmsg,RECOVERABLE);
}
if ( get_attr(q_id) & BOUNDARY )
{ sprintf(errmsg,
"Cannot set %s %s on a constraint since it is on a boundary.\n",
typenames[node->op2.eltype],ELNAME(q_id));
kb_error(4002,errmsg,RECOVERABLE);
}
switch ( node->op2.eltype )
{ case VERTEX: set_v_constraint_map(q_id,con);
project_v_constr(q_id,ACTUAL_MOVE,RESET_ONESIDEDNESS);
break;
case EDGE: set_e_constraint_map(q_id,con); break;
case FACET: set_f_constraint_map(q_id,con); break;
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SET_NAMED_QUANTITY_:
{ int qnum = (int)*(stacktop--);
apply_quantity(q_id,qnum);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case UNSET_NAMED_QUANTITY_:
{ int qnum = (int)*(stacktop--);
unapply_quantity(q_id,qnum);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SET_METHOD_INSTANCE_:
{ int qnum = (int)*(stacktop--);
apply_method_num(q_id,qnum);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case UNSET_METHOD_INSTANCE_:
{ int qnum = (int)*(stacktop--);
unapply_method(q_id,qnum);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SET_COLOR_:
{ int color = (int)*(stacktop--);
switch ( node->op2.eltype )
{ case EDGE: set_edge_color(q_id,color); break;
case FACET: set_facet_color(q_id,color); break;
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
update_display_flag = 1;
}
break;
case SET_FRONTCOLOR_:
{ int color = (int)*(stacktop--);
set_facet_frontcolor(q_id,color);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
update_display_flag = 1;
}
break;
case SET_BACKCOLOR_:
{ int color = (int)*(stacktop--);
set_facet_backcolor(q_id,color);
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
update_display_flag = 1;
}
break;
case SET_TAG_:
{ int tag = (int)*(stacktop--);
switch ( node->op2.eltype )
{
case FACET: set_tag(q_id,tag); break;
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SET_COORD_:
get_coord(q_id)[node->op2.coordnum] = *(stacktop--);
if ( node->op2.coordnum <= SDIM ) recalc_flag = 1;
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case SET_PARAM_:
if ( get_vattr(q_id) & BOUNDARY )
{ struct boundary *boundary = get_boundary(q_id);
REAL *param = get_param(q_id);
REAL *xx = get_coord(q_id);
if ( node->op2.coordnum > boundary->pcount )
{ sprintf(errmsg,"Parameter number is %d; maximum is %d.\n",
node->op2.coordnum,boundary->pcount);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1296,errmsg,RECOVERABLE);
}
param[node->op2.coordnum] = *(stacktop--);
PROF_EVAL_END(ex);
for ( k = 0 ; k < SDIM ; k++ )
xx[k] = eval(boundary->coordf[k],param,q_id,NULL);
PROF_EVAL_START(ex);
recalc_flag = 1;
}
else
{ /* probably just handy for storage */
REAL *param = get_param(q_id);
param[node->op2.coordnum] = *(stacktop--);
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
/************************/
/* numerical aggregates */
/************************/
case MAX_:
{ REAL *aggrptr;
val = *(stacktop--);
aggrptr = (REAL *)(stacktop - 3);
if ( val > *aggrptr ) *aggrptr = val;
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case MIN_:
{
REAL *aggrptr;
val = *(stacktop--);
aggrptr = (REAL *)(stacktop - 3);
if ( val < *aggrptr ) *aggrptr = val;
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
}
break;
case SUM_:
stacktop--;
stacktop[-3] += stacktop[1];
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case AVG_:
stacktop--;
stacktop[-3] += stacktop[1]; /* sum */
stacktop[-4] += 1.0; /* count */
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case COUNT_:
stacktop--;
stacktop[-3] += 1.0;
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case HISTOGRAM_:
case LOGHISTOGRAM_:
if ( histo_count >= histo_max )
{ histo_data = (REAL*)temp_realloc((char*)histo_data,
2*histo_max*sizeof(REAL));
histo_max *= 2;
}
histo_data[histo_count++] = *(stacktop--);
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case FOREACH_:
case SET_ATTRIBUTE_LOOP_:
node += node->op1.skipsize - 1; /* back to start of loop */
break;
case ARRAY_HEAD_: break; /* let indices accumulate */
case ARRAYASSIGN:
{ struct array *a;
REAL value=0.0,rhs;
int i,offset;
void *lvalue;
struct global *g = globals(node->op2.name_id);
a = get_name_arrayptr(node->op2.name_id,localstack,localbase);
rhs = *(stacktop--);
for ( i = 0 ; i < a->dim ; i++ )
{ int k = (int)stacktop[i+1-a->dim];
if ( k < 1 )
{ sprintf(errmsg,
"Array index %d of array %s is %d. Indexes start at 1.\n",
i+1,g->name,k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3011,errmsg,RECOVERABLE);
}
if ( k > a->sizes[i] && (!(node->flags & IS_VIRTUAL_ATTR) ||(k > SDIM)) )
{ sprintf(errmsg,"Array index %d of array %s is %d; exceeds bound of %d.\n",
i+1,g->name,k,a->sizes[i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3012,errmsg,RECOVERABLE);
}
}
for ( i = 1, offset = (int)stacktop[1-a->dim]-1 ; i < a->dim ; i++ )
{ offset *= a->sizes[i];
offset += (int)stacktop[i+1-a->dim]-1; /* 1-based indexing */
}
stacktop -= a->dim;
lvalue = ((char *)a) + a->datastart + offset*a->itemsize;
switch ( a->datatype )
{ case REAL_TYPE: value = *(REAL*)(lvalue); break;
case INTEGER_TYPE: value = *(int*)(lvalue); break;
case UINT_TYPE: value = *(unsigned int*)(lvalue); break;
case SHORT_TYPE: value = *(short int*)(lvalue); break;
case USHORT_TYPE: value = *(unsigned short int*)(lvalue); break;
case LONG_TYPE: value = *(long int*)(lvalue); break;
case ULONG_TYPE: value = *(unsigned long int*)(lvalue); break;
case CHAR_TYPE: value = *(char*)(lvalue); break;
case UCHAR_TYPE: value = *(unsigned char*)(lvalue); break;
case PTR_TYPE: value = (unsigned long int)*(char**)(lvalue); break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: break;
default: value = *(int*)(lvalue); break;
}
switch ( node->op1.assigntype )
{
case ASSIGN_: value = rhs; break;
case PLUSASSIGN_: value += rhs; break;
case SUBASSIGN_: value -= rhs; break;
case MULTASSIGN_: value *= rhs; break;
case DIVASSIGN_:
if( rhs == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3015,errmsg,RECOVERABLE);
}
value /= rhs; break;
}
switch ( a->datatype )
{ case REAL_TYPE: *(REAL*)(lvalue) = value; break;
case INTEGER_TYPE: *(int*)(lvalue) = (int)value; break;
case UINT_TYPE: *(unsigned int*)(lvalue) = (unsigned int)value; break;
case CHAR_TYPE: *(char*)(lvalue) = (char)value; break;
case UCHAR_TYPE: *(unsigned char*)(lvalue) = (unsigned char)value; break;
case SHORT_TYPE: *(short*)(lvalue) = (short)value; break;
case USHORT_TYPE: *(unsigned short*)(lvalue) = (unsigned short)value; break;
case LONG_TYPE: *(long*)(lvalue) = (long)value; break;
case ULONG_TYPE: *(unsigned long*)(lvalue) = (unsigned long)value; break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: break;
default: *(int*)(lvalue) = (int)value; break;
}
if ( g->flags & RECALC_PARAMETER )
recalc_flag = 1;
}
break;
case ARRAYEVAL:
{
struct global *g = globals(node->op2.name_id);
struct array *a;
REAL value=0.0;
int i,offset;
void *lvalue;
a = get_name_arrayptr(node->op2.name_id,localstack,localbase);
for ( i = 0 ; i < a->dim ; i++ )
{ int k = (int)stacktop[i+1-a->dim];
if ( k < 1 )
{ sprintf(errmsg,
"Array index %d of array %s is %d. Indexes start at 1.\n",
i+1,g->name,k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2047,errmsg,RECOVERABLE);
}
if ( k > a->sizes[i] )
{ sprintf(errmsg,
"Array index %d of array %s is %d; exceeds bound of %d.\n",
i+1,g->name,k,a->sizes[i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2048,errmsg,RECOVERABLE);
}
}
for ( i = 1, offset = (int)stacktop[1-a->dim]-1 ; i < a->dim ; i++ )
{ offset *= a->sizes[i];
offset += (int)stacktop[i+1-a->dim]-1; /* 1-based indexing */
}
stacktop -= a->dim;
lvalue = ((char *)a) + a->datastart + offset*a->itemsize;
switch ( a->datatype )
{ case REAL_TYPE: value = *(REAL*)(lvalue); break;
case INTEGER_TYPE: value = *(int*)(lvalue); break;
case UINT_TYPE: value = *(unsigned int*)(lvalue); break;
case CHAR_TYPE: value = *(char*)(lvalue); break;
case UCHAR_TYPE: value = *(unsigned char*)(lvalue); break;
case SHORT_TYPE: value = *(short int*)(lvalue); break;
case USHORT_TYPE: value = *(unsigned short int*)(lvalue); break;
case LONG_TYPE: value = *(long*)(lvalue); break;
case ULONG_TYPE: value = *(unsigned long*)(lvalue); break;
case PTR_TYPE: value = (unsigned long)*(char**)(lvalue); break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: value = (int)*(element_id*)(lvalue); break;
default: value = *(int*)(lvalue); break;
}
*(++stacktop) = value;
}
break;
/* whole array syntax */
case ARRAYIDENT_: /* push datastart for array */
{ struct global *glvalue = globals(node->op2.name_id);
struct array *alvalue;
alvalue = get_name_arrayptr(node->op2.name_id,localstack,localbase);
if ( glvalue->flags & FIXED_SIZE_ARRAY )
*(REAL**)(++stacktop) =
localstack + glvalue->attr.arrayptr->datastart;
else
*(char**)(++stacktop) = (char*)alvalue + alvalue->datastart;
break;
}
case ATTRIB_LVALUE_: /* push datastart for attribute array */
{ element_id id;
n = node->op2.name_id & GLOBMASK; /* attribute number */
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
*(char**)(++stacktop) = (char*)get_extra(id,n);
}
break;
case ARRAY_VERTEX_NORMAL_:
case ARRAY_EDGE_VECTOR_:
case ARRAY_FACET_NORMAL_:
{ element_id id;
REAL *datastart = get_localp(node->op3.localnum);
*(REAL**)(++stacktop) = datastart;
if ( node->flags & IS_RVALUE )
{ if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
switch ( node->type )
{ case ARRAY_VERTEX_NORMAL_:
{ MAT2D(normal,MAXCOORD,MAXCOORD);
REAL mag;
int normcount;
normcount = new_calc_vertex_normal(id,normal);
project_vertex_normals(id,normal,normcount);
mag = sqrt(SDIM_dot(normal[0],normal[0]));
if ( mag == 0.0 ) mag = 1;
for ( i = 0 ; i < SDIM ; i++ )
datastart[i] = normal[0][i]/mag;
break;
}
case ARRAY_EDGE_VECTOR_:
get_edge_side(id,datastart);
break;
case ARRAY_FACET_NORMAL_:
get_facet_normal(id,datastart);
break;
}
}
}
break;
case ARRAY_LVALUE_INDEXED_:
break;
case ARRAY_RVALUE_ :
break;
case DOT_: /* dot product */
{ struct array *a,*b;
int name1 = node->op2.name_id;
int name2 = node->op3.name_id;
REAL *datastart1,*datastart2;
REAL sum;
int counta,countb,count;
if ( node[node->left].flags & IS_VIRTUAL_ATTR )
counta = SDIM;
else
{ a = get_name_arrayptr(name1,NULL,localbase);
counta = a->datacount;
}
if ( node[node->right].flags & IS_VIRTUAL_ATTR )
countb = SDIM;
else
{ b = get_name_arrayptr(name2,NULL,localbase);
countb = b->datacount;
}
count = (counta < countb) ? counta : countb;
datastart1 = *(REAL**)(stacktop--);
datastart2 = *(REAL**)(stacktop--);
for ( sum = 0.0, i = 0 ; i < count ; i++ )
sum += datastart1[i]*datastart2[i];
*(++stacktop) = sum;
break;
}
case ARRAY_EVAL_: /* rexpr: arraylvalue indexset */
{ /* use info on stack to push value of array element.
stack: datastart index-values -> rexpr */
struct array *a;
REAL value=0.0;
int i,offset;
void *lvalue;
char *datastart;
a = get_name_arrayptr(node->op2.name_id,localstack,localbase);
for ( i = 0 ; i < a->dim ; i++ )
{ int k = (int)stacktop[i+1-a->dim];
if ( k < 1 )
{ sprintf(errmsg,
"Array index %d of array %s is %d. Indexes start at 1.\n",
i+1,get_name_name(node->op2.name_id,localbase),k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3022,errmsg,RECOVERABLE);
}
if ( k > a->sizes[i] && (!(node->flags & IS_VIRTUAL_ATTR) ||(k > SDIM)) )
{sprintf(errmsg,"Array index %d of array %s is %d; exceeds bound of %d.\n",
i+1,get_name_name(node->op2.name_id,localbase),k,a->sizes[i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3023,errmsg,RECOVERABLE);
}
}
for ( i = 1, offset = (int)stacktop[1-a->dim]-1 ; i < a->dim ; i++ )
{ offset *= a->sizes[i];
offset += (int)stacktop[i+1-a->dim]-1; /* 1-based indexing */
}
stacktop -= a->dim;
datastart = *(char**)(stacktop--);
lvalue = datastart + offset*a->itemsize;
switch ( a->datatype )
{ case REAL_TYPE: value = *(REAL*)(lvalue); break;
case INTEGER_TYPE: value = *(int*)(lvalue); break;
case UINT_TYPE: value = *(unsigned int*)(lvalue); break;
case SHORT_TYPE: value = *(short int*)(lvalue); break;
case USHORT_TYPE: value = *(unsigned short int*)(lvalue); break;
case LONG_TYPE: value = *(long int*)(lvalue); break;
case ULONG_TYPE: value = *(unsigned long int*)(lvalue); break;
case CHAR_TYPE: value = *(char*)(lvalue); break;
case UCHAR_TYPE: value = *(unsigned char*)(lvalue); break;
case PTR_TYPE: value = (unsigned long int)*(char**)(lvalue); break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: break;
default: value = *(int*)(lvalue); break;
}
*(++stacktop) = value;
break;
}
case ARRAY_ASSIGNOP_SINGLE_:
{ /* use info on stack to assign value to array element.
stack: datastart index-values rexpr */
struct array *a;
REAL value=0.0,rhs;
int i,offset;
void *lvalue;
char *datastart;
a = get_name_arrayptr(node->op2.name_id,localstack,localbase);
rhs = *(stacktop--);
for ( i = 0 ; i < a->dim ; i++ )
{ int k = (int)stacktop[i+1-a->dim];
if ( k < 1 )
{ sprintf(errmsg,
"Array index %d of array %s is %d. Indexes start at 1.\n",
i+1,get_name_name(node->op2.name_id,localbase),k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2045,errmsg,RECOVERABLE);
}
if ( k > a->sizes[i] && (!(node->flags & IS_VIRTUAL_ATTR) ||(k > SDIM)) )
{ sprintf(errmsg,"Array index %d of array %s is %d; exceeds bound of %d.\n",
i+1,get_name_name(node->op2.name_id,localbase),k,a->sizes[i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2046,errmsg,RECOVERABLE);
}
}
for ( i = 1, offset = (int)stacktop[1-a->dim]-1 ; i < a->dim ; i++ )
{ offset *= a->sizes[i];
offset += (int)stacktop[i+1-a->dim]-1; /* 1-based indexing */
}
stacktop -= a->dim;
datastart = *(char**)(stacktop--);
lvalue = datastart + offset*a->itemsize;
switch ( a->datatype )
{ case REAL_TYPE: value = *(REAL*)(lvalue); break;
case INTEGER_TYPE: value = *(int*)(lvalue); break;
case UINT_TYPE: value = *(unsigned int*)(lvalue); break;
case SHORT_TYPE: value = *(short int*)(lvalue); break;
case USHORT_TYPE: value = *(unsigned short int*)(lvalue); break;
case LONG_TYPE: value = *(long int*)(lvalue); break;
case ULONG_TYPE: value = *(unsigned long int*)(lvalue); break;
case CHAR_TYPE: value = *(char*)(lvalue); break;
case UCHAR_TYPE: value = *(unsigned char*)(lvalue); break;
case PTR_TYPE: value = (unsigned long int)*(char**)(lvalue); break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: break;
default: value = *(int*)(lvalue); break;
}
switch ( node->op1.assigntype )
{
case ASSIGN_: value = rhs; break;
case PLUSASSIGN_: value += rhs; break;
case SUBASSIGN_: value -= rhs; break;
case MULTASSIGN_: value *= rhs; break;
case DIVASSIGN_:
if( rhs == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2564,errmsg,RECOVERABLE);
}
value /= rhs; break;
}
switch ( a->datatype )
{ case REAL_TYPE: *(REAL*)(lvalue) = value; break;
case INTEGER_TYPE: *(int*)(lvalue) = (int)value; break;
case UINT_TYPE: *(unsigned int*)(lvalue) = (unsigned int)value; break;
case CHAR_TYPE: *(char*)(lvalue) = (char)value; break;
case UCHAR_TYPE: *(unsigned char*)(lvalue) = (unsigned char)value; break;
case SHORT_TYPE: *(short*)(lvalue) = (short)value; break;
case USHORT_TYPE: *(unsigned short*)(lvalue) = (unsigned short)value; break;
case LONG_TYPE: *(long*)(lvalue) = (long)value; break;
case ULONG_TYPE: *(unsigned long*)(lvalue) = (unsigned long)value; break;
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
case ELEMENTID_TYPE: break;
default: *(int*)(lvalue) = (int)value; break;
}
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
break;
}
case ARRAY_ASSIGNOP_VERTEX_NORMAL_:
{ MAT2D(normal,MAXCOORD,MAXCOORD);
REAL mag;
int normcount;
element_id id;
/* pop datastarts off stack */
REAL *q = *(REAL**)(stacktop--); /* not actually used, just pops stack */
REAL *p = *(REAL**)(stacktop--);
struct array *alvalue = get_name_arrayptr(node->op2.name_id,localstack,localbase);
int count = ( alvalue->datacount < SDIM ) ? alvalue->datacount : SDIM;
if ( node[node->right].op1.localnum )
id = *(element_id*)get_localp(node[node->right].op1.localnum);
else id = q_id;
normcount = new_calc_vertex_normal(id,normal);
project_vertex_normals(id,normal,normcount);
mag = sqrt(SDIM_dot(normal[0],normal[0]));
if ( mag == 0.0 ) mag = 1;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] = normal[0][i]/mag;
break;
case PLUSASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] += normal[0][i]/mag;
break;
case SUBASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] -= normal[0][i]/mag;
break;
case MULTASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] *= normal[0][i]/mag;
break;
case DIVASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] /= normal[0][i]/mag;
break;
}
break;
}
case ARRAY_ASSIGNOP_EDGE_VECTOR_:
{ /* pop datastarts off stack */
element_id id;
REAL *q = *(REAL**)(stacktop--); /* not actually used, just pops stack */
REAL *p = *(REAL**)(stacktop--);
REAL v[MAXCOORD];
struct array *alvalue = get_name_arrayptr(node->op2.name_id,localstack,localbase);
int count = ( alvalue->datacount < SDIM ) ? alvalue->datacount : SDIM;
if ( node[node->right].op1.localnum )
id = *(element_id*)get_localp(node[node->right].op1.localnum);
else id = q_id;
get_edge_side(id,v);
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] = v[i];
break;
case PLUSASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] += v[i];
break;
case SUBASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] -= v[i];
break;
case MULTASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] *= v[i];
break;
case DIVASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] /= v[i];
break;
}
break;
}
case ARRAY_ASSIGNOP_FACET_NORMAL_:
{ /* pop datastarts off stack */
element_id id;
REAL *q = *((REAL**)stacktop--); /* not actually used, just pops stack */
REAL *p = *(REAL**)(stacktop--);
struct array *alvalue = get_name_arrayptr(node->op2.name_id,localstack,localbase);
int count = ( alvalue->datacount < SDIM ) ? alvalue->datacount : SDIM;
REAL v[MAXCOORD];
if ( node[node->right].op1.localnum )
id = *(element_id*)get_localp(node[node->right].op1.localnum);
else id = q_id;
get_facet_normal(id,v);
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] = v[i];
break;
case PLUSASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] += v[i];
break;
case SUBASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] -= v[i];
break;
case MULTASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] *= v[i];
break;
case DIVASSIGN_:
for ( i = 0 ; i < count ; i++ )
p[i] /= v[i];
break;
}
break;
}
case ARRAY_ASSIGNOP_ARRAY_:
{
struct array *alvalue= get_name_arrayptr(node->op2.name_id,localstack,localbase);
struct array *arvalue = get_name_arrayptr(node->op3.name_id,localstack,localbase);
int inx[100]; /* keep track of indices */
char *p,*q;
int j,k;
char *pspots[100],*qspots[100];
int pstride[100],qstride[100];
int minsize[100],lastsize;
/* Was checked in parser that the arrays have the same number
of indices, but might be different sizes. So do
intersection. */
/* pop datastarts off stack */
q = *(char**)(stacktop--);
p = *(char**)(stacktop--);
for ( i = 0 ; i < arvalue->dim ; i++ )
{ inx[i] = 0;
minsize[i] = arvalue->sizes[i] < alvalue->sizes[i] ?
arvalue->sizes[i] : alvalue->sizes[i] ;
pspots[i] = p;
qspots[i] = q;
}
if ( alvalue->dim >= 2 )
{
pstride[alvalue->dim-2] = alvalue->sizes[alvalue->dim-1]*alvalue->itemsize;
qstride[arvalue->dim-2] = arvalue->sizes[arvalue->dim-1]*arvalue->itemsize;
for ( i = arvalue->dim - 3 ; i >= 0 ; i-- )
{ pstride[i] = pstride[i+1]*alvalue->sizes[i+1];
qstride[i] = qstride[i+1]*arvalue->sizes[i+1];
}
}
lastsize = minsize[arvalue->dim-1];
do
{ /* do a row */
switch ( arvalue->datatype )
{ case REAL_TYPE:
{ REAL *pp = (REAL*)p;
REAL *qq = (REAL*)q;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++);
break;
}
}
break; /* end REAL_TYPE */
case INTEGER_TYPE:
{ int *pp = (int*)p;
int *qq = (int*)q;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++);
break;
}
break; /* end INTEGER_TYPE */
}
}
/* increment pointers */
for ( j = arvalue->dim-2 ; j >= 0 ; j-- )
{ pspots[j] += pstride[j];
qspots[j] += qstride[j];
if ( ++inx[j] < minsize[j] )
{ p = pspots[j];
q = qspots[j];
for ( k = j+1 ; k < alvalue->dim-1 ; k++ )
{ pspots[k] = p;
qspots[k] = q;
}
break;
}
inx[j] = 0 ;
}
} while ( j >= 0 );
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
break;
} /* end ARRAY_ASSIGNOP_ARRAY_ */
case ARRAY_ASSIGNOP_SCALAR_:
{
struct array *alvalue= get_name_arrayptr(node->op2.name_id,localstack,localbase);
REAL scalar = *(stacktop--);
char *p = *(char**)(stacktop--);
int lastsize = alvalue->datacount;
switch ( alvalue->datatype )
{ case REAL_TYPE:
{ REAL *pp = (REAL*)p;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = scalar;
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += scalar;
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= scalar;
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= scalar;
break;
case DIVASSIGN_:
if ( scalar == 0.0 )
{
sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),
"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(4677,errmsg,RECOVERABLE);
}
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= scalar;
break;
}
break; /* end REAL_TYPE */
}
case INTEGER_TYPE:
{ int intscalar = (int)floor(scalar);
int *pp = (int*)p;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = intscalar;
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += intscalar;
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= intscalar;
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = (int)(floor(*(int*)p) * scalar);
break;
case DIVASSIGN_:
if ( scalar == 0.0 )
kb_error(4678,"Division by zero.\n",RECOVERABLE);
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= (int)floor((*(int*)p) / scalar);
break;
}
}
break; /* end INTEGER_TYPE */
}
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
} /* end ARRAY_ASSIGNOP_SCALAR */
break;
case ARRAY_ASSIGNOP_S_X_A_:
{ struct array *alvalue= get_name_arrayptr(node->op2.name_id,localstack,localbase);
struct array *arvalue= get_name_arrayptr(node->op3.name_id,localstack,localbase);
int inx[100]; /* keep track of indices */
char *p,*q;
int j,k;
char *pspots[100],*qspots[100];
int pstride[100],qstride[100];
int minsize[100],lastsize;
REAL scalar;
/* Was checked in parser that the arrays have the same number
of indices, but might be different sizes. So do
intersection. */
/* pop datastarts off stack */
q = *(char**)(stacktop--);
scalar = *(stacktop--);
p = *(char**)(stacktop--);
for ( i = 0 ; i < arvalue->dim ; i++ )
{ inx[i] = 0;
minsize[i] = arvalue->sizes[i] < alvalue->sizes[i] ?
arvalue->sizes[i] : alvalue->sizes[i] ;
pspots[i] = p;
qspots[i] = q;
}
if ( alvalue->dim >= 2 )
{
pstride[alvalue->dim-2] = alvalue->sizes[alvalue->dim-1]*alvalue->itemsize;
qstride[arvalue->dim-2] = arvalue->sizes[arvalue->dim-1]*arvalue->itemsize;
for ( i = arvalue->dim - 3 ; i >= 0 ; i-- )
{ pstride[i] = pstride[i+1]*alvalue->sizes[i+1];
qstride[i] = qstride[i+1]*arvalue->sizes[i+1];
}
}
lastsize = minsize[arvalue->dim-1];
p = pspots[0];
q = qspots[0];
do
{ /* do a row */
switch ( arvalue->datatype )
{ case REAL_TYPE:
{ REAL *pp = (REAL*)p;
REAL *qq = (REAL*)q;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++)*scalar;
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++)*scalar;
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++)*scalar;
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++)*scalar;
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++)*scalar;
break;
}
break; /* end REAL_TYPE */
}
case INTEGER_TYPE:
{ int *pp = (int*)p;
int *qq = (int*)q;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = (int)floor(*(qq++)*scalar);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += (int)floor(*(qq++)*scalar);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= (int)floor(*(qq++)*scalar);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= (int)floor(*(qq++)*scalar);
break;
case DIVASSIGN_:
if ( scalar == 0.0 )
kb_error(4679,"Division by zero.\n",RECOVERABLE);
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= (int)floor(*(qq++)*scalar);
break;
}
break; /* end INTEGER_TYPE */
}
}
/* increment pointers */
for ( j = arvalue->dim-2 ; j >= 0 ; j-- )
{ pspots[j] += pstride[j];
qspots[j] += qstride[j];
if ( ++inx[j] < minsize[j] )
{ p = pspots[j];
q = qspots[j];
for ( k = j+1 ; k < alvalue->dim-1 ; k++ )
{ pspots[k] = p;
qspots[k] = q;
}
break;
}
inx[j] = 0 ;
}
} while ( j >= 0 );
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
break;
} /* end ARRAY_ASSIGNOP_S_X_A_ */
case ARRAY_ASSIGNOP_A_P_A_:
{
struct array *alvalue= get_name_arrayptr(node->op2.name_id,localstack,localbase);
struct array *arvalue= get_name_arrayptr(node->op3.name_id,localstack,localbase);
struct array *asvalue= get_name_arrayptr(node->op4.name_id,localstack,localbase);
int inx[100]; /* keep track of indices */
char *p,*q,*s;
int j,k;
char *pspots[100],*qspots[100],*sspots[100];
int pstride[100],qstride[100],sstride[100];
int minsize[100],lastsize;
/* Was checked in parser that the arrays have the same number
of indices, but might be different sizes. So do
intersection. */
/* pop datastarts off stack */
s = *(char**)(stacktop--);
q = *(char**)(stacktop--);
p = *(char**)(stacktop--);
for ( i = 0 ; i < arvalue->dim ; i++ )
{ inx[i] = 0;
minsize[i] = arvalue->sizes[i] < alvalue->sizes[i] ?
arvalue->sizes[i] : alvalue->sizes[i] ;
if ( minsize[i] > asvalue->sizes[i] )
minsize[i] = asvalue->sizes[i];
pspots[i] = p;
qspots[i] = q;
sspots[i] = s;
}
if ( alvalue->dim >= 2 )
{
pstride[alvalue->dim-2] = alvalue->sizes[alvalue->dim-1]*alvalue->itemsize;
qstride[arvalue->dim-2] = arvalue->sizes[arvalue->dim-1]*arvalue->itemsize;
sstride[asvalue->dim-2] = asvalue->sizes[asvalue->dim-1]*asvalue->itemsize;
for ( i = arvalue->dim - 3 ; i >= 0 ; i-- )
{ pstride[i] = pstride[i+1]*alvalue->sizes[i+1];
qstride[i] = qstride[i+1]*arvalue->sizes[i+1];
sstride[i] = sstride[i+1]*asvalue->sizes[i+1];
}
}
lastsize = minsize[arvalue->dim-1];
p = pspots[0];
q = qspots[0];
s = sspots[0];
do
{ /* do a row */
switch ( arvalue->datatype )
{ case REAL_TYPE:
{ REAL *pp = (REAL*)p;
REAL *qq = (REAL*)q;
REAL *ss = (REAL*)s;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++) + *(ss++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++) + *(ss++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++) + *(ss++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++) + *(ss++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++) + *(ss++);
break;
}
break; /* end REAL_TYPE */
}
case INTEGER_TYPE:
{ int *pp = (int*)p;
int *qq = (int*)q;
int *ss = (int*)s;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++) + *(ss++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++) + *(ss++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++) + *(ss++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++) + *(ss++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++) + *(ss++);
break;
}
break; /* end INTEGER_TYPE */
}
}
/* increment pointers */
for ( j = arvalue->dim-2 ; j >= 0 ; j-- )
{ pspots[j] += pstride[j];
qspots[j] += qstride[j];
sspots[j] += sstride[j];
if ( ++inx[j] < minsize[j] )
{ p = pspots[j];
q = qspots[j];
s = sspots[j];
for ( k = j+1 ; k < alvalue->dim-1 ; k++ )
{ pspots[k] = p;
qspots[k] = q;
sspots[k] = s;
}
break;
}
inx[j] = 0 ;
}
} while ( j >= 0 );
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
} /* end ARRAY_ASSIGNOP_A_P_A_ */
break;
case ARRAY_ASSIGNOP_A_S_A_:
{
struct array *alvalue= get_name_arrayptr(node->op2.name_id,localstack,localbase);
struct array *arvalue= get_name_arrayptr(node->op3.name_id,localstack,localbase);
struct array *asvalue= get_name_arrayptr(node->op4.name_id,localstack,localbase);
int inx[100]; /* keep track of indices */
char *p,*q,*s;
int j,k;
char *pspots[100],*qspots[100],*sspots[100];
int pstride[100],qstride[100],sstride[100];
int minsize[100],lastsize;
/* Was checked in parser that the arrays have the same number
of indices, but might be different sizes. So do
intersection. */
/* pop datastarts off stack */
s = *(char**)(stacktop--);
q = *(char**)(stacktop--);
p = *(char**)(stacktop--);
for ( i = 0 ; i < arvalue->dim ; i++ )
{ inx[i] = 0;
minsize[i] = arvalue->sizes[i] < alvalue->sizes[i] ?
arvalue->sizes[i] : alvalue->sizes[i] ;
if ( minsize[i] > asvalue->sizes[i] )
minsize[i] = asvalue->sizes[i];
pspots[i] = p;
qspots[i] = q;
sspots[i] = s;
}
if ( alvalue->dim >= 2 )
{
pstride[alvalue->dim-2] = alvalue->sizes[alvalue->dim-1]*alvalue->itemsize;
qstride[arvalue->dim-2] = arvalue->sizes[arvalue->dim-1]*arvalue->itemsize;
sstride[asvalue->dim-2] = asvalue->sizes[asvalue->dim-1]*asvalue->itemsize;
for ( i = arvalue->dim - 3 ; i >= 0 ; i-- )
{ pstride[i] = pstride[i+1]*alvalue->sizes[i+1];
qstride[i] = qstride[i+1]*arvalue->sizes[i+1];
sstride[i] = sstride[i+1]*asvalue->sizes[i+1];
}
}
lastsize = minsize[arvalue->dim-1];
p = pspots[0];
q = qspots[0];
s = sspots[0];
do
{ /* do a row */
switch ( arvalue->datatype )
{ case REAL_TYPE:
{ REAL *pp = (REAL*)p;
REAL *qq = (REAL*)q;
REAL *ss = (REAL*)s;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++) - *(ss++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++) - *(ss++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++) - *(ss++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++) - *(ss++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++) - *(ss++);
break;
}
break; /* end REAL_TYPE */
}
case INTEGER_TYPE:
{ int *pp = (int*)p;
int *qq = (int*)q;
int *ss = (int*)s;
switch ( node->op1.assigntype )
{ case ASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) = *(qq++) - *(ss++);
break;
case PLUSASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) += *(qq++) - *(ss++);
break;
case SUBASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) -= *(qq++) - *(ss++);
break;
case MULTASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) *= *(qq++) - *(ss++);
break;
case DIVASSIGN_:
for ( i = 0 ; i < lastsize ; i++ )
*(pp++) /= *(qq++) - *(ss++);
break;
}
break; /* end INTEGER_TYPE */
}
}
/* increment pointers */
for ( j = arvalue->dim-2 ; j >= 0 ; j-- )
{ pspots[j] += pstride[j];
qspots[j] += qstride[j];
sspots[j] += sstride[j];
if ( ++inx[j] < minsize[j] )
{ p = pspots[j];
q = qspots[j];
s = sspots[j];
for ( k = j+1 ; k < alvalue->dim-1 ; k++ )
{ pspots[k] = p;
qspots[k] = q;
sspots[k] = s;
}
break;
}
inx[j] = 0 ;
}
} while ( j >= 0 );
if ( node->flags & RECALC_NODE )
recalc_flag = 1;
}
break; /* end ARRAY_ASSIGNOP_A_S_A_ */
case PLUSASSIGN_:
case SUBASSIGN_:
case MULTASSIGN_:
case DIVASSIGN_:
case SET_GLOBAL_:
{ struct global *g = globals(node->op1.name_id);
REAL *x;
if ( g->flags & GLOB_LOCALVAR )
x = localstack + g->value.offset;
else if ( g->flags & ORDINARY_PARAM )
x = &g->value.real;
else
{ sprintf(errmsg, "Variable %s is read-only.\n",g->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3455,errmsg,WARNING);
break;
}
if ( g->flags & STRINGVAL )
{ if ( g->flags & GLOB_LOCALVAR )
myfree(*(char**)x);
else myfree(g->value.string);
g->flags &= ~STRINGVAL;
}
switch(node->type)
{
case SET_GLOBAL_: *x = *(stacktop--); break;
case PLUSASSIGN_: *x += *(stacktop--); break;
case SUBASSIGN_: *x -= *(stacktop--); break;
case MULTASSIGN_: *x *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2562,errmsg,RECOVERABLE);
}
*x /= *(stacktop--); break;
}
if ( g->flags & RECALC_PARAMETER )
recalc_flag = 1;
}
break;
case SET_PERM_GLOBAL_:
{ struct global *g = perm_globals(node->op1.name_id);
REAL *x;
if ( g->flags & STRINGVAL )
{ free(g->value.string); g->flags &= ~STRINGVAL; }
x = &g->value.real;
*x = *(stacktop--);
if ( g->flags & RECALC_PARAMETER )
recalc_flag = 1;
}
break;
/* end whole-array syntax */
case FINISHED:
if ( this_frame->flags & BASE_OF_EVAL )
{ /* want to exit from eval() */
goto the_exit;
}
else /* want to return within eval() */
{
if ( localbase && (localbase->flags & LL_HAS_ARRAY) )
{ /* de-allocate local array storage */
int n;
for ( n = 0 ; n < localbase->count ; n++ )
{ struct global *g = &(localbase->list[n].g);
if ( g->flags & ARRAY_PARAM )
{ struct array *a = *(struct array**)(newstack + g->value.offset);
if ( a ) temp_free((char*)a);
a = NULL;
}
}
}
return_value = *stacktop;
stacktop = (REAL*)this_frame;
stacktop--; /* since points to occupied spot */
node = this_frame->return_node;
td->frame_spot = this_frame->parent_frame_spot;
localstack = (REAL*)(this_frame+1);
PROF_EVAL_END(ex);
ex = this_frame->base_ex;
PROF_EVAL_START(ex);
localbase = ex->locals;
if ( ex->locals )
localcount = ex->locals->totalsize;
else localcount = 0;
}
break;
default:
other_stuff(node,&recalc_flag,
&update_display_flag,q_id,localstack,localbase);
break;
}
if ( breakflag )
{ switch ( breakflag )
{ case BREAKFULL:
{ sprintf(errmsg,"Command aborted due to user interrupt.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2073,errmsg, RECOVERABLE);
}
break;
case BREAKABORT:
{ sprintf(errmsg,"Command aborted.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3234,errmsg, RECOVERABLE_ABORT);
}
break;
case BREAKAFTERWARNING:
{ sprintf(errmsg,"Command aborted due to break_after_warning.\n");
kb_error(3109,errmsg, RECOVERABLE);
}
}
}
#ifdef _XXDEBUG
{ static int didwarn;
/* Check predicted stack alignment. There are circumstances when alignment
is not equal (e.g. skipping procedure bodies when assigning them,
so just check there is room. */
if ( (node[1].type != SETUP_FRAME_) &&
(stacktop > (REAL*)this_frame + FRAME_SPACE + localcount + node->stack_spot) )
{ sprintf(errmsg,"Intermediate stack misalignment after node type %d.\n",
node->type);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
if ( ! didwarn ) /* to prevent error cascade */
kb_error(2671,errmsg,WARNING);
didwarn = 1;
}
else didwarn = 0;
}
#endif
if ( td->stack_top < td->eval_stack )
kb_error(5243,"BAD EVAL STACK\n",RECOVERABLE);
if ( newstack[stackmax-1] != STACKMAGIC ) /* nearing overflow, so extend */
{ kb_error(3488,"Evaluation stack overflow.\n",RECOVERABLE);
}
}
the_exit:
if ( !params )
{ if ( web.counts_changed )
flush_counts();
if ( recalc_flag && autorecalc_flag ) recalc();
else if ( update_display_flag ) update_display();
}
PROF_EVAL_END(ex);
iterate_flag = old_flag;
if ( stacktop == (REAL*)this_frame + FRAME_SPACE + localcount )
{ /* Have return value on stack */
REAL retval = *(stacktop--);
stacktop = (REAL*)this_frame;
stacktop--; /* since points to occupied spot */
td->frame_spot = this_frame->parent_frame_spot;
return retval;
}
else if ( stacktop != (REAL*)this_frame + FRAME_SPACE + localcount - 1)
{
sprintf(errmsg,"Internal error: Stack misalignment by %d in eval()\n",
stacktop-(REAL*)this_frame-localcount-FRAME_SPACE+1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1298,errmsg, RECOVERABLE);
}
stacktop = (REAL*)this_frame;
stacktop--; /* since points to occupied spot */
td->frame_spot = this_frame->parent_frame_spot;
return 0.0;
} /* end eval() */
/************************************************************************
*
* function: flush_counts()
*
* purpose: print pending counts
*/
void flush_counts()
{
if ( web.counts_changed & fix_count_bit )
{ sprintf(msg,"Fixed: %d\n",web.fix_count); outstring(msg); }
if ( web.counts_changed & unfix_count_bit )
{ sprintf(msg,"Unfixed: %d\n",web.unfix_count); outstring(msg); }
if ( web.counts_changed & equi_count_bit )
{ sprintf(msg,"Edges equiangulated: %d\n",web.equi_count); outstring(msg); }
if ( web.counts_changed & edge_delete_count_bit )
{ sprintf(msg,"Edges deleted: %d\n",web.edge_delete_count); outstring(msg); }
if ( web.counts_changed & facet_delete_count_bit )
{ sprintf(msg,"Facets deleted: %d\n",web.facet_delete_count); outstring(msg); }
if ( web.counts_changed & edge_refine_count_bit )
{ sprintf(msg,"Edges refined: %d\n",web.edge_refine_count); outstring(msg); }
if ( web.counts_changed & facet_refine_count_bit )
{ sprintf(msg,"Facets refined: %d\n",web.facet_refine_count); outstring(msg); }
if ( web.counts_changed & vertex_dissolve_count_bit )
{ sprintf(msg,"Vertices dissolved: %d\n",web.vertex_dissolve_count); outstring(msg); }
if ( web.counts_changed & edge_dissolve_count_bit )
{ sprintf(msg, "Edges dissolved: %d\n",web.edge_dissolve_count); outstring(msg); }
if ( web.counts_changed & facet_dissolve_count_bit )
{ sprintf(msg,"Facets dissolved: %d\n",web.facet_dissolve_count); outstring(msg); }
if ( web.counts_changed & body_dissolve_count_bit )
{ sprintf(msg,"Bodies dissolved: %d\n",web.body_dissolve_count); outstring(msg); }
if ( web.counts_changed & edge_reverse_count_bit )
{ sprintf(msg, "Edges reversed: %d\n",web.edge_reverse_count); outstring(msg); }
if ( web.counts_changed & facet_reverse_count_bit )
{ sprintf(msg, "Facets reversed: %d\n",web.facet_reverse_count); outstring(msg); }
if ( web.counts_changed & vertex_pop_count_bit )
{ sprintf(msg,"Vertices popped: %d\n",web.vertex_pop_count); outstring(msg); }
if ( web.counts_changed & edge_pop_count_bit )
{ sprintf(msg,"Edges popped: %d\n",web.edge_pop_count); outstring(msg); }
if ( web.counts_changed & pop_tri_to_edge_count_bit )
{ sprintf(msg,"pop_tri_to_edge count: %d\n",web.pop_tri_to_edge_count); outstring(msg); }
if ( web.counts_changed & pop_edge_to_tri_count_bit )
{ sprintf(msg,"pop_edge_to_tri count: %d\n",web.pop_edge_to_tri_count); outstring(msg); }
if ( web.counts_changed & pop_quad_to_quad_count_bit )
{ sprintf(msg,"pop_quad_to_quad count: %d\n",web.pop_quad_to_quad_count); outstring(msg); }
if ( web.counts_changed & edgeswap_count_bit )
{ sprintf(msg,"Edges swapped: %d\n",web.edgeswap_count); outstring(msg); }
if ( web.counts_changed & t1_edgeswap_count_bit )
{ sprintf(msg,"T1 swaps: %d\n",web.t1_edgeswap_count); outstring(msg); }
web.counts_reported = ~0;
web.counts_changed = 0;
}
/************************************************************************
*
* function: reset_counts()
*
* purpose: set counts to 0 for event counts and profiling counts.
*/
void reset_counts()
{
web.equi_count = 0;
web.edge_delete_count = 0;
web.facet_delete_count = 0;
web.edge_refine_count = 0;
web.facet_refine_count = 0;
web.notch_count = 0;
web.vertex_dissolve_count = 0;
web.edge_dissolve_count = 0;
web.facet_dissolve_count = 0;
web.body_dissolve_count = 0;
web.edge_reverse_count = 0;
web.facet_reverse_count = 0;
web.vertex_pop_count = 0;
web.edge_pop_count = 0;
web.pop_tri_to_edge_count = 0;
web.pop_edge_to_tri_count = 0;
web.pop_quad_to_quad_count = 0;
web.where_count = 0;
web.edgeswap_count = 0;
web.fix_count = 0;
web.unfix_count = 0;
web.t1_edgeswap_count = 0;
web.notch_count = 0;
web.counts_reported = 0;
web.counts_changed = 0;
#ifdef PROFILING_ENABLED
{ int i;
for ( i = LOW_INST ; i < meth_inst_count ; i++ )
{ struct method_instance *mi = METH_INSTANCE(i);
mi->value_call_count = mi->grad_call_count = mi->hess_call_count = 0;
mi->value_elapsed_time = mi->grad_elapsed_time
= mi->hess_elapsed_time = 0.0;
}
for ( i = 0 ; i < 2 ; i++ )
{ element_setup_elapsed_time[i] = 0;
calc_quants_elapsed_time[i] = 0;
calc_quant_grads_elapsed_time[i] = 0;
calc_quant_hess_elapsed_time[i] = 0;
exparse_elapsed_time[i] = 0;
yyparse_elapsed_time[i] = 0;
yylex_elapsed_time[i] = 0;
kblex_elapsed_time[i] = 0;
hessian_solve_elapsed_time[i] = 0;
hessian_mul_elapsed_time[i] = 0;
hessian_AIJ_setup_elapsed_time[i] = 0;
hessian_constraint_setup_elapsed_time[i] = 0;
hessian_project_setup_elapsed_time[i] = 0;
hessian_factor_elapsed_time[i] = 0;
hessian_CHinvC_elapsed_time[i] = 0;
}
find_cpu_speed();
}
#endif
}
evolver-2.30c.dfsg/src/exprint.c 0000644 0001753 0001753 00000273671 11410765113 017072 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: exprint.c
*
* Purpose: To print user commands and functions in algebraic form
*
*/
#include "include.h"
#include "lex.h"
#include "ytab.h"
void check_room_left ARGS((size_t));
void print_quote ARGS((char*));
void linebreak ARGS((void));
void newline ARGS((void));
struct locallist_t *current_proc_locals[100];
int current_proc_depth;
char * assign_symbol ARGS((int));
char * assign_symbol (sym)
int sym;
{ switch ( sym )
{ case ASSIGN_: return ":=";
case PLUSASSIGN_: return "+=";
case SUBASSIGN_: return "-=";
case MULTASSIGN_: return "*=";
case DIVASSIGN_: return "/=";
}
return "";
}
/*****************************************************************
*
* Function print_express()
*
* Purpose: print expression in algebraic format
* Uses private working space, expanding as needed.
* Returns pointer to working space.
*
*/
static char *pos; /* current position in string */
static char vch;
static size_t strsize;
static char *strstart;
static char *linestart;
static int bracket_depth;
/* precedence levels for knowing how to parenthesize */
#define PREC_POW 50
#define PREC_UMINUS 45
#define PREC_MUL 40
#define PREC_DIV 40
#define PREC_ADD 35
#define PREC_SUB 35
#define PREC_COMP 30
#define PREC_NOT 25
#define PREC_AND 20
#define PREC_OR 15
#define PREC_COND 13
#define PREC_ASSIGN 10
#define PREC_ARG 0
/**************************************************************************
*
* Function: print_express()
*
* Purpose: Convert parse tree for expression to ASCII string in
* character array pos.
*/
char *print_express(node,c)
struct expnode *node; /* expression tree */
int c; /* character for parameters */
{
if ( !strstart ) /* for first time thru */
{ strsize = 200;
strstart = my_list_calloc(1,strsize,ETERNAL_BLOCK);
}
else strstart[0] = '\0';
linestart = pos = strstart;
vch = (char)c;
if ( !node || !node->root ) { strcpy(strstart,"{}"); return strstart;}
bracket_depth = 0;
current_proc_locals[0] = node->locals;
current_proc_depth = 0;
exprint_recur(node->root,0);
return strstart;
}
/**********************************************************************
*
* Function: linebreak()
*
* Purpose: Insert a linebreak when the line gets too long.
*/
#define INDENT 2
#define GOODLEN 75
#define MINLEN 30
void linebreak()
{ int i;
char *c,*cc;
char *minline = linestart + MINLEN;
int extra_indent = 0;
if ( pos - linestart < GOODLEN ) return;
cc = NULL;
/* search for end of quote, starting at end so don't break quote */
for ( c = pos-1 ; c != linestart ; c-- )
if ( *c == '"' ) { cc = (c[1] == ';') ? c+1 : c; break; }
if ( cc == NULL ) /* search for end bracket */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == '}' ) { cc = (c[1] == ';') ? c+1 : c; break; }
if ( cc == NULL ) /* scan back for handy ';' */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == ';' ) { cc = c; break; }
if ( cc == NULL ) /* just look for { */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == '{' ) { cc = c; break; }
if ( cc == NULL ) extra_indent = 2;
if ( cc == NULL ) /* just look for space */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == ' ' ) { cc = c; break; }
if ( cc == NULL ) /* just look for comma */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == ',' ) { cc = c; break; }
if ( cc == NULL ) /* just look for = */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == '=' ) { cc = c; break; }
if ( cc == NULL ) /* just look for logic signs */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( (*c == '&') || (*c == '%') )
{ cc = c; break; }
if ( cc == NULL ) /* just look for arithmetic signs */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( ((*c == '+') || (*c == '-')) && !(isalpha(c[-1]) && !isalpha(c[-2])))
{ cc = c; break; } /* don't split scientific notation */
if ( (cc == NULL) || (cc - linestart < GOODLEN/2) )
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( ((*c == '*') || (*c == '/')) && (c[1] != '=') && (c[1] != '*') )
{ cc = c; break; }
if ( cc == NULL ) /* just look for closing parenthesis */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == ')' ) { cc = c; break; }
if ( cc == NULL ) /* just look for opening parenthesis */
for ( c = linestart + GOODLEN ; c != minline ; c-- )
if ( *c == '(' ) { cc = c; break; }
/* Have break, so do split, with *cc as last character on old line */
if ( cc )
{ char *ch;
int bd = bracket_depth;
linestart = cc+3;
c = cc+1 ; while (*c == ' ' ) c++ ; /* skip spaces */
for ( ch = c ; ch < pos ; ch++ ) /* unwind bracket depth */
if ( *ch == '{' ) bd--;
else if ( *ch == '}' ) bd++;
pos = cc + 3 + INDENT*bd + extra_indent + strlen(c);
kb_memmove(cc+3+INDENT*bd+extra_indent,c,strlen(c));
cc[1] = (char)(bd ? ' ' : '\\');
cc[2] = '\n';
for ( i = 0 ; i < INDENT*bd + extra_indent ; i++ ) cc[i+3] = ' ';
*pos = 0;
}
else
{ if ( bracket_depth <= 0 ) *(pos++) = '\\';
*(pos++) = '\n';
linestart = pos;
for ( i = 0 ; i < INDENT*bracket_depth ; i++ ) *(pos++) = ' ';
*pos = 0;
}
}
/***************************************************************************
*
* function: newline()
*
* purpose: Begin a new line, suitably indented.
*/
void newline()
{
int i;
*(pos++) = '\n';
for ( i = 0 ; i < INDENT*bracket_depth ; i++ )
*(pos++) = ' ';
*pos = 0;
linestart = pos;
}
/**********************************************************************
*
* Function: check_room_left()
*
* Purpose: Keep print string from overflowing.
*/
void check_room_left(n)
size_t n; /* room needed */
{
/* check room remaining */
if ( (pos + n - strstart) > (int)strsize )
{ size_t len = pos - strstart;
size_t linespot = linestart - strstart;
strstart = my_list_realloc(strstart,strsize + 1000 + n,ETERNAL_BLOCK);
strsize += 1000 + n;
linestart = strstart + linespot;
pos = strstart + len;
}
}
void print_quote(c)
char *c;
{ check_room_left(strlen(c)+30);
convert_string(c,pos);
pos += strlen(pos);
}
/********************************************************************
*
* function: convert_string()
*
* purpose: convert string from internal to printable representation.
* Converts to C escapes, encloses in quotes.
*/
void convert_string(c,p)
char *c; /* source */
char *p; /* destination */
{
/* convert to C escape sequences */
*(p++) = '"';
if ( c )
for ( ; *c ; c++ )
switch ( *c )
{ case '\n': *(p++) = '\\'; *(p++) = 'n'; break;
case '\r': *(p++) = '\\'; *(p++) = 'r'; break;
case '\t': *(p++) = '\\'; *(p++) = 't'; break;
case '\b': *(p++) = '\\'; *(p++) = 'b'; break;
case '"': *(p++) = '\\'; *(p++) = 'q'; break;
case '\\': *(p++) = '\\'; *(p++) = '\\'; break;
default: *(p++) = *c;
}
*(p++) = '"';
*p = 0;
return;
}
/*************************************************************************
*
* function: exprint_recur()
*
* purpose: Convert node of parse tree to ASCII, recursively doing sons.
*/
void exprint_recur(node,prec_parent)
struct treenode *node;
int prec_parent; /* precedence level of parent, for parenthesizing */
{
struct treenode *nn;
struct extra *ex;
struct locallist_t *localbase = current_proc_locals[current_proc_depth];
check_room_left(1000);
/* insert some handy line breaks */
if ( (pos - linestart > GOODLEN) /* && (pos[-2] != ';') */ )
linebreak();
switch ( node->type )
{
case NOP_: return;
case NULLBLOCK_: sprintf(pos,"{}");pos+=2; return;
case NULLCMD_: return;
case BREAKPOINT_:
sprintf(pos,"breakpoint %s ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case UNSET_BREAKPOINT_:
if ( node->left )
{ sprintf(pos,"unset breakpoint %s ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
}
else
{ sprintf(pos,"unset breakpoints");
pos += strlen(pos);
}
return;
case SUPPRESS_WARNING_:
sprintf(pos,"suppress_warning "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case UNSUPPRESS_WARNING_:
sprintf(pos,"unsuppress_warning "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case KEYLOGFILE_:
sprintf(pos,"keylogfile "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case LOGFILE_:
sprintf(pos,"logfile "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case CMDLIST_:
exprint_recur(node+node->left,prec_parent);
if ( node->right )
{ sprintf(pos,"; "); pos += 2;
newline();
exprint_recur(node+node->right,prec_parent);
}
return;
case BACKQUOTE_START_: return;
case BACKQUOTE_END_:
exprint_recur(node+node->right,prec_parent); /* left was dummy */
return;
case TEXT_SPOT_:
exprint_recur(node+node->left,prec_parent);
*(pos++) = ',';
exprint_recur(node+node->right,prec_parent);
return;
case DISPLAY_TEXT_:
sprintf(pos,"display_text("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
*(pos++) = ',';
exprint_recur(node+node->right,prec_parent);
*(pos++) = ')';
return;
case DELETE_TEXT_:
sprintf(pos,"delete_text("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
*(pos++) = ')';
return;
case ACOMMANDEXPR_:
*(pos++) = '`'; /* surround with backquotes */
exprint_recur(node+node->left,prec_parent);
sprintf(pos,";`");
pos+=2; /* surround with backquotes; make sure of ; */
if ( node->right )
{ sprintf(pos,", "); pos += 2;
exprint_recur(node+node->right,prec_parent);
}
return;
case ATTR_FUNCTION_END_:
exprint_recur(node+node->left,prec_parent); /* define part */
strcat(pos," function {"); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* code part */
strcat(pos," } "); pos += strlen(pos);
return;
case ATTR_FUNCTION_:
exprint_recur(node+node->left,prec_parent); /* define part */
return;
case WRAP_VERTEX_:
strcat(pos,"wrap_vertex("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case CREATE_VERTEX_:
sprintf(pos,"new_vertex("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,")"); pos++;
return;
case CREATE_EDGE_:
sprintf(pos,"new_edge("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case CREATE_FACET_:
sprintf(pos,"new_facet("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,")"); pos++;
return;
case CREATE_BODY_:
sprintf(pos,"new_body"); pos += strlen(pos);
return;
case ELINDEX_:
exprint_recur(node+node->left,prec_parent);
if ( node->right )
{ *pos = '@'; pos++; *pos = 0;
exprint_recur(node+node->right,prec_parent);
}
return;
case PUSH_ELEMENT_ID_:
sprintf(pos,"%%sd@%d\n",(inverted(node->op1.id)?"-":""),
node->op1.id & OFFSETMASK, id_task(node->op1.id));
pos += strlen(pos);
return;
case VALID_ELEMENT_:
sprintf(pos,"valid_element(%s[",typenames[node->op1.eltype]);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,"])"); pos+=2;
return;
case VALID_CONSTRAINT_:
sprintf(pos,"valid_constraint(");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,")"); pos+=1;
return;
case VALID_BOUNDARY_:
sprintf(pos,"valid_boundary(");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,")"); pos+=1;
return;
case MATRIX_INVERSE_:
sprintf(pos,"matrix_inverse(%s,%s)",
globals(node->op1.name_id)->name,globals(node->op2.name_id)->name);
pos += strlen(pos);
return;
case MATRIX_MULTIPLY_:
sprintf(pos,"matrix_multiply(%s,%s,%s)",
globals(node->op1.name_id)->name,globals(node->op2.name_id)->name,
globals(node->op3.name_id)->name);
pos += strlen(pos);
return;
case MATRIX_DETERMINANT_:
sprintf(pos,"matrix_determinant(%s)",
globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case MERGE_VERTEX_:
sprintf(pos,"vertex_merge("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case MERGE_EDGE_:
sprintf(pos,"edge_merge("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case MERGE_FACET_:
sprintf(pos,"facet_merge("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case COMMAND_BLOCK_:
sprintf(pos,"{ "); pos+=2; bracket_depth++;
exprint_recur(node+node->left,prec_parent);
bracket_depth--;
newline();
sprintf(pos,"}"); pos++;
return;
case LOCAL_LIST_START_:
sprintf (pos,"local ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case DECLARE_LOCAL_:
{
if ( node->left )
{
exprint_recur(node+node->left,0);
*pos = ','; pos++;
}
sprintf (pos,"%s",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
}
case DEFINE_QUANTITY_:
{ struct gen_quant *g = GEN_QUANT(node->op1.quant_id);
sprintf(pos,"/* Definition of quantity %s was originally here.*/",
g->name);
pos += strlen(pos);
return;
}
case DEFINE_METHOD_INSTANCE_:
{ struct method_instance *mi = METH_INSTANCE(node->op1.meth_id);
sprintf(pos,
"/* Definition of method instance %s was originally here.*/",
mi->name);
pos += strlen(pos);
return;
}
case DEFINE_CONSTRAINT_:
{ struct constraint *con = get_constraint(node->op1.con_id);
if ( con->attr & NAMED_THING )
sprintf(pos,
"/* Definition of constraint %s was originally here.*/",
con->name);
else
sprintf(pos,
"/* Definition of constraint %d was originally here.*/",
node->op1.con_id);
pos += strlen(pos);
return;
}
case DEFINE_BOUNDARY_:
{ struct boundary *bdry = web.boundaries+node->op1.bdry_id;
if ( bdry->attr & NAMED_THING )
sprintf(pos,
"/* Definition of boundary %s was originally here.*/",
bdry->name);
else
sprintf(pos,
"/* Definition of boundary %d was originally here.*/",
node->op1.con_id);
pos += strlen(pos);
return;
}
case DEFINE_EXTRA_:
ex = EXTRAS(node->op2.eltype)+node->op1.extranum;
sprintf(pos,"define %s attribute %s %s",
typenames[node->op2.eltype],ex->name, datatype_name[ex->type]);
pos += strlen(pos);
if ( ex->code.start )
{ strcat(pos," function "); pos += strlen(pos);
/*current_proc_locals[++current_proc_depth] = ex->locals;*/
exprint_recur(ex->code.root,prec_parent);
/*current_proc_depth--;*/
}
break;
case DEFINE_EXTRA_INDEX_:
exprint_recur(node+node->left,prec_parent);
exprint_recur(node+node->right,prec_parent);
break;
case DEFINE_ARRAY_:
sprintf(pos,"define %s %s",globals(node->op1.name_id)->name,
datatype_name[node->op2.valtype]);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case DEFINE_FIXED_LOCAL_ARRAY_:
{ struct global *g = globals(node->op1.name_id);
struct array *a = g->attr.arrayptr;
int i;
sprintf(pos,"define %s %s",g->name,
datatype_name[node->op2.valtype]);
pos += strlen(pos);
for ( i = 0 ; i < a->dim ; i++ )
{ sprintf(pos,"[%d]",a->sizes[i]);
pos += strlen(pos);
}
}
break;
case ARRAY_EVAL_:
exprint_recur(node+node->left,prec_parent);
exprint_recur(node+node->right,prec_parent);
break;
case ARRAY_HEAD_:
exprint_recur(node+node->left,prec_parent);
break;
case ARRAYASSIGN:
sprintf(pos,"%s",globals(node->op2.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
switch ( node->op1.assigntype )
{ case ASSIGN_: sprintf(pos," := "); break;
case PLUSASSIGN_: sprintf(pos," += "); break;
case SUBASSIGN_: sprintf(pos," -= "); break;
case MULTASSIGN_: sprintf(pos," *= "); break;
case DIVASSIGN_: sprintf(pos," /= "); break;
}
pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
break;
case ARRAYEVAL:
sprintf(pos,"%s",globals(node->op2.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
/* whole-array syntax */
case ARRAYIDENT_:
sprintf(pos,"%s",get_name_name(node->op2.name_id,localbase));
pos += strlen(pos);
break;
case ARRAY_ASSIGNOP_FACET_NORMAL_:
case ARRAY_ASSIGNOP_EDGE_VECTOR_ :
case ARRAY_ASSIGNOP_VERTEX_NORMAL_:
case ARRAY_ASSIGNOP_ARRAY_ :
case ARRAY_ASSIGNOP_SCALAR_ :
case ARRAY_ASSIGNOP_S_X_A_:
case ARRAY_ASSIGNOP_A_P_A_:
case ARRAY_ASSIGNOP_A_S_A_:
exprint_recur(node+node->left,prec_parent);
if ( !(node->flags & SET_ASSIGNOP) )
{
switch ( node->op1.assigntype )
{ case ASSIGN_: sprintf(pos," := "); break;
case PLUSASSIGN_: sprintf(pos," += "); break;
case SUBASSIGN_: sprintf(pos," -= "); break;
case MULTASSIGN_: sprintf(pos," *= "); break;
case DIVASSIGN_: sprintf(pos," /= "); break;
}
pos += strlen(pos);
}
exprint_recur(node+node->right,prec_parent);
break;
case ARRAY_ASSIGNOP_SINGLE_:
exprint_recur(node+node->left,prec_parent);
if ( !(node->flags & SET_ASSIGNOP) )
{
switch ( node->op1.assigntype )
{ case ASSIGN_: sprintf(pos," := "); break;
case PLUSASSIGN_: sprintf(pos," += "); break;
case SUBASSIGN_: sprintf(pos," -= "); break;
case MULTASSIGN_: sprintf(pos," *= "); break;
case DIVASSIGN_: sprintf(pos," /= "); break;
}
pos += strlen(pos);
}
else
{ *pos = '('; *(++pos) = 0; /* avoid - after ] */}
exprint_recur(node+node->right,prec_parent);
if ( node->flags & SET_ASSIGNOP )
{ *pos = ')'; *(++pos) = 0; }
break;
case DOT_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos," dot_product ");
pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
break;
case ARRAY_LVALUE_INDEXED_:
exprint_recur(node+node->left,prec_parent);
exprint_recur(node+node->right,prec_parent);
*pos = ' '; *(++pos) = 0;
break;
case PRINT_ARRAY_LVALUE_:
sprintf(pos,"print ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case ATTRIB_LVALUE_:
case ARRAY_VERTEX_NORMAL_:
case ARRAY_EDGE_VECTOR_:
case ARRAY_FACET_NORMAL_:
if ( node->left )
{ exprint_recur(node+node->left,prec_parent);
/* sprintf(pos," %s",get_name_name(node->op2.name_id,localbase)); */
}
if ( node->op1.localnum == 0)
sprintf(pos," %s",get_name_name(node->op2.name_id,localbase));
else
sprintf(pos,".%s",get_name_name(node->op2.name_id,localbase));
pos += strlen(pos);
break;
case ARRAY_RVALUE_:
exprint_recur(node+node->left,PREC_MUL);
sprintf(pos," %c ",node->op1.intval);
pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
break;
/* end whole-array syntax */
case SET_CONSTRAINT_GLOBAL:
strcat(pos,"set constraint "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos," global "); pos += strlen(pos);
break;
case UNSET_CONSTRAINT_GLOBAL:
strcat(pos,"unset constraint "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos," global "); pos += strlen(pos);
break;
case SET_CONSTRAINT_NAME_GLOBAL:
sprintf(pos,"set constraint %s global",
get_constraint(node->op3.connum)->name);
pos += strlen(pos);
break;
case UNSET_CONSTRAINT_NAME_GLOBAL:
sprintf(pos,"unset constraint %s global",
get_constraint(node->op3.connum)->name);
pos += strlen(pos);
break;
case RESET_COUNTS_:
strcat(pos,"reset_counts"); pos += strlen(pos);
return;
case FLUSH_COUNTS_:
strcat(pos,"flush_counts"); pos += strlen(pos);
return;
case PRINT_PROFILING_:
strcat(pos,"print profiling"); pos += strlen(pos);
return;
case RESET_PROFILING_:
strcat(pos,"reset_profiling"); pos += strlen(pos);
return;
case PAUSE_:
strcat(pos,"pause"); pos += strlen(pos);
return;
case RETURN_:
strcat(pos,"return "); pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent);
return;
case DATE_AND_TIME_:
strcat(pos,"date_and_time"); pos += strlen(pos);
return;
case BREAK_:
if ( node->op2.breakdepth > 1 )
sprintf(pos,"break %d",node->op2.breakdepth);
else strcat(pos,"break ");
pos += strlen(pos);
return;
case CONTINUE_:
if ( node->op2.breakdepth > 1 )
sprintf(pos,"continue %d",node->op2.breakdepth);
else strcat(pos,"continue ");
pos += strlen(pos);
return;
case HISTORY_:
strcat(pos,"history "); pos += strlen(pos);
return;
case GET_TRANSFORM_EXPR_:
strcat(pos,"transform_expr "); pos += strlen(pos);
return;
case WARNING_MESSAGES_:
strcat(pos,"warning_messages "); pos += strlen(pos);
return;
case DATAFILENAME_:
strcat(pos,"datafilename "); pos += strlen(pos);
return;
case REPEAT_:
exprint_recur(node+node->right,prec_parent);
nn = node + node->left;
exprint_recur(nn+nn->left,prec_parent);
return;
case EXPRLIST_:
exprint_recur(node+node->left,prec_parent);
if ( node->right )
{ sprintf(pos,", "); pos += 2;
exprint_recur(node+node->right,prec_parent);
}
return;
case QUOTATION_:
print_quote(node->op1.string);
return;
case SPRINTFHEAD_:
case PRESPRINTF_:
sprintf(pos,"sprintf ");
pos += strlen(pos);
if ( node->op1.string ) print_quote(node->op1.string);
else exprint_recur(node+node->left,prec_parent);
return;
case PREPRINTF_:
case PRINTFHEAD_:
sprintf(pos,"printf ");
pos += strlen(pos);
if ( node->op1.string ) print_quote(node->op1.string);
else exprint_recur(node+node->left,prec_parent);
return;
case ERRPRINTFHEAD_:
sprintf(pos,"errprintf ");
pos += strlen(pos);
if ( node->op1.string ) print_quote(node->op1.string);
else exprint_recur(node+node->left,prec_parent);
return;
case BINARY_PRINTFHEAD_:
sprintf(pos,"binary_printf ");
pos += strlen(pos);
if ( node->op1.string ) print_quote(node->op1.string);
else exprint_recur(node+node->left,prec_parent);
return;
case PRINTF_:
case BINARY_PRINTF_:
case ERRPRINTF_:
case SPRINTF_:
exprint_recur(node+node->left,prec_parent);
strcat(pos++,",");
exprint_recur(node+node->right,prec_parent);
return;
case STRPRINT_:
case PRINT_:
case EPRINT_:
sprintf(pos,"print "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case PRINT_LETTER_:
sprintf(pos,"print %c ",node->op1.name_id);
pos += strlen(pos);
return;
case PRINT_PROCEDURE_:
case PRINT_ARRAY_:
sprintf(pos,"print %s ",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case PRINT_ARRAYPART_:
sprintf(pos,"print %s",globals(node[node->left].op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case PRINT_VERTEXNORMAL_:
sprintf(pos,"print ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,".vertexnormal");
pos += strlen(pos);
return;
case PRINT_ATTR_ARRAY_:
sprintf(pos,"print ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".%s",EXTRAS(node->op2.eltype)[node->op3.extranum].name);
pos += strlen(pos);
if ( node->right )
exprint_recur(node+node->right,prec_parent);
return;
case PRINT_PERM_PROCEDURE_:
sprintf(pos,"print %s ",perm_globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case EXPRINT_PROCEDURE_:
sprintf(pos,"exprint %s ",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case ELSE_: /* root of IF */
exprint_recur(node+node->left,prec_parent); /* IF part */
if ( node->right )
{ sprintf(pos," else "); pos += strlen(pos);
newline();
exprint_recur(node+node->right,prec_parent); /* command */
}
bracket_depth--;
return;
case IF_:
exprint_recur(node+node->left,prec_parent); /* IF part */
exprint_recur(node+node->right,prec_parent); /* command */
return;
case IFTEST_:
sprintf(pos,"if ( "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* expr */
sprintf(pos," ) then "); pos += strlen(pos);
bracket_depth++;
newline();
return;
case WHILE_END_:
exprint_recur(node+node->left,prec_parent); /* test part */
sprintf(pos," do "); pos += strlen(pos);
bracket_depth++;
if ( node->right )
{ newline();
exprint_recur(node+node->right,prec_parent); /* command */
} else
{ strcat(pos," ;"); pos += strlen(pos); }
bracket_depth--;
return;
case WHILE_TOP_:
sprintf(pos,"while ("); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* expr */
strcat(pos,") "); pos += strlen(pos);
return;
case DO_TOP_:
exprint_recur(node+node->right,prec_parent); /* command */
return;
case DO_END_:
sprintf(pos,"do "); pos += strlen(pos);
bracket_depth++;
newline();
exprint_recur(node+node->left,prec_parent); /* command */
bracket_depth--;
newline();
sprintf(pos," while ("); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* expr */
strcat(pos,") "); pos += strlen(pos);
return;
case FOR_END_:
sprintf(pos,"for ( "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* FOR_TOP_ */
sprintf(pos," ) "); pos += strlen(pos);
bracket_depth++;
newline();
if ( node->right )
exprint_recur(node+node->right,prec_parent); /* command3 */
else { strcat(pos," ;") ; pos += strlen(pos); } /* empty command3 */
bracket_depth--;
newline();
return;
case FOR_TOP_:
exprint_recur(node+node->left,prec_parent); /* FOR_HEAD_ */
sprintf(pos," ; "); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* command2 */
return;
case FOR_HEAD_:
exprint_recur(node+node->left,prec_parent); /* FOR_ENTRY */
sprintf(pos," ; "); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* expr */
return;
case FOR_ENTRY_:
exprint_recur(node+node->left,prec_parent); /* command1 */
return;
case REDIRECT_:
if ( node->left )
{ strcat(pos,">> "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* command */
}
else
sprintf(pos,">> \"%s\" ",node->op1.string); pos += strlen(pos);
return;
case REDIRECTOVER_:
if ( node->left )
{ strcat(pos,">>> "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* command */
}
else
sprintf(pos,">>> \"%s\" ",node->op1.string); pos += strlen(pos);
return;
case PIPE_:
if ( node->left )
{ strcat(pos,"| "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent); /* command */
}
else
sprintf(pos,"| \"%s\" ",node->op1.string); pos += strlen(pos);
return;
case PIPE_END_:
case REDIRECT_END_:
exprint_recur(node+node->right,prec_parent); /* command */
exprint_recur(node+node->left,prec_parent); /* pipe */
return;
case SINGLE_REDEFD_:
sprintf(pos,"%c ",node->op1.letter);
pos += strlen(pos);
return;
case SINGLE_LETTER_:
if ( single_redefine[node->op1.letter].start )
sprintf(pos,"'%c' ",node->op1.letter);
else sprintf(pos,"%c ",node->op1.letter);
pos += strlen(pos);
return;
/* toggles */ case QUIETGO_: case QUIETLOAD_: case SLICE_VIEW_:
case CLIP_VIEW_: case STAR_FINAGLING_: case FORCE_DELETION_:
case KUSNER_: case ESTIMATE_: case DETURCK_: case HOMOTHETY_:
case SQGAUSS_: case AUTOPOP_: case AUTOCHOP_: case QUIET_:
case OLD_AREA_: case APPROX_CURV_: case RUNGE_KUTTA_:
case CHECK_INCREASE_: case DEBUG_: case MEAN_CURV_: case RIBIERE_CG_:
case DIFFUSION_: case GRAVITY_: case CONJ_GRAD_: case TRANSFORMS_:
case CONF_EDGE_SQCURV_: case EFFECTIVE_AREA_: case AREA_FIXED_:
case RAW_CELLS_: case CONNECTED_CELLS_: case CLIPPED_CELLS_:
case THICKEN_: case SHOW_INNER_: case SHOW_OUTER_: case COLORMAP_:
case HESSIAN_DIFF_: case POST_PROJECT_: case MEAN_CURV_INT_:
case OPTIMIZE_: case NORMAL_CURVATURE_: case DIV_NORMAL_CURVATURE_:
case SHADING_: case FACET_COLORS_: case BOUNDARY_CURVATURE_:
case NORMAL_MOTION_: case PINNING_: case VIEW_4D_: case MEMDEBUG_:
case METRIC_CONVERSION_: case AUTORECALC_: case GV_BINARY_:
case SELF_SIMILAR_: case AUTODISPLAY_: case FORCE_POS_DEF_:
case ASSUME_ORIENTED_: case HESSIAN_QUIET_: case JIGGLE_TOGGLE_:
case HESSIAN_NORMAL_: case YSMP_: case BUNCH_KAUFMAN_:
case QUANTITIES_ONLY_: case LINEAR_METRIC_:
case SQUARED_GRADIENT_: case H_INVERSE_METRIC_:
case HESSIAN_DOUBLE_NORMAL_: case INTERP_BDRY_PARAM_:
case HESSIAN_NORMAL_ONE_: case PSCOLORFLAG_: case GRIDFLAG_:
case CROSSINGFLAG_: case LABELFLAG_: case SHOW_ALL_QUANTITIES_:
case HESSIAN_NORMAL_PERP_: case HESSIAN_SPECIAL_NORMAL_: case ITDEBUG_:
case METIS_FACTOR_: case VOLGRADS_EVERY_: case ZENER_DRAG_:
case BACKCULL_: case INTERP_NORMALS_: case TORUS_FILLED_: case VERBOSE_:
case AMBIENT_PRESSURE_: case DIRICHLET_MODE_: case SOBOLEV_MODE_:
case KRAYNIKPOPVERTEX_FLAG_: case FUNCTION_QUANTITY_SPARSE_:
case KRAYNIKPOPEDGE_FLAG_: case VISIBILITY_TEST_: case SPARSE_CONSTRAINTS_:
case BLAS_FLAG_: case AUGMENTED_HESSIAN_: case BREAK_AFTER_WARNING_:
case RGB_COLORS_FLAG_: case CIRCULAR_ARC_DRAW_: case BEZIER_BASIS_:
case SMOOTH_GRAPH_: case MPI_DEBUG_: case POP_DISJOIN_:
case POP_TO_EDGE_: case POP_TO_FACE_: case POP_ENJOIN_:
case FULL_BOUNDING_BOX_: case BIG_ENDIAN_: case LITTLE_ENDIAN_:
case AUTOPOP_QUARTIC_: case IMMEDIATE_AUTOPOP_:
sprintf(pos,"%s %s ",keywordname(node->type),
node->op1.toggle_state==ON_?"ON":"OFF"); pos += strlen(pos);
break;
case LOGFILE_TOGGLE_:
sprintf(pos,"logfile %s ",
node->op1.toggle_state==ON_?"ON":"OFF"); pos += strlen(pos);
break;
case KEYLOGFILE_TOGGLE_:
sprintf(pos,"keylogfile %s ",
node->op1.toggle_state==ON_?"ON":"OFF"); pos += strlen(pos);
break;
case GEOMVIEW_TOGGLE_:
sprintf(pos,"geomview %s ",
node->op1.toggle_state==ON_?"ON":"OFF"); pos += strlen(pos);
break;
case GEOMPIPE_TOGGLE_:
sprintf(pos,"geompipe %s ",
node->op1.toggle_state==ON_?"ON":"OFF"); pos += strlen(pos);
break;
case GEOMPIPE_:
sprintf(pos,"geompipe "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case POSTSCRIPT_:
sprintf(pos,"postscript "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case BINARY_OFF_FILE_:
sprintf(pos,"binary_off_file "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case OOGLFILE_:
sprintf(pos,"ooglfile "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case TOGGLEVALUE:
sprintf(pos,"(%s) ",keywordname(node->op1.toggle_id));
pos += strlen(pos);
break;
case GET_INTERNAL_:
sprintf(pos,"%s",keywordname(node->op1.name_id));
pos += strlen(pos);
break;
case PROCEDURE_:
sprintf(pos,"%s ",globals(node->op1.name_id)->name);
pos += strlen(pos);
break;
case PERM_PROCEDURE_:
sprintf(pos,"%s ",perm_globals(node->op1.name_id)->name);
pos += strlen(pos);
break;
case FIX_PARAMETER_:
sprintf(pos,"fix %s",globals(node->op1.name_id)->name);
pos += strlen(pos);
break;
case UNFIX_PARAMETER_:
sprintf(pos,"unfix %s",globals(node->op1.name_id)->name);
pos += strlen(pos);
break;
case FIX_QUANTITY_:
sprintf(pos,"fix %s",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case UNFIX_QUANTITY_:
sprintf(pos,"unfix %s",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case SET_Q_FIXED_:
sprintf(pos,"set %s fixed",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case SET_Q_ENERGY_:
sprintf(pos,"set %s energy",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case SET_Q_INFO_:
sprintf(pos,"set %s info_only",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case SET_Q_CONSERVED_:
sprintf(pos,"set %s conserved",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case SET_INTERNAL_:
sprintf(pos,"%s %s ",keywordname(node->op1.name_id),
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case VIEW_MATRIX_LVALUE_:
sprintf(pos,"view_matrix["); pos += strlen("view_matrix[");
exprint_recur(node+node->left,prec_parent);
sprintf(pos,"]["); pos += 2;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,"]"); pos += 1;
break;
case SET_VIEW_MATRIX_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos," := "); pos += 4;
exprint_recur(node+node->right,prec_parent);
break;
case SET_SCALE_:
sprintf(pos,"m "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_OPTIMIZE_:
sprintf(pos,"optimize "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_FIXED_AREA_:
sprintf(pos,"area_fixed := "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_GAP_CONSTANT_:
sprintf(pos,"gap_constant := "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SKINNY_:
sprintf(pos,"K "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case TORDUP_:
sprintf(pos,"y "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_MODEL_:
sprintf(pos,"M "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case INVOKE_P_MENU_:
sprintf(pos,"P "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_GRAVITY_:
switch ( node->op1.assigntype )
{ case ASSIGN_: sprintf(pos,"G "); break;
case PLUSASSIGN_: sprintf(pos,"gravity += "); break;
case SUBASSIGN_: sprintf(pos,"gravity -= "); break;
case MULTASSIGN_: sprintf(pos,"gravity *= "); break;
case DIVASSIGN_: sprintf(pos,"gravity /= "); break;
}
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_DIFFUSION_:
sprintf(pos,"diffusion := "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_THICKEN_:
sprintf(pos,"thicken := "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_AUTOCHOP_:
sprintf(pos,"autochop := "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_AMBIENT_PRESSURE_:
sprintf(pos,"p "); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case ZOOM_:
sprintf(pos,"zoom "); pos+=strlen(pos);
if ( node->left )
{ exprint_recur(node+node->left,prec_parent);
exprint_recur(node+node->right,prec_parent);
}
break;
case CHDIR_:
case SYSTEM_:
case EXEC_: case PARALLEL_EXEC_:
case READ_:
case LOAD_:
case PERMLOAD_:
case ADDLOAD_:
case SHOW_TRANS_:
case TRANSFORM_EXPR_:
case GEOMVIEW_:
sprintf(pos,"%s ",keywordname(node->type));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case TASK_EXEC_:
sprintf(pos,"%s ",keywordname(node->type));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
*pos = ','; pos++;
exprint_recur(node+node->right,prec_parent);
break;
case VIEW_TRANSFORM_PARITY_:
strcat(pos,"view_transform_parity["); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]"); pos++;
break;
case VIEW_TRANSFORM_SWAP_COLORS_:
strcat(pos,"view_transform_swap_colors["); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]"); pos++;
break;
case VIEW_TRANSFORMS_NOP_:
strcat(pos,"view_transforms["); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]["); pos += 2;
exprint_recur(node+node->right,prec_parent);
break;
case VIEW_TRANSFORMS_ELEMENT_:
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]["); pos += 2;
exprint_recur(node+node->right,prec_parent);
*(pos++) = ']';
break;
case IS_DEFINED_:
sprintf(pos,"is_defined(");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
*(pos++) = ')';
break;
case DUMP_:
sprintf(pos,"dump ");
pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent);
break;
case SET_COLORMAP_:
sprintf(pos,"colormap := ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SHOW_VOL_: case CHECK_: case LONG_JIGGLE_: case RAW_VERAVG_:
case STABILITY_TEST_: case UTEST_: case GO_: case SHELL_:
case ALICE_: case RECALC_: case COUNTS_: case RAWEST_VERAVG_:
case EXTRAPOLATE_: case LINEAR_: case QUADRATIC_: case REBODY_:
case HESSIAN_: case SHOWQ_: case CLOSE_SHOW_: case HESSIAN_MENU_:
case DIRICHLET_: case SOBOLEV_: case REORDER_STORAGE_:
case DIRICHLET_SEEK_: case SOBOLEV_SEEK_: case CONVERT_TO_QUANTS_:
case RENUMBER_ALL_: case DUMP_MEMLIST_: case FREE_DISCARDS_:
case REPARTITION_: case SUBCOMMAND_: case ABORT_:
case SIMPLEX_TO_FE_:
sprintf(pos,"%s ",keywordname(node->type)); pos+=strlen(pos);
break;
case BURCHARD_:
sprintf(pos,"%s %d ",keywordname(node->type),node->op1.maxsteps);
pos+=strlen(pos);
break;
case SHOW_END_:
if ( node[node->left].type == SHOW_ )
sprintf(pos,"show_expr "); /* prevent extraneous shows from dump */
else sprintf(pos,"show_expr ");
pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
break;
case SET_PROC_END_:
{ struct global *g = globals(node[node->left].op1.name_id);
if ( node[node->left].type == REDEFINE_SINGLE_ )
sprintf(pos,"%c :::= ",node[node->left].op1.letter);
else if ( g->flags & PERMANENT )
sprintf(pos,"%s ::= ",g->name);
else sprintf(pos,"%s := ",g->name);
pos += strlen(pos);
if ( node[node->right].type != COMMAND_BLOCK_ )
{ strcat(pos,"{"); pos++; }
current_proc_locals[++current_proc_depth] = g->value.proc.locals;
exprint_recur(node+node->right,prec_parent);
current_proc_depth--;
if ( node[node->right].type != COMMAND_BLOCK_ )
{ strcat(pos,"}"); pos++; }
break;
}
case SET_PERM_PROC_END_:
sprintf(pos,"%s ::= ",perm_globals(node[node->left].op1.name_id)->name);
pos += strlen(pos);
if ( node[node->right].type != COMMAND_BLOCK_ )
{ strcat(pos,"{"); pos++; }
exprint_recur(node+node->right,prec_parent);
if ( node[node->right].type != COMMAND_BLOCK_ )
{ strcat(pos,"}"); pos++; }
break;
case ARGLIST_:
{ struct global *g;
if ( node->op1.name_id == 0 ) break; /* empty list */
g = globals(node->op1.name_id);
if ( node->left )
{ exprint_recur(node+node->left,prec_parent); /* arglist */
strcat(pos,","); pos++;
}
sprintf(pos,"%s %s",datatype_name[node->op3.argtype],g->name);
pos += strlen(pos);
break;
}
case FUNCTION_CALL_:
{ struct global *g = globals(node->op1.name_id);
sprintf(pos,"%s(",g->name);
pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent); /* arglist */
strcat(pos,")"); pos++;
break;
}
case FUNCTION_CALL_RETURN_:
exprint_recur(node+node->left,prec_parent); /* FUNCTION_CALL_ */
break;
case FUNCTION_START_: break;
case FUNCTION_DEF_START_: break;
case FUNCTION_PROTO_START_: break;
case FUNCTION_HEAD_:
exprint_recur(node+node->right,prec_parent); /* arglist */
break;
case SET_FUNCTION_:
case FUNCTION_PROTO_:
{ struct global *g = globals(node[node->left].op1.name_id);
sprintf(pos,"function %s %s (",datatype_name[node->op4.ret_type],
g->name);
pos += strlen(pos);
current_proc_locals[++current_proc_depth] = g->value.proc.locals;
exprint_recur(node+node->left,prec_parent); /* arglist */
if ( node->type == SET_FUNCTION_ )
{ strcat(pos,")\n"); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* body */
}
else { strcat(pos,");\n"); pos += strlen(pos); }
current_proc_depth--;
break;
}
case PROCEDURE_CALL_:
sprintf(pos,"%s(",globals(node->op1.name_id)->name);
pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent); /* arglist */
strcat(pos,")"); pos++;
break;
case PROCEDURE_CALL_RETURN_:
exprint_recur(node+node->left,prec_parent); /* PROCEDURE_CALL_ */
break;
case PROCEDURE_START_: break;
case PROCEDURE_DEF_START_: break;
case PROCEDURE_PROTO_START_: break;
case PROCEDURE_HEAD_:
exprint_recur(node+node->right,prec_parent); /* arglist */
break;
case SET_ARGSPROC_:
case PROCEDURE_PROTO_:
{ struct global *g = globals(node[node->left].op1.name_id);
sprintf(pos,"procedure %s (",g->name);
pos += strlen(pos);
current_proc_locals[++current_proc_depth] = g->value.proc.locals;
exprint_recur(node+node->left,prec_parent); /* arglist */
if ( node->type == SET_ARGSPROC_ )
{ strcat(pos,")\n"); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent); /* body */
}
else { strcat(pos,");\n"); pos += strlen(pos); }
current_proc_depth--;
break;
}
case DEFINE_IDENT_:
sprintf(pos,"define %s %s",globals(node->op1.name_id)->name,
datatype_name[node->op2.valtype]);
pos += strlen(pos);
break;
case SET_DELTA_:
sprintf(pos,"%s.pdelta",globals(node->op1.name_id)->name);
pos += strlen(pos);
switch ( node->op2.assigntype )
{ case ASSIGN_: sprintf(pos," := "); break;
case PLUSASSIGN_: sprintf(pos," += "); break;
case SUBASSIGN_: sprintf(pos," -= "); break;
case MULTASSIGN_: sprintf(pos," *= "); break;
case DIVASSIGN_: sprintf(pos," /= "); break;
}
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_PARAM_SCALE:
sprintf(pos,"%s.pscale",globals(node->op1.name_id)->name);
pos += strlen(pos);
switch ( node->op2.assigntype )
{ case ASSIGN_: sprintf(pos," := "); break;
case PLUSASSIGN_: sprintf(pos," += "); break;
case SUBASSIGN_: sprintf(pos," -= "); break;
case MULTASSIGN_: sprintf(pos," *= "); break;
case DIVASSIGN_: sprintf(pos," /= "); break;
}
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_GLOBAL_: case SET_SGLOBAL_:
{ struct global *g = globals(node->op1.name_id);
if ( g->flags & PERMANENT )
sprintf(pos,"%s ::= ",g->name);
else sprintf(pos,"%s := ",g->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
}
case SET_PERM_GLOBAL_: case SET_PERM_SGLOBAL_:
sprintf(pos,"%s ::= ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case PLUSASSIGN_:
sprintf(pos,"%s += ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SUBASSIGN_:
sprintf(pos,"%s -= ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case MULTASSIGN_:
sprintf(pos,"%s *= ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case DIVASSIGN_:
sprintf(pos,"%s /= ",globals(node->op1.name_id)->name);
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SIZEOF_ATTR_:
sprintf(pos,"sizeof(%s)",
EXTRAS(node->op2.eltype)[node->op1.extranum].name);
pos += strlen(pos);
break;
case SIZEOF_ARRAY_:
sprintf(pos,"sizeof(%s)",globals(node->op1.name_id)->name);
pos += strlen(pos);
break;
case SIZEOF_STRING_:
sprintf(pos,"sizeof(");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,")");
pos++;
break;
case LAGRANGE_:
sprintf(pos,"%s ",keywordname(node->type)); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case LANCZOS_:
case EIGENPROBE_:
sprintf(pos,"%s ",keywordname(node->type)); pos += strlen(pos);
if ( node->right )
{ strcat(pos,"("); pos++;
exprint_recur(node+node->left,prec_parent);
strcat(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
strcat(pos,")"); pos++;
}
else exprint_recur(node+node->left,prec_parent);
return;
case RITZ_:
sprintf(pos,"%s(",keywordname(node->type)); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
strcat(pos,")"); pos++;
return;
case GET_TORUS_PERIODS_:
sprintf(pos,"torus_periods"); pos += strlen(pos);
strcat(pos++,"[");
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]["); pos+=2;
exprint_recur(node+node->right,prec_parent);
strcat(pos++,"]");
return;
case GET_INVERSE_PERIODS_:
sprintf(pos,"inverse_periods"); pos += strlen(pos);
strcat(pos++,"[");
exprint_recur(node+node->left,prec_parent);
strcat(pos,"]["); pos+=2;
exprint_recur(node+node->right,prec_parent);
strcat(pos++,"]");
return;
case HESSIAN_SADDLE_:
case HESSIAN_SEEK_:
sprintf(pos,"%s ",keywordname(node->type)); pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent);
return;
case MOVE_:
case AREAWEED_:
case EDGEWEED_:
case METIS_:
case METIS_READJUST_:
case KMETIS_:
case BODY_METIS_:
case NOTCH_:
case EDGEDIVIDE_:
sprintf(pos,"%s ",keywordname(node->type)); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case OMETIS_:
sprintf(pos,"%s ",keywordname(node->type)); pos += strlen(pos);
if ( node->left )
exprint_recur(node+node->left,prec_parent);
return;
case JIGGLE_:
strcat(pos,"j "); pos += 2;
exprint_recur(node+node->left,prec_parent);
return;
case LIST_PROCS_:
sprintf(pos,"list procedures "); pos+=strlen(pos);
break;
case LIST_ATTRIBUTES_:
sprintf(pos,"list attributes "); pos+=strlen(pos);
break;
case LIST_QUANTITY_:
sprintf(pos,"list quantity %s",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
break;
case LIST_METHOD_INSTANCE_:
sprintf(pos,"list method_instance %s",
METH_INSTANCE(node->op1.meth_id)->name);
pos += strlen(pos);
break;
case LIST_CONSTRAINT_:
{
if ( node->op1.con_id > 0 )
{ sprintf(pos,"list constraint %s",
get_constraint(node->op1.con_id)->name);
pos += strlen(pos);
}
else
{ sprintf(pos,"list constraint ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
}
}
break;
case LIST_BOUNDARY_:
{
if ( node->op1.bdry_id > 0 )
{ sprintf(pos,"list constraint %s",
web.boundaries[node->op1.bdry_id].name);
pos += strlen(pos);
}
else
{ sprintf(pos,"list boundary ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
}
}
break;
case TOPINFO_:
sprintf(pos,"list topinfo "); pos+=strlen(pos);
break;
case BOTTOMINFO_:
sprintf(pos,"list bottominfo "); pos+=strlen(pos);
break;
case AGGREGATE_END_:
exprint_recur(node+node->right,prec_parent);
return;
case LIST_: case DELETE_: case REFINE_: case DISSOLVE_: case POP_:
case FIX_: case UNFIX_: case EDGESWAP_: case VERTEX_AVERAGE_:
case RAW_VERTEX_AVERAGE_: case RAWEST_VERTEX_AVERAGE_:
case EQUIANGULATE_: case POP_EDGE_TO_TRI_: case POP_TRI_TO_EDGE_:
case POP_QUAD_TO_QUAD_: case T1_EDGESWAP_:
case REVERSE_ORIENTATION_:
case WHEREAMI_COMMAND_:
sprintf(pos,"%s ",keywordname(node->type));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case SINGLE_ELEMENT_INIT_:
return;
case SINGLE_ELEMENT_:
exprint_recur(node+node->left,prec_parent);
if ( node[node->left].type == INDEXED_SUBTYPE_ ||
node[node->left].type == INDEXED_ELEMENT_ )
if ( node[node->left].op5.string )
{ sprintf(pos," %s ",node[node->left].op5.string);
pos += strlen(pos);
}
return;
case GET_VERTEXNORMAL_:
strcat(pos,"vertexnormal"); pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
return;
case INDEXED_COORD_:
strcat(pos,"x"); pos += 1;
exprint_recur(node+node->left,prec_parent);
return;
case INDEXED_ELEMENT_:
switch ( node->op1.eltype )
{ case VERTEX: strcat(pos,"vertex["); break;
case EDGE: strcat(pos,"edge["); break;
case FACET: strcat(pos,"facet["); break;
case BODY: strcat(pos,"body["); break;
case FACETEDGE: strcat(pos,"facetedge["); break;
}
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
strcat(pos++,"]");
return;
case INDEXED_SUBTYPE_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".%s[",typenames[node->op1.eltype]);
pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
strcat(pos,"]");
pos += strlen(pos);
return;
case SELF_ELEMENT_:
strcat(pos,"self"); pos+=4; break;
case SINGLE_ELEMENT_EXPR_:
exprint_recur(node+node->left,prec_parent);
break;
case SYMBOL_:
case SYMBOL_ELEMENT_:
sprintf(pos,"%s", node->op5.string);
pos += strlen(pos); break;
case SET_PHASE_:
set_print(node,"set","phase",prec_parent); break;
case SET_DENSITY_:
set_print(node,"set","density",prec_parent); break;
case SET_VOLCONST_:
set_print(node,"set","volconst",prec_parent); break;
case SET_TARGET_:
set_print(node,"set","target",prec_parent); break;
case SET_PRESSURE_:
set_print(node,"set","pressure",prec_parent); break;
case SET_OPACITY_:
set_print(node,"set","opacity",prec_parent); break;
case SET_CONSTRAINT_:
set_print(node,"set","constraint",prec_parent); break;
case SET_CONSTRAINT_NAME:
set_print(node,"set","constraint ",prec_parent);
strcat(pos,get_constraint((int)(node[node->left].op1.real))->name);
pos += strlen(pos); break;
case SET_NAMED_QUANTITY_:
set_print(node,"set","quantity",prec_parent); break;
case UNSET_NAMED_QUANTITY_:
set_print(node,"unset","quantity",prec_parent); break;
case SET_METHOD_INSTANCE_:
set_print(node,"set","method_instance",prec_parent); break;
case UNSET_METHOD_INSTANCE_:
set_print(node,"unset","method_instance",prec_parent); break;
case SET_EXTRA_ATTR_:
{ ex = EXTRAS(node->op3.extra_info >> ESHIFT)
+(node->op3.extra_info & 0xFF);
set_print(node,"set",ex->name,prec_parent);
if ( node->right )
exprint_recur(node+node->right,prec_parent);
}
break;
case SET_COLOR_:
set_print(node,"set","color",prec_parent); break;
case SET_FRONTCOLOR_:
set_print(node,"set","frontcolor",prec_parent); break;
case SET_BACKCOLOR_:
set_print(node,"set","backcolor",prec_parent); break;
case SET_TAG_:
set_print(node,"set","tag",prec_parent); break;
case SET_BACKGROUND_:
set_print(node,"set","background",prec_parent); break;
case SET_COORD_:
{ char cname[10];
if ( (vch == 'X') && (node->op2.coordnum+1 <= 3) )
sprintf(cname,"%c",'x'+node->op2.coordnum);
else
sprintf(cname,"%c%d",vch,node->op2.coordnum+1);
set_print(node,"set",cname,prec_parent);
}
break;
case SET_PARAM_:
{ char cname[10];
sprintf(cname,"P%d",node->op2.coordnum+1);
set_print(node,"set",cname,prec_parent);
}
break;
case UNSET_FIXED_:
set_print(node,"unset","fixed",prec_parent); break;
case SET_FIXED_:
set_print(node,"set","fixed",prec_parent); break;
case UNSET_BARE_:
set_print(node,"unset","bare",prec_parent); break;
case SET_BARE_:
set_print(node,"set","bare",prec_parent); break;
case UNSET_NO_DISPLAY_:
set_print(node,"unset","no_display",prec_parent); break;
case SET_NO_DISPLAY_:
set_print(node,"set","no_display",prec_parent); break;
case UNSET_NONCONTENT_:
set_print(node,"unset","noncontent",prec_parent); break;
case SET_NONCONTENT_:
set_print(node,"set","noncontent",prec_parent); break;
case UNSET_HIT_PARTNER_:
set_print(node,"unset","hit_partner",prec_parent); break;
case SET_HIT_PARTNER_:
set_print(node,"set","hit_partner",prec_parent); break;
case UNSET_NO_REFINE_:
set_print(node,"unset","no_refine",prec_parent); break;
case SET_NO_REFINE_:
set_print(node,"set","no_refine",prec_parent); break;
case UNSET_TRIPLE_PT_:
set_print(node,"unset","triple_point",prec_parent); break;
case SET_ORIENTATION_:
set_print(node,"set","orientation",prec_parent); break;
case UNSET_TETRA_PT_:
set_print(node,"unset","tetra_point",prec_parent); break;
case UNSET_AXIAL_POINT_:
set_print(node,"unset","axial_point",prec_parent); break;
case UNSET_FACET_BODY_:
set_print(node,"unset","body",prec_parent); break;
case SET_FRONTBODY_:
set_print(node,"set","frontbody",prec_parent); break;
case UNSET_FRONTBODY_:
set_print(node,"unset","frontbody",prec_parent); break;
case SET_BACKBODY_:
set_print(node,"set","backbody",prec_parent); break;
case UNSET_BACKBODY_:
set_print(node,"unset","backbody",prec_parent); break;
case UNSET_DENSITY_:
set_print(node,"unset","density",prec_parent); break;
case UNSET_PRESSURE_:
set_print(node,"unset","pressure",prec_parent); break;
case UNSET_VOLUME_:
case UNSET_TARGET_:
set_print(node,"unset","target",prec_parent); break;
case UNSET_CONSTRAINT_:
set_print(node,"unset","constraint",prec_parent);
break;
case UNSET_CONSTRAINT_NAME:
{ char temp[100];
sprintf(temp,"constraint %s",get_constraint(node->op3.connum)->name);
set_print(node,"unset",temp,prec_parent);
pos += strlen(pos);
break;
}
case UNSET_BOUNDARY_:
set_print(node,"unset","boundary",prec_parent); break;
case UNSET_BOUNDARY_NAME:
{ char temp[100];
sprintf(temp,"boundary %s",web.boundaries[node->op3.bdrynum].name);
set_print(node,"unset",temp,prec_parent);
pos += strlen(pos);
break;
}
case SET_INIT_ : break;
case SET_ATTRIBUTE_LOOP_:
{ struct treenode *nnode;
sprintf(pos," set ");
pos += strlen(pos);
nnode = node + node->left;
if ( nnode->type == WHERE_ ) nnode += nnode->left; /* get NEXT_ */
exprint_recur(nnode,prec_parent);
if ( node->right ) exprint_recur(node+node->right,prec_parent);
if ( node[node->left].type == WHERE_ )
{ node+= node->left;
sprintf(pos," where "); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
}
}
return;
case FOREACH_:
sprintf(pos,"foreach ");
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos," do ");
pos += strlen(pos);
bracket_depth++;
newline();
exprint_recur(node+node->right,prec_parent);
bracket_depth--;
return;
case MAX_: case MIN_: case SUM_: case AVG_: case COUNT_:
case HISTOGRAM_: case LOGHISTOGRAM_:
sprintf(pos,"%s(",keywordname(node->type));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
sprintf(pos,","); pos++;
exprint_recur(node+node->right,prec_parent);
sprintf(pos,")"); pos++;
return;
case WHERE_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos," where "); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
return;
case NEXT_VERTEX_: case NEXT_EDGE_VERTEX_: case NEXT_FACET_VERTEX_:
case NEXT_BODY_VERTEX_: case NEXT_FACETEDGE_:
case NEXT_EDGE_: case NEXT_VERTEX_EDGE_: case NEXT_FACET_EDGE_:
case NEXT_FACET_: case NEXT_VERTEX_FACET_: case NEXT_EDGE_FACET_:
case NEXT_BODY_: case NEXT_VERTEX_BODY_: case NEXT_EDGE_BODY_:
case NEXT_FACET_BODY_:
case NEXT_BODY_FACET_:
case NEXT_BODY_EDGE_:
exprint_recur(node+node->left,prec_parent);
if ( strcmp(node->op5.string,default_name) != 0 )
{ sprintf(pos,"%s ",node->op5.string);
pos += strlen(pos);
}
return;
case INIT_FACETEDGE_:
sprintf(pos,"facetedges "); pos += strlen(pos);
return;
case INIT_VERTEX_:
sprintf(pos,"vertices "); pos += strlen(pos);
return;
case INIT_EDGE_VERTEX_: case INIT_FACET_VERTEX_: case INIT_BODY_VERTEX_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".vertices ");
pos += strlen(pos);
return;
case INIT_EDGE_:
sprintf(pos,"edges "); pos += strlen(pos);
return;
case INIT_VERTEX_EDGE_: case INIT_FACET_EDGE_: case INIT_BODY_EDGE_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".edges ");
pos += strlen(pos);
return;
case INIT_FACET_:
sprintf(pos,"facets "); pos += strlen(pos);
return;
case INIT_VERTEX_FACET_: case INIT_EDGE_FACET_: case INIT_BODY_FACET_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".facets ");
pos += strlen(pos);
return;
case INIT_BODY_:
sprintf(pos,"bodies "); pos += strlen(pos);
break;
case INIT_VERTEX_BODY_: case INIT_EDGE_BODY_: case INIT_FACET_BODY_:
exprint_recur(node+node->left,prec_parent);
sprintf(pos,".bodies ");
pos += strlen(pos);
return;
case PUSH_NAMED_QUANTITY:
sprintf(pos,"%s ",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSH_METHOD_INSTANCE_:
sprintf(pos,"%s ",METH_INSTANCE(node->op1.meth_id)->name);
pos += strlen(pos);
return;
case PUSHCONST:
#ifdef LONGDOUBLE
sprintf(pos,"%1.*Lg",DPREC,node->op1.real);
#else
sprintf(pos,"%1.15g",node->op1.real);
#endif
pos += strlen(pos);
return;
case PUSHPI:
sprintf(pos,"pi");
pos += strlen(pos);
return;
case PUSHE:
sprintf(pos,"e");
pos += strlen(pos);
return;
case PUSHG:
sprintf(pos,"G");
pos += strlen(pos);
return;
case COORD_:
if ( node->left )
{ exprint_recur(node+node->left,PREC_COND);
sprintf(pos,"."); pos += strlen(pos);
}
if ( (vch == 'X') && (node->op2.coordnum+1 <= 3) )
sprintf(msg,"%c",'x'+node->op2.coordnum);
else
sprintf(msg,"%c%d",vch,node->op2.coordnum+1);
print_attr(node,msg);
return;
case PARAM_:
sprintf(msg,"P%d",node->op2.coordnum+1);
print_attr(node,msg);
return;
case PUSHPARAM:
if ( (vch == 'X') && (node->op1.coordnum+1 <= 3) )
sprintf(msg,"%c",'x'+node->op1.coordnum);
else
sprintf(msg,"%c%d",vch,node->op1.coordnum+1);
print_attr(node,msg);
return;
case SET_MMODULUS_:
sprintf(pos,"%s.modulus %s ",METH_INSTANCE(node->op1.meth_id)->name,
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_QMODULUS_:
sprintf(pos,"%s.modulus %s ",GEN_QUANT(node->op1.quant_id)->name,
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_QTARGET_:
sprintf(pos,"%s.target %s ",GEN_QUANT(node->op1.quant_id)->name,
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_QVOLCONST_:
sprintf(pos,"%s.volconst %s ",GEN_QUANT(node->op1.quant_id)->name,
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case SET_QTOLERANCE_:
sprintf(pos,"%s.tolerance %s ",GEN_QUANT(node->op1.quant_id)->name,
assign_symbol(node->op2.assigntype));
pos += strlen(pos);
exprint_recur(node+node->left,prec_parent);
break;
case PUSHQFIXED_:
sprintf(pos,"%s.fixed",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQENERGY_:
sprintf(pos,"%s.energy",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQINFO_ONLY_:
sprintf(pos,"%s.info_only",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQCONSERVED_:
sprintf(pos,"%s.conserved",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQPRESSURE_:
sprintf(pos,"%s.pressure",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQTARGET_:
sprintf(pos,"%s.target",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHMVALUE_:
sprintf(pos,"%s.value",METH_INSTANCE(node->op1.meth_id)->name);
pos += strlen(pos);
return;
case PUSHQVALUE_:
sprintf(pos,"%s.value",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHMMODULUS_:
sprintf(pos,"%s.modulus",GEN_QUANT(node->op1.meth_id)->name);
pos += strlen(pos);
return;
case PUSHQMODULUS_:
sprintf(pos,"%s.modulus",GEN_QUANT(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHQVOLCONST_:
sprintf(pos,"%s.volconst",globals(node->op1.quant_id)->name);
pos += strlen(pos);
return;
case PUSHDELTA_:
sprintf(pos,"%s.pdelta",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case PUSH_PARAM_SCALE:
sprintf(pos,"%s.pscale",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case PUSH_PARAM_FIXED:
sprintf(pos,"%s.fixed",globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case PUSH_PARAM_EXTRA_:
sprintf(pos,"%s.%s",globals(node->op1.name_id)->name,
EXTRAS(0)[node->op2.extranum].name);
pos += strlen(pos);
return;
case ELEMENT_IDENT_:
{ struct global *g = globals(node->op3.name_id);
sprintf(pos,"%s",g->name);
pos += strlen(pos);
return;
}
case PUSHGLOBAL_:
case STRINGGLOBAL_:
{ struct global *g = globals(node->op1.name_id);
if ( g->flags & QUANTITY_NAME )
sprintf(pos,"total %s",g->name);
else sprintf(pos,"%s",g->name);
pos += strlen(pos);
return;
}
case PUSH_PERM_GLOBAL_:
case PERM_STRINGGLOBAL_:
sprintf(pos,"%s",perm_globals(node->op1.name_id)->name);
pos += strlen(pos);
return;
case USERFUNC:
sprintf(pos,"usr%d",node->op1.userfunc+1);
pos += strlen(pos);
return;
case DYNAMIC_LOAD_FUNC_:
sprintf(pos,globals(node->op2.name_id)->name);
pos += strlen(pos);
return;
case PLUS:
binary_print(node,prec_parent,PREC_ADD," + ",PREC_ADD);
return;
case MINUS:
binary_print(node,prec_parent,PREC_SUB," - ",PREC_SUB+1);
return;
case EQUATE:
binary_print(node,prec_parent,PREC_ASSIGN," = ",PREC_ASSIGN+1);
return;
case TIMES:
binary_print(node,prec_parent,PREC_MUL,"*",PREC_MUL);
return;
case DIVIDE:
binary_print(node,prec_parent,PREC_DIV,"/",PREC_DIV+1);
return;
case REALMOD:
binary_print(node,prec_parent,PREC_DIV,"%%",PREC_DIV+1);
return;
case IMOD_:
binary_print(node,prec_parent,PREC_DIV," imod ",PREC_DIV+1);
return;
case IDIV_:
binary_print(node,prec_parent,PREC_DIV," idiv ",PREC_DIV+1);
return;
case COND_ELSE_:
binary_print(node,prec_parent,PREC_COND,"):(",PREC_COND);
strcat(pos++,")");
return;
case COND_EXPR_:
strcat(pos++,"(");
binary_print(node,prec_parent,PREC_COND,")?(",PREC_COND);
return;
case COND_TEST_:
exprint_recur(node+node->left,PREC_COND);
return;
case INV:
exprint_recur(node+node->left,PREC_POW);
sprintf(pos,"^(-1)");
pos += strlen(pos);
return;
case INTPOW:
exprint_recur(node+node->left,PREC_POW);
sprintf(pos,"^%1d",node->op1.intpow);
pos += strlen(pos);
return;
case POW:
binary_print(node,prec_parent,PREC_POW,"**",PREC_POW);
return;
case MAXIMUM_:
strcat(pos,"maximum(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case MINIMUM_:
strcat(pos,"minimum(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case INCOMPLETE_ELLIPTICF:
sprintf(pos,"incompleteEllipticF(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case INCOMPLETE_ELLIPTICE:
sprintf(pos,"incompleteEllipticE(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case ATAN2_:
sprintf(pos,"atan2(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case WRAP_COMPOSE_:
sprintf(pos,"wrap_compose(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos++,",");
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,")");
return;
case WRAP_INVERSE_:
sprintf(pos,"wrap_inverse(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case SQR:
sprintf(pos,"(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")^2");
pos += strlen(pos);
return;
case SQRT:
sprintf(pos,"sqrt(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case FLOOR_:
sprintf(pos,"floor(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case CEIL_:
sprintf(pos,"ceil(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ABS:
sprintf(pos,"abs(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case SINH:
sprintf(pos,"sinh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case COSH:
sprintf(pos,"cosh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case TANH:
sprintf(pos,"tanh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ACOSH:
sprintf(pos,"acosh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ASINH:
sprintf(pos,"asinh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ATANH:
sprintf(pos,"atanh(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case SIN:
sprintf(pos,"sin(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case COS:
sprintf(pos,"cos(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case TAN:
sprintf(pos,"tan(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case EXP:
sprintf(pos,"exp(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case LOG:
sprintf(pos,"log(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ASIN:
sprintf(pos,"asin(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ACOS:
sprintf(pos,"acos(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ATAN:
sprintf(pos,"atan(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ELLIPTICK:
sprintf(pos,"ellipticK(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case ELLIPTICE:
sprintf(pos,"ellipticE(");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
sprintf(pos,")");
pos += strlen(pos);
return;
case CHS:
sprintf(pos,"-");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_UMINUS);
return;
case NOT_:
sprintf(pos," not ");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_NOT);
return;
case VIEW_MATRIX_:
sprintf(pos,"view_matrix[");
pos += strlen(pos);
exprint_recur(node+node->left,PREC_ARG);
strcat(pos,"]["); pos += 2;
exprint_recur(node+node->right,PREC_ARG);
strcat(pos++,"]");
return;
case LENGTH_:
case VALENCE_:
case AREA_:
case VOLUME_:
case DENSITY_:
case PHASE_:
case ID_:
case STAR_:
case OID_:
case TAG_:
case ORIGINAL_:
case FIXED_:
case NO_REFINE_:
case HIT_PARTNER_:
case NONCONTENT_:
case NODISPLAY_:
case BARE_:
case SQ_MEAN_CURV_:
sprintf(pos," %s ",keywordname(node->type));
pos += strlen(pos);
return;
case GET_EXTRA_ATTR_:
ex = EXTRAS(node->op2.eltype) + node->op3.extranum;
print_attr(node,ex->name);
if ( node->left )
exprint_recur(node+node->left,prec_parent);
break;
case ON_QUANTITY_:
print_attr(node,"on_quantity ");
strcat(pos,GEN_QUANT(node->op2.quant_id)->name);
pos += strlen(pos);
return;
case ON_METHOD_INSTANCE_:
print_attr(node,"on_method_instance ");
strcat(pos,METH_INSTANCE(node->op2.meth_id)->name);
pos += strlen(pos);
return;
case ON_CONSTRAINT_:
print_attr(node,"on_constraint ");
exprint_recur(node+node->left,prec_parent);
return;
case ON_CONSTRAINT_NAME:
print_attr(node,"on_constraint ");
strcat(pos,get_constraint(node->op3.connum)->name);
pos += strlen(pos);
return;
case HIT_CONSTRAINT_:
print_attr(node,"hit_constraint ");
exprint_recur(node+node->left,prec_parent);
return;
case HIT_CONSTRAINT_NAME:
print_attr(node,"hit_constraint ");
strcat(pos,get_constraint(node->op3.connum)->name);
pos += strlen(pos);
return;
case ON_BOUNDARY_:
print_attr(node,"on_boundary ");
exprint_recur(node+node->left,prec_parent);
return;
case ON_BOUNDARY_NAME:
print_attr(node,"on_boundary ");
strcat(pos,web.boundaries[node->op3.bdrynum].name);
pos += strlen(pos);
return;
case QUALIFIED_ATTRIBUTE:
exprint_recur(node+node->left,prec_parent);
strcat(pos,"."); pos++;
exprint_recur(node+node->right,prec_parent);
return;
case GET_MIDV_:
print_attr(node,"midv");
return;
case GET_TRIPLE_PT_:
print_attr(node,"triple_point");
return;
case GET_TETRA_PT_:
print_attr(node,"tetra_point");
return;
case GET_AXIAL_POINT_:
print_attr(node,"axial_point");
return;
case GET_FIXED_:
print_attr(node,"fixed");
return;
case GET_BARE_:
print_attr(node,"bare");
return;
case GET_NO_DISPLAY_:
print_attr(node,"no_display");
return;
case GET_NONCONTENT_:
print_attr(node,"noncontent");
return;
case GET_HIT_PARTNER_:
print_attr(node,"hit_partner");
return;
case GET_NO_REFINE_:
print_attr(node,"no_refine");
return;
case GET_ORIGINAL_:
print_attr(node,"original");
return;
case GET_ID_:
print_attr(node,"id");
return;
case GET_STAR_:
print_attr(node,"star");
return;
case GET_OID_:
print_attr(node,"oid");
return;
case GET_VALENCE_:
print_attr(node,"valence");
return;
case GET_COLOR_:
print_attr(node,"color");
return;
case GET_FRONTCOLOR_:
print_attr(node,"frontcolor");
return;
case GET_BACKCOLOR_:
print_attr(node,"backcolor");
return;
case GET_FRONTBODY_:
print_attr(node,"frontbody");
return;
case GET_BACKBODY_:
print_attr(node,"backbody");
return;
case GET_TAG_:
print_attr(node,"tag");
return;
case GET_ORIENTATION_:
print_attr(node,"orientation");
return;
case GET_SHOW_:
print_attr(node,"show");
return;
case GET_LENGTH_:
print_attr(node,"length");
return;
case GET_MEANCURV_:
print_attr(node,"mean_curvature");
return;
case GET_FIXEDVOL_:
print_attr(node,"volfixed");
return;
case GET_MID_EDGE_:
print_attr(node,"mid_edge");
return;
case GET_MID_FACET_:
print_attr(node,"mid_facet");
return;
case GET_WRAP_:
print_attr(node,"wrap");
return;
case GET_SQ_MEAN_CURV_:
print_attr(node,"sqcurve");
return;
case GET_DIHEDRAL_:
print_attr(node,"dihedral");
return;
case GET_AREA_:
print_attr(node,"area");
return;
case GET_VOLUME_:
print_attr(node,"volume");
return;
case GET_VOLCONST_:
print_attr(node,"volconst");
return;
case GET_TARGET_:
print_attr(node,"target");
return;
case GET_MPI_TASK_:
print_attr(node,"mpi_task");
return;
case GET_PRESSURE_:
print_attr(node,"pressure");
return;
case GET_USERATTR_:
print_attr(node,"user_attr");
return;
case GET_DENSITY_:
print_attr(node,"density");
return;
case GET_PHASE_:
print_attr(node,"phase");
return;
case GET_QUANTITY_:
print_attr(node,GEN_QUANT(node->op2.quant_id)->name);
return;
case GET_INSTANCE_:
print_attr(node,METH_INSTANCE(node->op2.meth_id)->name);
return;
case INDEXSET_:
case DIMENSIONSET_:
if ( node->right )
{ exprint_recur(node+node->left,prec_parent);
strcat(pos++,"[");
exprint_recur(node+node->right,prec_parent);
strcat(pos++,"]");
} else
{
strcat(pos++,"[");
exprint_recur(node+node->left,prec_parent);
strcat(pos++,"]");
}
break;
case SET_ATTRIBUTE_:
strcat(pos,"set "); pos += 4;
case SET_ATTRIBUTE_A: /* single element assign */
case SET_ATTRIBUTE_L: /* skip printing set when in set loop */
if ( pos[-1] != '.' ) strcat(pos++," "); /* just to be sure */
switch ( node->op2.attr_kind )
{ case SET_DENSITY_: print_set_attr(node,"density"); break;
case SET_EXTRA_ATTR_:
{ ex = EXTRAS(node->op3.extra_info>>ESHIFT)
+(node->op3.extra_info&0xFF);
print_attr(node,ex->name);
if ( node->right )
exprint_recur(node+node->right,prec_parent);
}
break;
case SET_PHASE_ : print_set_attr(node,"phase"); break;
case SET_WRAP_ : print_set_attr(node,"wrap"); break;
case SET_ORIENTATION_ : print_set_attr(node,"orientation"); break;
case SET_TARGET_: print_set_attr(node,"target"); break;
case SET_VOLCONST_: print_set_attr(node,"volconst"); break;
case SET_PRESSURE_: print_set_attr(node,"pressure"); break;
case SET_OPACITY_: print_set_attr(node,"opacity"); break;
case SET_COLOR_: print_set_attr(node,"color"); break;
case SET_ORIGINAL_: print_set_attr(node,"original"); break;
case SET_FRONTBODY_: print_set_attr(node,"frontbody"); break;
case SET_BACKBODY_: print_set_attr(node,"backbody"); break;
case SET_FRONTCOLOR_: print_attr(node,"frontcolor"); break;
case SET_BACKCOLOR_: print_set_attr(node,"backcolor"); break;
case SET_CONSTRAINT_:
{ struct constraint *con;
print_set_attr(node,"constraint ");
if ( node[node->left].type == PUSHCONST )
{ int cnum = (int)(node[node->left].op1.real);
con = get_constraint(cnum);
if ( (cnum <= web.maxcon) && (con->attr & NAMED_THING) )
{ strcat(pos,con->name);
pos += strlen(pos);
return;
} /* else recursion takes care of expression number constant */
}
pos += strlen(pos);
break;
}
case SET_BOUNDARY_:
{ struct boundary *bdry;
print_set_attr(node,"boundary ");
if ( node[node->left].type == PUSHCONST )
{ int bnum = (int)(node[node->left].op1.real);
bdry = web.boundaries+bnum;
if ( (bnum <= web.bdrymax) && (bdry->attr & NAMED_THING) )
{ strcat(pos,bdry->name);
pos += strlen(pos);
return;
} /* else recursion takes care of expression number constant */
}
pos += strlen(pos);
break;
}
case SET_TAG_: print_set_attr(node,"tag"); break;
case SET_FIXED_: print_set_attr(node,"fixed"); break;
case SET_BARE_: print_set_attr(node,"bare"); break;
case SET_NO_REFINE_: print_set_attr(node,"no_refine"); break;
case SET_HIT_PARTNER_: print_set_attr(node,"hit_partner"); break;
case SET_NONCONTENT_: print_set_attr(node,"noncontent"); break;
case SET_NO_DISPLAY_: print_set_attr(node,"no_display"); break;
case SET_TETRA_PT_: print_set_attr(node,"tetra_pt"); break;
case SET_AXIAL_POINT_: print_set_attr(node,"axial_point"); break;
case SET_TRIPLE_PT_: print_set_attr(node,"triple_point"); break;
case SET_COORD_1:
if ( node->right )
{ print_set_attr(node,"x");
exprint_recur(node+node->right,prec_parent);
break;
}
else print_set_attr(node,"X1");
break;
case SET_COORD_2: print_set_attr(node,"X2"); break;
case SET_COORD_3: print_set_attr(node,"X3"); break;
case SET_COORD_4: print_set_attr(node,"X4"); break;
case SET_COORD_5: print_set_attr(node,"X5"); break;
case SET_COORD_6: print_set_attr(node,"X6"); break;
case SET_COORD_7: print_set_attr(node,"X7"); break;
case SET_COORD_8: print_set_attr(node,"X8"); break;
case SET_PARAM_1:
if ( node->right )
{ print_set_attr(node,"p1["); pos += 3;
exprint_recur(node+node->right,prec_parent);
strcat(pos,"]"); pos += strlen(pos);
break;
}
else print_set_attr(node,"P1");
break;
case SET_PARAM_2: print_set_attr(node,"P2"); break;
case SET_PARAM_3: print_set_attr(node,"P3"); break;
case SET_PARAM_4: print_set_attr(node,"P4"); break;
default:
sprintf(errmsg,"Internal error: bad SET_ATTRIBUTE type %d.\n",
node->op2.attr_kind);
kb_error(1655,errmsg,RECOVERABLE);
}
if ( node->type == SET_ATTRIBUTE_A )
{ switch ( node[1].op1.assigntype )
{ case ASSIGN_: strcat(pos," := "); break;
case PLUSASSIGN_: strcat(pos," += "); break;
case SUBASSIGN_: strcat(pos," -= "); break;
case MULTASSIGN_: strcat(pos," *= "); break;
case DIVASSIGN_: strcat(pos," /= "); break;
}
pos += 4;
}
strcat(pos," ("); pos += 2;
if ( node->left ) exprint_recur(node+node->left,prec_parent);
strcat(pos++,")");
return;
case SINGLE_ASSIGN_ :
exprint_recur(node+node->left,prec_parent);
*(pos++) = '.'; *pos = 0;
exprint_recur(node+node->right,prec_parent);
return;
case EQ_:
binary_print(node,prec_parent,PREC_COMP," == ",PREC_COMP);
return;
case NE_:
binary_print(node,prec_parent,PREC_COMP," != ",PREC_COMP);
return;
case GE_:
binary_print(node,prec_parent,PREC_COMP," >= ",PREC_COMP);
return;
case LE_:
binary_print(node,prec_parent,PREC_COMP," <= ",PREC_COMP);
return;
case GT_:
binary_print(node,prec_parent,PREC_COMP," > ",PREC_COMP);
return;
case LT_:
binary_print(node,prec_parent,PREC_COMP," < ",PREC_COMP);
return;
case AND_:
binary_print(node,prec_parent,PREC_AND," && ",PREC_AND);
return;
case OR_:
binary_print(node,prec_parent,PREC_OR," || ",PREC_OR);
return;
case CONJUNCTION_END:
exprint_recur(node+node->left,prec_parent);
return;
default:
sprintf(pos,"(unknown)");
pos += strlen(pos);
sprintf(errmsg,"Printing of expression node type %s (%d) unimplemented.\n",
tokname(node->type),node->type);
kb_error(1656,errmsg,WARNING);
return;
}
return ; /* shouldn't happen */
} /* end exprint_recur */
/**************************************************************************
*
* function: binary_print()
*
* purpose: print binary operation with parentheses if needed.
*
*/
void binary_print(node,prec_parent,prec1,op,prec2)
struct treenode *node;
int prec_parent;
int prec1;
char *op;
int prec2;
{
if ( prec_parent > prec1 )
{ sprintf(pos,"(");
pos += strlen(pos);
}
exprint_recur(node+node->left,prec1);
sprintf(pos,op);
pos += strlen(pos);
exprint_recur(node+node->right,prec2);
if ( prec_parent > prec1 )
{ sprintf(pos,")");
pos += strlen(pos);
}
return;
}
/**************************************************************************
*
* function: set_print()
*
* purpose: print SET type command, with possible WHERE clause.
*
*/
void set_print(node,keyw,attrw,prec_parent)
struct treenode *node;
char *keyw,*attrw;
int prec_parent;
{ struct treenode *nnode;
sprintf(pos,"%s ",keyw);
pos += strlen(pos);
nnode = node + node->left;
if ( nnode->type == WHERE_ ) nnode += nnode->left; /* get NEXT_ */
exprint_recur(nnode,prec_parent);
sprintf(pos," %s ",attrw);
pos += strlen(pos);
if ( node->right ) exprint_recur(node+node->right,prec_parent);
if ( node[node->left].type == WHERE_ )
{ node+= node->left;
sprintf(pos," where "); pos += strlen(pos);
exprint_recur(node+node->right,prec_parent);
}
return;
}
void print_attr(node,word)
struct treenode *node;
char *word;
{
sprintf(pos,"%s",word);
pos += strlen(pos); return;
}
void print_set_attr(node,word)
struct treenode *node;
char *word;
{
sprintf(pos,"%s",word);
pos += strlen(pos); return;
}
evolver-2.30c.dfsg/src/grapher.c 0000644 0001753 0001753 00000060506 11410765113 017020 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: grapher.c
*
* contents: Functions for control of interactive
* graphics display.
*/
#include "include.h"
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#define dang (M_PI/30) /* rotation increment */
static REAL zoomfactor = 1.2; /* scale factor */
static REAL low[MAXCOORD],high[MAXCOORD]; /* extreme coordiates */
static REAL mid[MAXCOORD]; /* midpoint of extremes */
/* matrices */
/* image display motion done via homogeneous coordinates */
static REAL **spinl, **tipup; /* rotation increment matrices */
static REAL **spinr, **tipdown; /* rotation increment matrices */
static REAL **clockwise, **counterclock; /* rotation increment matrices */
static REAL **transleft,**transright; /* translation increment matrices */
static REAL **transup,**transdown; /* translation increment matrices */
static REAL **zoom, **shrink; /* scaling matrices */
static int showflag;
/********************************************************************
*
* function: update_display()
*
* purpose: wrapper for local_update_display()
*/
void update_display()
{
#ifdef MPI_EVOLVER
if ( this_task == 0 )
mpi_update_display();
#endif
local_update_display();
}
/********************************************************************
*
* function: local_update_display()
*
* purpose: Check for necessity of re-displaying surface.
*
*/
void local_update_display()
{
graph_timestamp = ++global_timestamp; /* new surface */
if ( go_display_flag )
{
if ( OOGL_flag ) UpdateOOGL();
else
display();
}
}
/********************************************************************
*
* function: do_show()
*
* purpose: Handles 's' command, displays and switches to
* graphics command mode.
*
*/
void do_show()
{
char line[100]; /* for reading user commands */
int old_flag = iterate_flag;
#ifdef MAC_OS_X
do_show_flag++; /* kludge so mac_exec_commands() does do_show() again */
#endif
#ifndef OPENGL
/* to prevent unnecessary recalculation of display */
graph_timestamp = ++global_timestamp; /* new surface */
#endif
if ( torus_display_mode == TORUS_DEFAULT_MODE ) ask_wrap_display();
/* main loop */
showflag = 1;
do
{
iterate_flag = 2;
if ( showflag ) display();
showflag = 1; /* default to show next time around, unless option
below decides otherwise */
#ifdef MOTIF
return;
#endif
if ( prompt("Graphics command: ",line,sizeof(line)) == EOF ) break;
}
while ( view_transform(line) );
iterate_flag = old_flag;
}
/********************************************************************
*
* function: ask_wrap_display()
*
* purpose: Dialog asking for symmetry group display mode.
*
*/
void ask_wrap_display()
{
if ( commandfd != stdin ) return;
if ( web.torus_flag )
{
char response[100];
if ( web.skel[BODY].count == 0 )
prompt("Display raw facets or clipped cell? (0,2): ",response,sizeof(response));
else
prompt("Display raw facets, connected bodies or clipped cell? (0,1,2): ",
response,sizeof(response));
switch ( response[0] )
{
case '0' : torus_display_mode = TORUS_RAW_MODE;
web.torus_body_flag = 0;
web.torus_clip_flag = 0;
break;
case '1' :
if ( web.skel[BODY].count == 0 )
kb_error(1042,"There are no bodies to display connectedly.\n",
WARNING);
else { web.torus_body_flag = 1;
web.torus_clip_flag = 0;
torus_display_mode = TORUS_CONNECTED_MODE;}
break;
case '2' :
web.torus_body_flag = 0;
web.torus_clip_flag = 1;
torus_display_mode = TORUS_CLIPPED_MODE;
break;
}
}
else if ( web.symmetry_flag )
{
char response[100];
if ( web.skel[BODY].count == 0 )
{ torus_display_mode = TORUS_RAW_MODE; return; }
prompt("Display raw cell or connected bodies? (0,1): ",response,sizeof(response));
switch ( response[0] )
{
case '0' : torus_display_mode = TORUS_RAW_MODE;
web.torus_body_flag = 0;
web.torus_clip_flag = 0;
break;
case '1' :
if ( web.skel[BODY].count == 0 )
kb_error(1043,"There are no bodies to display connectedly.\n",
WARNING);
else { web.torus_body_flag = 1;
web.torus_clip_flag = 0;
torus_display_mode = TORUS_CONNECTED_MODE;}
break;
}
}
}
/********************************************************************
*
* function: view_transform()
*
* purpose: parse and execute "graphics command" input.
*
*/
int view_transform(string)
char *string;
{
char *c;
size_t legal; /* number of legal characters at start of string */
/* test for illegal characters */
legal = strspn(string,
"0123456789.+-udrlcCRmzsABDxqtvwbeETH?h\034\035\036\037\033\133\n\r");
if ( legal != strlen(string) )
{ sprintf(msg,"Illegal character in graphics command: %c",string[legal]);
kb_error(1044,msg,WARNING);
showflag = 0; /* don't reshow */
return 1;
}
for ( c = string ; *c ; c++ )
{ int reps = 1; /* repetition count */
REAL val = 0.0; /* for arbitrary rotations */
int decflag = 0; /* whether have real number for angle or other */
char *cc = c;
if ( isdigit(*c) )
reps = atoi(c);
if ( isdigit(*c) || (*c=='.') || (*c=='-'))
{ val = atof(c);
if ( *cc == '.' ) decflag = 1;
cc = c+1;
while ( isdigit(*cc) || (*cc=='.'))
{ if ( *cc == '.' ) decflag = 1;
cc++;
}
}
if ( decflag ) { reps = 1; c = cc; }
else if ( *c == '-' ) { /* '-' for color decrement */ }
else { c = cc; val = 6.0; /* default angle */ }
while ( reps-- > 0 )
switch ( *c )
{
case 0: return 1;
case 'u':
if ( !decflag ) val = 6.0;
set_tipup(val*M_PI/180);
mat_mult(tipup,view,view,HOMDIM,HOMDIM,HOMDIM); break;
case 'd':
if ( !decflag ) val = 6.0;
set_tipdown(val*M_PI/180);
mat_mult(tipdown,view,view,HOMDIM,HOMDIM,HOMDIM); break;
case 'r':
if ( !decflag ) val = 6.0;
set_spinr(val*M_PI/180);
mat_mult(spinr,view,view,HOMDIM,HOMDIM,HOMDIM); break;
case 'l':
if ( !decflag ) val = 6.0;
set_spinl(val*M_PI/180);
mat_mult(spinl,view,view,HOMDIM,HOMDIM,HOMDIM); break;
case 'c':
if ( !decflag ) val = 6.0;
set_clockwise(val*M_PI/180);
mat_mult(clockwise,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 'C':
if ( !decflag ) val = 6.0;
set_counterclockwise(val*M_PI/180);
mat_mult(counterclock,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 'z':
if ( !decflag ) val = 1.2;
set_zoom(val);
mat_mult(zoom ,view,view,HOMDIM,HOMDIM,HOMDIM); break;
case 's':
if ( !decflag ) val = 1.2;
set_zoom(1/val);
mat_mult(zoom,view,view,HOMDIM,HOMDIM,HOMDIM); break;
/* MS-DOS arrow keys for translation */
case 30:
transup[SDIM>2?2:1][HOMDIM-1] = decflag ? val : 0.25;
mat_mult(transup, view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 31:
transdown[SDIM>2?2:1][HOMDIM-1] = decflag ? -val : -0.25;
mat_mult(transdown,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 28:
transright[SDIM>2?1:0][HOMDIM-1] = decflag ? val : 0.25;
mat_mult(transright,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 29:
transleft[SDIM>2?1:0][HOMDIM-1] = decflag ? -val : -0.25;
mat_mult(transleft,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 0x1b : /* ANSI arrow keys for translation */
if ( *(++c) != 0x5B )
{ if ( isprint(*c) )
sprintf(msg,"Unrecognized character: %c\n",*c);
else sprintf(msg,"Unrecognized character: 0x%04X\n",*c);
outstring(msg);
break;
}
switch ( *(++c) )
{
case 0x41:
transup[SDIM>2?2:1][HOMDIM-1] = decflag ? val : 0.25;
mat_mult(transup, view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 0x42:
transdown[SDIM>2?2:1][HOMDIM-1] = decflag ? -val : -0.25;
mat_mult(transdown,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 0x43:
transright[SDIM>2?1:0][HOMDIM-1] = decflag ? val : 0.25;
mat_mult(transright,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case 0x44:
transleft[SDIM>2?1:0][HOMDIM-1] = decflag ? -val : -0.25;
mat_mult(transleft,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
default:
if ( isprint(*c) )
sprintf(msg,"Unrecognized character: %c\n",*c);
else sprintf(msg,"Unrecognized character: 0x%04X \n",*c);
outstring(msg);
break;
}
break;
case 'R':
if ( decflag ) /* particular scaling */
{ int i;
matcopy(view,identmat,HOMDIM,HOMDIM);
for ( i = 0 ; i < HOMDIM-1 ; i++ )
{ view[i][i] = val;
}
}
else resize();
reps = 0; graph_timestamp = ++global_timestamp;
break;
case 'm': /* middle, for centering */
{ do_gfile(0,NULL); /* get bounding box */
if ( SDIM == 2 )
{ view[0][HOMDIM-1] -= (bbox_maxx+bbox_minx)/2;
view[1][HOMDIM-1] -= (bbox_maxy+bbox_miny)/2;
} else
{ view[1][HOMDIM-1] -= (bbox_maxx+bbox_minx)/2;
view[2][HOMDIM-1] -= (bbox_maxy+bbox_miny)/2;
}
break;
}
case 'x':
case 'q': return 0;
case 't':
if ( !web.symmetry_flag ) break;
ask_wrap_display(); graph_timestamp = ++global_timestamp;
reps = 0; break;
case 'B': bdry_showflag = !bdry_showflag;
graph_timestamp = ++global_timestamp;
reps = 0; break;
case 'v': ridge_color_flag = !ridge_color_flag; reps = 0;
graph_timestamp = ++global_timestamp;break;
case 'w': no_wall_flag = !no_wall_flag; reps = 0;
graph_timestamp = ++global_timestamp;break;
case 'b': box_flag = !box_flag; reps = 0;
graph_timestamp = ++global_timestamp; break;
case 'e': edgeshow_flag = !edgeshow_flag;
graph_timestamp = ++global_timestamp; break;
case 'E': triple_edgeshow_flag = !triple_edgeshow_flag;
graph_timestamp = ++global_timestamp; break;
case 'T': transforms_flag = !transforms_flag;
graph_timestamp = ++global_timestamp; break;
case '+': fillcolor++;
sprintf(msg,"fillcolor %d\n",fillcolor);
outstring(msg);
graph_timestamp = ++global_timestamp;
reps = 0; break;
case '-': fillcolor--;
sprintf(msg,"fillcolor %d\n",fillcolor);
outstring(msg);
graph_timestamp = ++global_timestamp;
reps = 0; break;
case 'H': web.hide_flag = !web.hide_flag; reps = 0;
graph_timestamp = ++global_timestamp;
break;
case '?':
case 'h':
graph_help();
showflag = 0;
reps = 0; break;
case '\n': case '\r': break;
default:
if ( isprint(*c) )
sprintf(msg,"Unrecognized letter: %c\n",*c);
else sprintf(msg,"Unrecognized character: 0x%04x \n",*c);
outstring(msg);
reps = 0; showflag = 0;
break;
}
}
return 1;
} /* end view_transform() */
/********************************************************************
*
* function: init_view()
*
* purpose: Initialize viewing and transform matrices.
*
*/
void init_view()
{
int i;
view = dmatrix(0,SDIM,0,SDIM);
if ( identmat == NULL )
{ /* first time set-up */
/* set up identity matrix */
identmat = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
for ( i = 0 ; i <= MAXCOORD ; i++ )
identmat[i][i] = 1.0;
to_focus = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
from_focus = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
/* set rotation matrices */
spinr = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(spinr,identmat,SDIM+1,SDIM+1);
spinr[0][0] = spinr[1][1] = cos(dang);
spinr[0][1] = -(spinr[1][0] = sin(dang));
spinl = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(spinl,identmat,SDIM+1,SDIM+1);
spinl[0][0] = spinl[1][1] = cos(dang);
spinl[0][1] = -(spinl[1][0] = -sin(dang));
tipup = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(tipup,identmat,SDIM+1,SDIM+1);
tipup[0][0] = tipup[2][2] = cos(dang);
tipup[0][2] = -(tipup[2][0] = sin(dang));
tipdown = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(tipdown,identmat,SDIM+1,SDIM+1);
tipdown[0][0] = tipdown[2][2] = cos(dang);
tipdown[0][2] = -(tipdown[2][0] = -sin(dang));
clockwise = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(clockwise,identmat,SDIM+1,SDIM+1);
clockwise[1][1] = clockwise[2][2] = cos(dang);
clockwise[1][2] = -(clockwise[2][1] = -sin(dang));
counterclock = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(counterclock,identmat,SDIM+1,SDIM+1);
counterclock[1][1] = counterclock[2][2] = cos(dang);
counterclock[1][2] = -(counterclock[2][1] = sin(dang));
/* set magnifying matrix */
zoom = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(zoom,identmat,SDIM+1,SDIM+1);
zoom[0][0] = zoom[1][1] = zoom[2][2] = zoomfactor;
/* set shrink matrix */
shrink = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
matcopy(shrink,identmat,SDIM+1,SDIM+1);
shrink[0][0] = shrink[1][1] = shrink[2][2] = 1/zoomfactor;
/* set translation matrices */
transleft = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
transup = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
transright = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
transdown = perm_matrix2(MAXCOORD+1,MAXCOORD+1);
}
set_view_matrix_global();
matcopy(to_focus,identmat,SDIM+1,SDIM+1);
matcopy(from_focus,identmat,SDIM+1,SDIM+1);
}
/********************************************************************
*
* functions: set_*()
*
* purpose: set key entries of transform matrices.
*
*/
void set_spinr(val)
REAL val;
{
spinr[0][0] = spinr[1][1] = cos(val);
spinr[0][1] = -(spinr[1][0] = sin(val));
}
void set_spinl(val)
REAL val;
{
spinl[0][0] = spinl[1][1] = cos(val);
spinl[0][1] = -(spinl[1][0] = -sin(val));
}
void set_tipup(val)
REAL val;
{
tipup[0][0] = tipup[2][2] = cos(val);
tipup[0][2] = -(tipup[2][0] = sin(val));
}
void set_tipdown(val)
REAL val;
{
tipdown[0][0] = tipdown[2][2] = cos(val);
tipdown[0][2] = -(tipdown[2][0] = -sin(val));
}
void set_clockwise(val)
REAL val;
{
clockwise[1][1] = clockwise[2][2] = cos(val);
clockwise[1][2] = -(clockwise[2][1] = -sin(val));
}
void set_counterclockwise(val)
REAL val;
{
counterclock[1][1] = counterclock[2][2] = cos(val);
counterclock[1][2] = -(counterclock[2][1] = sin(val));
}
void set_zoom(val)
REAL val;
{ zoom[0][0] = zoom[1][1] = val;
if ( web.sdim >= 3 )
zoom[2][2] = val;
}
/********************************************************************
*
* function: reset_view()
*
* purpose: re-initialize view matrix.
*
*/
void reset_view()
{
HOMDIM = web.sdim + 1;
matcopy(transleft,identmat,HOMDIM,HOMDIM);
matcopy(transdown,identmat,HOMDIM,HOMDIM);
matcopy(transright,identmat,HOMDIM,HOMDIM);
matcopy(transup,identmat,HOMDIM,HOMDIM);
if ( SDIM > 2 )
{
transright[1][HOMDIM-1] = .25;
transleft[1][HOMDIM-1] = -.25;
transup[2][HOMDIM-1] = .25;
transdown[2][HOMDIM-1] = -.25;
}
else /* show x-y plane */
{
transright[0][HOMDIM-1] = .25;
transleft[0][HOMDIM-1] = -.25;
transup[1][HOMDIM-1] = .25;
transdown[1][HOMDIM-1] = -.25;
shrink[2][2] = 1.0;
zoom[2][2] = 1.0;
}
}
/********************************************************************
*
* function: resize()
*
* purpose: Recalculate bounding box of surface.
* Also initializes clip_view and slice_view if empty.
*
*/
void resize()
{
int i,j,k;
vertex_id v_id;
REAL size;
/* if domain is torus, get torus fundamental cell in view */
if ( web.torus_flag )
{
for ( i = 0 ; i < SDIM ; i++ ) /* coordinate loop */
{
low[i] = high[i] = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) /* axis loop */
if ( web.torus_period[j][i] < 0.0 ) low[i] += web.torus_period[j][i];
else high[i] += web.torus_period[j][i];
}
if ( transforms_flag )
{ REAL x[MAXCOORD+1];
for ( j = 0 ; j < SDIM ; j++ )
{
for ( i = 0 ; i < SDIM ; i++ ) x[i] = web.torus_period[j][i];
x[SDIM] = 1.0;
for ( k = 0 ; k < transform_count ; k++ )
{ REAL xx,newx[MAXCOORD+1];
matvec_mul(view_transforms[k],x,newx,SDIM+1,SDIM+1);
for ( i = 0 ; i < SDIM ; i++ )
{ xx = newx[i]/newx[SDIM]; /* project */
if ( xx < low[i] ) low[i] = xx;
if ( xx > high[i] ) high[i] = xx;
}
}
}
for ( i = 0 ; i < SDIM ; i++ ) x[i] = 0;
x[SDIM] = 1.0;
for ( k = 0 ; k < transform_count ; k++ )
{ REAL xx,newx[MAXCOORD+1];
matvec_mul(view_transforms[k],x,newx,SDIM+1,SDIM+1);
for ( i = 0 ; i < SDIM ; i++ )
{ xx = newx[i]/newx[SDIM]; /* project */
if ( xx < low[i] ) low[i] = xx;
if ( xx > high[i] ) high[i] = xx;
}
}
}
}
else if ( web.symmetry_flag )
{ edge_id e_id;
for ( i = 0 ; i < SDIM ; i++ ) /* initialize */
{ low[i] = 1e30;
high[i] = -1e30;
}
/* figure out how big window should be */
FOR_ALL_EDGES(e_id)
{ REAL *t;
REAL x[MAXCOORD+1],y[MAXCOORD+1];
t = get_coord(get_edge_tailv(e_id));
for ( i = 0 ; i < SDIM ; i++ ) x[i] = t[i];
(*sym_wrap)(get_coord(get_edge_headv(e_id)),y,get_edge_wrap(e_id));
x[SDIM] = y[SDIM] = 1.0; /* homogeneous coord */
for ( i = 0 ; i < SDIM ; i++ )
{ if ( x[i] < low[i] ) low[i] = x[i];
if ( x[i] > high[i] ) high[i] = x[i];
if ( y[i] < low[i] ) low[i] = y[i];
if ( y[i] > high[i] ) high[i] = y[i];
}
if ( transforms_flag )
for ( j = 0 ; j < transform_count ; j++ )
{ REAL xx,newx[MAXCOORD+1];
matvec_mul(view_transforms[j],x,newx,SDIM+1,SDIM+1);
for ( i = 0 ; i < SDIM ; i++ )
{ xx = newx[i]/newx[SDIM]; /* project */
if ( xx < low[i] ) low[i] = xx;
if ( xx > high[i] ) high[i] = xx;
}
matvec_mul(view_transforms[j],y,newx,SDIM+1,SDIM+1);
for ( i = 0 ; i < SDIM ; i++ )
{ xx = newx[i]/newx[SDIM]; /* project */
if ( xx < low[i] ) low[i] = xx;
if ( xx > high[i] ) high[i] = xx;
}
}
}
}
else
{
for ( i = 0 ; i < SDIM ; i++ ) /* initialize */
{ low[i] = 1e30;
high[i] = -1e30;
}
/* figure out how big window should be */
FOR_ALL_VERTICES(v_id)
{ REAL *x = get_coord(v_id);
if ( transform_count && transforms_flag )
{ REAL y[MAXCOORD+1];
for ( i = 0 ; i < SDIM ; i++ ) y[i] = x[i];
y[SDIM] = 1.0; /* homogeneous coord */
for ( j = 0 ; j < transform_count ; j++ )
{ REAL xx,newx[MAXCOORD+1];
matvec_mul(view_transforms[j],y,newx,SDIM+1,SDIM+1);
if ( fabs(newx[SDIM]) < 1e-12 )
{ sprintf(errmsg,"View transform matrix %d is singular.\n",j+1);
kb_error(1045,errmsg,WARNING);
}
else
for ( i = 0 ; i < SDIM ; i++ )
{ xx = newx[i]/newx[SDIM];;
if ( xx < low[i] ) low[i] = xx;
if ( xx > high[i] ) high[i] = xx;
}
}
} /* end transforms */
else /* just plain vertices */
for ( i = 0 ; i < SDIM ; i++ )
{ if ( x[i] < low[i] ) low[i] = x[i];
if ( x[i] > high[i] ) high[i] = x[i];
}
}
}
for ( i = 0 ; i < SDIM ; i++ ) mid[i] = (low[i] + high[i])/2;
size = high[2] - low[2];
if ( high[1] - low[1] > size ) size = high[1] - low[1];
if ( high[0] - low[0] > size ) size = high[0] - low[0];
/* transformation matrix will be set up to scale object into
[-1,1]^3 cube */
matcopy(view,identmat,HOMDIM,HOMDIM);
if ( size != 0.0 )
for ( i = 0 ; i < HOMDIM-1 ; i++ )
{ view[i][i] = 2/size;
view[i][HOMDIM-1] = -mid[i]*2/size;
}
if ( to_focus ) /* for oglgraph.c focus reset */
{ matcopy(to_focus,identmat,HOMDIM,HOMDIM);
matcopy(from_focus,identmat,HOMDIM,HOMDIM);
}
/* see if clip_view and slice_view need defaults */
if ( (clip_coeff[0][0] == 0.0) &&
(clip_coeff[0][1] == 0.0) &&
(clip_coeff[0][2] == 0.0))
{ clip_coeff[0][0] = 1.0;
clip_coeff[0][3] = mid[0];
}
if ( (slice_coeff[0] == 0.0) &&
(slice_coeff[1] == 0.0) &&
(slice_coeff[2] == 0.0))
{ slice_coeff[0] = 1.0;
slice_coeff[3] = mid[0];
}
overall_size = size; /* for anybody who wants to know how big */
if ( !user_thickness_flag ) thickness = 0.001*size;
}
/********************************************************************
*
* function: fix_ctm()
*
* Rotates coordinate transformation matrix according to how mouse
* dragged.
*/
void fix_ctm(viewmat,dx,dy)
REAL **viewmat; /* matrix to modify */
REAL dx,dy; /* pixels mouse dragged */
{
MAT2D(rot,MAXCOORD+1,MAXCOORD+1);
REAL alpha; /* angle around axis */
REAL theta; /* tilt of rotation axis */
int i,j;
for ( i = 0 ; i < HOMDIM ; i++ )
{ for ( j = 0 ; j < HOMDIM ; j++ )
rot[i][j] = 0.0;
rot[i][i] = 1.0;
}
alpha = sqrt(dx*dx + dy*dy)/300; /* one radian per 300 pixels */
if ( dx == 0.0 )
{ if ( dy > 0.0 ) theta = M_PI/2;
else if ( dy < 0.0 ) theta = -M_PI/2;
else goto ctm_exit; /* no change */
}
else
{ theta = atan(dy/dx);
if ( dx < 0.0 ) alpha = - alpha;
}
if ( SDIM == 2 )
{
/* tilt axis */
rot[2][2] = 1.0;
rot[0][0] = rot[1][1] = cos(theta);
rot[0][1] = sin(theta);
rot[1][0] = -sin(theta);
mat_mult(rot,viewmat,viewmat,HOMDIM,HOMDIM,HOMDIM);
/* rotate */
rot[2][2] = rot[0][0] = cos(alpha);
rot[2][0] = -sin(alpha);
rot[0][2] = sin(alpha);
rot[1][1] = 1.0;
rot[0][1] = rot[1][0] = 0.0;
mat_mult(rot,viewmat,viewmat,HOMDIM,HOMDIM,HOMDIM);
/* untilt axis */
rot[2][2] = 1.0;
rot[0][0] = rot[1][1] = cos(theta);
rot[0][1] = -sin(theta);
rot[1][0] = sin(theta);
rot[2][0] = rot[0][2] = 0.0;
}
else
{
/* tilt axis */
rot[0][0] = 1.0;
rot[1][1] = rot[2][2] = cos(theta);
rot[1][2] = sin(theta);
rot[2][1] = -sin(theta);
mat_mult(rot,viewmat,viewmat,HOMDIM,HOMDIM,HOMDIM);
/* rotate */
rot[0][0] = rot[1][1] = cos(alpha);
rot[0][1] = -sin(alpha);
rot[1][0] = sin(alpha);
rot[2][2] = 1.0;
rot[1][2] = rot[2][1] = 0.0;
mat_mult(rot,viewmat,viewmat,HOMDIM,HOMDIM,HOMDIM);
/* untilt axis */
rot[0][0] = 1.0;
rot[1][1] = rot[2][2] = cos(theta);
rot[1][2] = -sin(theta);
rot[2][1] = sin(theta);
rot[0][1] = rot[1][0] = 0.0;
}
mat_mult(rot,viewmat,viewmat,HOMDIM,HOMDIM,HOMDIM);
ctm_exit: ;
} /* end fix_ctm() */
evolver-2.30c.dfsg/src/method5.c 0000644 0001753 0001753 00000153625 11410765113 016742 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
* *
* Code for SVK and Neo_hookean submitted by *
* Dr. Rabah Bouzidi *
* Institut de Recherche en Gnie Civil et Mcanique *
* (Civil Engineering and Mechanical Research Institut) *
* Nantes University *
* France *
* Tl : +33 2 51 12 55 23 *
* rabah.bouzidi@physique.univ-nantes.fr *
*************************************************************/
#include "include.h"
REAL LambertW ARGS((REAL));
/************************************************************************
Named method: SVK (Saint-Venant - Kirchhoff) potential
Psi = lambda/2*(tr(E))^2+mu*(E:E) - (3 lambda + 2 mu) * alpha*(theta)*tr(E)
with E=(C-I)/2 the Green-Lagrange Strain tensor
theta = T-T0 : temperture variation
alpha : thermal dilation coefficient
Written by Dr. Rabah Bouzidi
************************************************************************/
#define LAMBDA_NAME "SVK_lambda"
#define MU_NAME "SVK_mu"
#define ALPHA_NAME "SVK_alpha"
#define THETA_NAME "SVK_theta"
#define FORM_FACTORS_NAME "form_factors"
static int lambda_attr; /* number of lambda extra attribute */
static int mu_attr; /* number of mu extra attribute */
static int alpha_attr ; /* number of alpha extra attribute */
static int theta_attr ; /* number of theta extra attribute */
extern int form_factors_attr; /* number of form_factors extra attribute */
/***************************************************************
*
* function: SVK_init()
*
* purpose: Make sure needed extra attributes are present.
*
*/
void SVK_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2811,"Saint-Veant - Kirchhoff method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(2812,"Saint-Veant - Kirchhoff method only for SOAPFILM model.\n",
RECOVERABLE);
/* extra edge atribute */
lambda_attr = find_attribute(FACET,LAMBDA_NAME);
if ( lambda_attr < 0 ) /* not found */
kb_error(2813,"Facet extra attribute SVK_lambda missing. Needed by SVK_elastic method.\n",RECOVERABLE);
mu_attr = find_attribute(FACET,MU_NAME);
if ( mu_attr < 0 ) /* not found */
kb_error(2814,"Facet extra attribute SVK_mu missing. Needed by SVK_elastic method.\n",RECOVERABLE);
alpha_attr = find_attribute(FACET,ALPHA_NAME);
if ( alpha_attr < 0 ) /* not found */
kb_error(2815,"Facet extra attribute alpha missing. Needed by Saint-Veant - Kirchhoff.\n",RECOVERABLE);
theta_attr = find_attribute(FACET,THETA_NAME);
if ( theta_attr < 0 ) /* not found */
kb_error(2816,"Facet extra attribute theta missing. Needed by Saint-Veant - Kirchhoff.\n",RECOVERABLE);
form_factors_attr = find_attribute(FACET,FORM_FACTORS_NAME);
if ( form_factors_attr < 0 ) /* not found */
kb_error(2817,"Facet extra attribute form_factors real[3] missing. Needed by Saint-Veant - Kirchhoff.\n",RECOVERABLE);
if ( EXTRAS(FACET)[form_factors_attr].array_spec.datacount != 3 )
kb_error(2818,"Facet extra attribute form_factors must have size 3.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: SVK_all()
*
* purpose: energy, gradient, and hessian for linear_elastic method.
*/
REAL SVK_all ARGS((struct qinfo *,int));
REAL SVK_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL *s; /* pointer to extra attributes */
REAL **side;
REAL q11,q12,q22; /* Q entries */
REAL det; /* det S */
REAL lambda; /* lambda coefficient */
REAL area; /* reference area of facet (area of facet in initial configuration - undeformed facet)*/
REAL mu; /* mu coefficient */
REAL alpha; /* Thermic dilatation coefficient */
REAL theta ; /* Relative variation of temperture to the the reference state's temperature*/
REAL f11,f12,f22;
REAL c11,c12,c21,c22;
REAL energy;
REAL dc11dv[FACET_VERTS][MAXCOORD];
REAL dc12dv[FACET_VERTS][MAXCOORD];
REAL dc21dv[FACET_VERTS][MAXCOORD];
REAL dc22dv[FACET_VERTS][MAXCOORD];
REAL ddc11dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc12dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc21dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc22dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
/* Potential derivatives */
REAL dpsirdc11,dpsirdc12,dpsirdc21,dpsirdc22;
REAL ddpsirdc11dc11, ddpsirdc11dc12, ddpsirdc11dc21, ddpsirdc11dc22;
REAL ddpsirdc12dc11, ddpsirdc12dc12, ddpsirdc12dc21, ddpsirdc12dc22;
REAL ddpsirdc21dc11, ddpsirdc21dc12, ddpsirdc21dc21, ddpsirdc21dc22;
REAL ddpsirdc22dc11, ddpsirdc22dc12, ddpsirdc22dc21, ddpsirdc22dc22;
int i,j,ii,jj;
lambda = *(REAL*)get_extra(f_info->id,lambda_attr);
mu = *(REAL*)get_extra(f_info->id,mu_attr);
alpha = *(REAL*)get_extra(f_info->id,alpha_attr);
theta = *(REAL*)get_extra(f_info->id,theta_attr);
s = (REAL*)get_extra(f_info->id,form_factors_attr);
det = s[0]*s[2] - s[1]*s[1];
if ( det <= 0.0 )
{
if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg," SVK_elastic: Facet %d has unstrained area 0.\n",
ordinal(f_info->id)+1);
kb_error(2895,errmsg,RECOVERABLE);
}
area = sqrt(det)/2.0;
q11 = s[2]/det; q12 = -s[1]/det; q22 = s[0]/det;
side = f_info->sides[0];
f11 = SDIM_dot(side[0],side[0]);
f12 = SDIM_dot(side[0],side[1]);
f22 = SDIM_dot(side[1],side[1]);
c11 = f11*q11 + f12*q12;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22;
/*
This exression of the potential takes into account the plane stress condition : Sig33 = 0,
This condition leads to the expression of c33, which can be written as a
function of c11 and c22 : c33 = -(lambda*(c11+c22-3)-2*mu)/(lambda+2*mu)
*/
energy =area*((2.0*mu+3.0*lambda)*alpha*theta*(-(2.0*mu+3.0*lambda)*alpha*theta-2.0*mu*(c11+c22-2.0))+((c22*c22+c11*c11+2.0*c12*c21+2.0-2.0*c11-2.0*c22)*mu*mu+(c11*c22+c12*c21+c22*c22+c11*c11+3.0-3.0*c11-3.0*c22)*lambda*mu))/(2.0*lambda+4.0*mu);
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < SDIM ; i++ )
{
dc11dv[1][i] = 2*side[0][i]*q11 + side[1][i]*q12;
dc11dv[2][i] = side[0][i]*q12;
dc12dv[1][i] = 2*side[0][i]*q12 + side[1][i]*q22;
dc12dv[2][i] = side[0][i]*q22;
dc21dv[1][i] = side[1][i]*q11;
dc21dv[2][i] = side[0][i]*q11 + 2*side[1][i]*q12;
dc22dv[1][i] = side[1][i]*q12;
dc22dv[2][i] = side[0][i]*q12 + 2*side[1][i]*q22;
dc11dv[0][i] = -(dc11dv[1][i] + dc11dv[2][i]);
dc12dv[0][i] = -(dc12dv[1][i] + dc12dv[2][i]);
dc21dv[0][i] = -(dc21dv[1][i] + dc21dv[2][i]);
dc22dv[0][i] = -(dc22dv[1][i] + dc22dv[2][i]);
}
dpsirdc11 = mu*((2.0*c11-2.0)*mu+2.0*lambda*c11-3.0*lambda+lambda*c22-4.0*alpha*theta*mu-6.0*alpha*theta*lambda)/(lambda+2.0*mu)/2.0;
dpsirdc12 = mu*c21/2.0;
dpsirdc21 = mu*c12/2.0;
dpsirdc22 = mu*((2.0*c22-2.0)*mu+2.0*lambda*c22-3.0*lambda+lambda*c11-4.0*alpha*theta*mu-6.0*alpha*theta*lambda)/(lambda+2.0*mu)/2.0;
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[j][i] = area*(dpsirdc11*dc11dv[j][i]
+dpsirdc12*dc12dv[j][i]
+dpsirdc21*dc21dv[j][i]
+dpsirdc22*dc22dv[j][i]);
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
ddc11dv[1][i][1] = 2*q11;
ddc11dv[1][i][2] = q12;
ddc11dv[2][i][1] = q12;
ddc11dv[2][i][2] = 0.0;
ddc12dv[1][i][1] = 2*q12;
ddc12dv[1][i][2] = q22;
ddc12dv[2][i][1] = q22;
ddc12dv[2][i][2] = 0.0;
ddc21dv[1][i][1] = 0.0;
ddc21dv[1][i][2] = q11;
ddc21dv[2][i][1] = q11;
ddc21dv[2][i][2] = 2*q12;
ddc22dv[1][i][1] = 0.0;
ddc22dv[1][i][2] = q12;
ddc22dv[2][i][1] = q12;
ddc22dv[2][i][2] = 2*q22;
for ( j = 1 ; j < FACET_VERTS; j++ )
{
ddc11dv[0][i][j] = -(ddc11dv[1][i][j] + ddc11dv[2][i][j]);
ddc12dv[0][i][j] = -(ddc12dv[1][i][j] + ddc12dv[2][i][j]);
ddc21dv[0][i][j] = -(ddc21dv[1][i][j] + ddc21dv[2][i][j]);
ddc22dv[0][i][j] = -(ddc22dv[1][i][j] + ddc22dv[2][i][j]);
ddc11dv[j][i][0] = -(ddc11dv[j][i][1] + ddc11dv[j][i][2]);
ddc12dv[j][i][0] = -(ddc12dv[j][i][1] + ddc12dv[j][i][2]);
ddc21dv[j][i][0] = -(ddc21dv[j][i][1] + ddc21dv[j][i][2]);
ddc22dv[j][i][0] = -(ddc22dv[j][i][1] + ddc22dv[j][i][2]);
}
ddc11dv[0][i][0] = -(ddc11dv[1][i][0] + ddc11dv[2][i][0]);
ddc12dv[0][i][0] = -(ddc12dv[1][i][0] + ddc12dv[2][i][0]);
ddc21dv[0][i][0] = -(ddc21dv[1][i][0] + ddc21dv[2][i][0]);
ddc22dv[0][i][0] = -(ddc22dv[1][i][0] + ddc22dv[2][i][0]);
}
ddpsirdc11dc11 = mu*(mu+lambda)/(lambda+2.0*mu);
ddpsirdc11dc12 = 0.0;
ddpsirdc11dc21 = 0.0 ;
ddpsirdc11dc22 = lambda*mu/(2.0*lambda+4.0*mu);
ddpsirdc12dc11 = 0.0;
ddpsirdc12dc12 = 0.0;
ddpsirdc12dc21 = mu/2.0;
ddpsirdc12dc22 = 0.0;
ddpsirdc21dc11 = 0.0;
ddpsirdc21dc12 = mu/2.0;
ddpsirdc21dc21 = 0.0;
ddpsirdc21dc22 = 0.0;
ddpsirdc22dc11 = mu*lambda/(2.0*lambda+4.0*mu);
ddpsirdc22dc12 = 0.0;
ddpsirdc22dc21 = 0.0;
ddpsirdc22dc22 = mu*(mu+lambda)/(lambda+2.0*mu) ;
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( jj = 0 ; jj < FACET_VERTS ; jj++ )
{
f_info->hess[j][jj][i][i] +=
area*(dpsirdc11*ddc11dv[j][i][jj]
+dpsirdc12*ddc21dv[j][i][jj]
+dpsirdc21*ddc12dv[j][i][jj]
+dpsirdc22*ddc22dv[j][i][jj]);
for ( ii = 0 ; ii < SDIM ; ii++ )
f_info->hess[j][jj][i][ii] +=
area*((ddpsirdc11dc11+ddpsirdc12dc11+ddpsirdc21dc11+ddpsirdc22dc11)*dc11dv[j][i]
+(ddpsirdc11dc12+ddpsirdc12dc12+ddpsirdc21dc12+ddpsirdc22dc12)*dc12dv[j][i]
+(ddpsirdc11dc21+ddpsirdc12dc21+ddpsirdc21dc21+ddpsirdc22dc21)*dc21dv[j][i]
+(ddpsirdc11dc22+ddpsirdc12dc22+ddpsirdc21dc22+ddpsirdc22dc22)*dc22dv[j][i]);
}
return energy;
}
/**************************************************************
*
* function: SVK_energy() (Saint-Veant - Kirchhoff potential)
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL SVK_energy(f_info)
struct qinfo *f_info;
{
return SVK_all(f_info,METHOD_VALUE);
}
/**************************************************************
*
* function: SVK_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL SVK_gradient(f_info)
struct qinfo *f_info;
{
return SVK_all(f_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: SVK_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL SVK_hessian(f_info)
struct qinfo *f_info;
{
return SVK_all(f_info,METHOD_HESSIAN);
}
/***********************************************************************/
/************************************************************************
Named method: Neo_Hookean
Written by Dr. Rabah Bouzidi
************************************************************************/
#define NEO_LAMBDA_NAME "neo_lambda"
#define NEO_MU_NAME "neo_mu"
#define FORM_FACTORS_NAME "form_factors"
/***************************************************************
*
* function: Neo_Hookean_init()
*
* purpose: Make sure needed extra attributes are present.
*
*/
void Neo_Hookean_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2819,"Neo_Hookean method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(2829,"Neo_Hookean method only for SOAPFILM model.\n",
RECOVERABLE);
/* extra edge atribute */
lambda_attr = find_attribute(FACET,NEO_LAMBDA_NAME);
if ( lambda_attr < 0 ) /* not found */
kb_error(2837,"Facet extra attribute neo_lambda missing. Needed by Neo_Hookean.\n",RECOVERABLE);
mu_attr = find_attribute(FACET,NEO_MU_NAME);
if ( mu_attr < 0 ) /* not found */
kb_error(2838,"Facet extra attribute neo_mu missing. Needed by Neo_Hookean.\n",RECOVERABLE);
form_factors_attr = find_attribute(FACET,FORM_FACTORS_NAME);
if ( form_factors_attr < 0 ) /* not found */
kb_error(2839,"Facet extra attribute form_factors real[3] missing. Needed by Neo_Hookean.\n",RECOVERABLE);
if ( EXTRAS(FACET)[form_factors_attr].array_spec.datacount != 3 )
kb_error(2850,"Facet extra attribute form_factors must have size 3.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: neo_Hookean_all()
*
* purpose: energy, gradient, and hessian for neo_Hookean method.
*/
REAL Neo_Hookean_all ARGS((struct qinfo *,int));
REAL Neo_Hookean_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL *s; /* pointer to extra attributes */
REAL **side;
REAL q11,q12,q22; /* Q entries */
REAL det; /* det S */
REAL lambda; /* coefficient lambda */
REAL area; /* reference area of facet */
REAL mu; /* coefficient mu */
REAL f11,f12,f22;
REAL c11,c12,c21,c22, c33;
REAL energy;
REAL dc11dv[FACET_VERTS][MAXCOORD];
REAL dc12dv[FACET_VERTS][MAXCOORD];
REAL dc21dv[FACET_VERTS][MAXCOORD];
REAL dc22dv[FACET_VERTS][MAXCOORD];
REAL ddc11dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc12dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc21dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc22dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
/* potential derivatives declaration */
REAL dpsirdc11,dpsirdc12,dpsirdc21,dpsirdc22;
REAL ddpsirdc11dc11, ddpsirdc11dc12, ddpsirdc11dc21, ddpsirdc11dc22;
REAL ddpsirdc12dc11, ddpsirdc12dc12, ddpsirdc12dc21, ddpsirdc12dc22;
REAL ddpsirdc21dc11, ddpsirdc21dc12, ddpsirdc21dc21, ddpsirdc21dc22;
REAL ddpsirdc22dc11, ddpsirdc22dc12, ddpsirdc22dc21, ddpsirdc22dc22;
REAL s1, s2, s3, s4, s5, s6, s7;
REAL LW, tmp1, tmp2, logtmp2;
int i,j,ii,jj;
REAL detr;
lambda = *(REAL*)get_extra(f_info->id,lambda_attr);
mu = *(REAL*)get_extra(f_info->id,mu_attr);
s = (REAL*)get_extra(f_info->id,form_factors_attr);
det = s[0]*s[2] - s[1]*s[1];
if ( det <= 0.0 )
{
if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg," Neo_Hookean: Facet %d has unstrained area 0.\n",
ordinal(f_info->id)+1);
kb_error(2852,errmsg,RECOVERABLE);
}
area = sqrt(det)/2.0;
q11 = s[2]/det; q12 = -s[1]/det; q22 = s[0]/det;
side = f_info->sides[0];
f11 = SDIM_dot(side[0],side[0]);
f12 = SDIM_dot(side[0],side[1]);
f22 = SDIM_dot(side[1],side[1]);
c11 = f11*q11 + f12*q12 ;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22;
detr = c11*c22-c12*c21;
/* plane stress condition */
LW = LambertW(2.0*mu/detr/lambda*exp(2.0*mu/lambda));
c33 = exp((-LW*lambda+2.0*mu)/lambda)/detr;
tmp1 = log(exp(-LW+2.0*mu/lambda));
tmp2 = exp(-(LW*lambda-2.0*mu)/lambda);
logtmp2 = log(tmp2);
energy =area*(mu*c11/2.0+mu*c22/2.0+mu/exp(LW)*pow(exp(mu/lambda),2.0)/(detr)/2.0-3.0/2.0*mu-mu*tmp1/2.0+lambda*pow(tmp1,2.0)/8.0);
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < SDIM ; i++ )
{
dc11dv[1][i] = 2*side[0][i]*q11 + side[1][i]*q12;
dc11dv[2][i] = side[0][i]*q12;
dc12dv[1][i] = 2*side[0][i]*q12 + side[1][i]*q22;
dc12dv[2][i] = side[0][i]*q22;
dc21dv[1][i] = side[1][i]*q11;
dc21dv[2][i] = side[0][i]*q11 + 2*side[1][i]*q12;
dc22dv[1][i] = side[1][i]*q12;
dc22dv[2][i] = side[0][i]*q12 + 2*side[1][i]*q22;
dc11dv[0][i] = -(dc11dv[1][i] + dc11dv[2][i]);
dc12dv[0][i] = -(dc12dv[1][i] + dc12dv[2][i]);
dc21dv[0][i] = -(dc21dv[1][i] + dc21dv[2][i]);
dc22dv[0][i] = -(dc22dv[1][i] + dc22dv[2][i]);
}
s1 = (1/(pow(detr,2.0))*LW/(1.0+LW)*c22*exp(-LW+2.0*mu/lambda)/2.0-1/(pow(detr,2.0))*c22*exp(-LW+2.0*mu/lambda)/2.0-LW/(1.0+LW)/(detr)*c22/2.0+1.0/2.0)*mu;
s2 = lambda*tmp1*LW/(1.0+LW)/(detr)*c22/4.0;
dpsirdc11 = s1+s2;
s1 = c21/4.0;
s4 = 2.0*mu*tmp2+2.0*mu*LW*c11*c22;
s3 = s4-2.0*mu*LW*c12*c21-lambda*logtmp2*LW*c11*c22+lambda*logtmp2*LW*c12*c21;
s4 = 1/(pow(detr,2.0))/(1.0+LW);
s2 = s3*s4;
dpsirdc12 = s1*s2;
s1 = c12/4.0;
s4 = 2.0*mu*tmp2+2.0*mu*LW*c11*c22;
s3 = s4-2.0*mu*LW*c12*c21-lambda*logtmp2*LW*c11*c22+lambda*logtmp2*LW*c12*c21;
s4 = 1/(pow(detr,2.0))/(1.0+LW);
s2 = s3*s4;
dpsirdc21 = s1*s2;
s1 = (1/(pow(detr,2.0))*LW/(1.0+LW)*c11*exp(-LW+2.0*mu/lambda)/2.0-1/(pow(detr,2.0))*c11*exp(-LW+2.0*mu/lambda)/2.0-LW/(1.0+LW)/(detr)*c11/2.0+1.0/2.0)*mu;
s2 = lambda*tmp1*LW/(1.0+LW)/(detr)*c11/4.0;
dpsirdc22 = s1+s2;
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[j][i] = area*(dpsirdc11*dc11dv[j][i]
+dpsirdc12*dc12dv[j][i]
+dpsirdc21*dc21dv[j][i]
+dpsirdc22*dc22dv[j][i]);
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
ddc11dv[1][i][1] = 2*q11;
ddc11dv[1][i][2] = q12;
ddc11dv[2][i][1] = q12;
ddc11dv[2][i][2] = 0.0;
ddc12dv[1][i][1] = 2*q12;
ddc12dv[1][i][2] = q22;
ddc12dv[2][i][1] = q22;
ddc12dv[2][i][2] = 0.0;
ddc21dv[1][i][1] = 0.0;
ddc21dv[1][i][2] = q11;
ddc21dv[2][i][1] = q11;
ddc21dv[2][i][2] = 2*q12;
ddc22dv[1][i][1] = 0.0;
ddc22dv[1][i][2] = q12;
ddc22dv[2][i][1] = q12;
ddc22dv[2][i][2] = 2*q22;
for ( j = 1 ; j < FACET_VERTS; j++ )
{
ddc11dv[0][i][j] = -(ddc11dv[1][i][j] + ddc11dv[2][i][j]);
ddc12dv[0][i][j] = -(ddc12dv[1][i][j] + ddc12dv[2][i][j]);
ddc21dv[0][i][j] = -(ddc21dv[1][i][j] + ddc21dv[2][i][j]);
ddc22dv[0][i][j] = -(ddc22dv[1][i][j] + ddc22dv[2][i][j]);
ddc11dv[j][i][0] = -(ddc11dv[j][i][1] + ddc11dv[j][i][2]);
ddc12dv[j][i][0] = -(ddc12dv[j][i][1] + ddc12dv[j][i][2]);
ddc21dv[j][i][0] = -(ddc21dv[j][i][1] + ddc21dv[j][i][2]);
ddc22dv[j][i][0] = -(ddc22dv[j][i][1] + ddc22dv[j][i][2]);
}
ddc11dv[0][i][0] = -(ddc11dv[1][i][0] + ddc11dv[2][i][0]);
ddc12dv[0][i][0] = -(ddc12dv[1][i][0] + ddc12dv[2][i][0]);
ddc21dv[0][i][0] = -(ddc21dv[1][i][0] + ddc21dv[2][i][0]);
ddc22dv[0][i][0] = -(ddc22dv[1][i][0] + ddc22dv[2][i][0]);
}
s1 = c22*c22/4.0;
s5 = 2.0*mu*pow(LW,2.0)*tmp2+4.0*mu*pow(LW,2.0)*c11*c22+4.0*mu*LW*c11*c22+4.0*mu*tmp2;
s4 = s5+4.0*mu*LW*tmp2-4.0*mu*pow(LW,2.0)*c12*c21-4.0*mu*LW*c12*c21+2.0*mu*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c12*c21;
s5 = s4-lambda*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c11*c22+lambda*pow(LW,3.0)*c11*c22+lambda*pow(LW,2.0)*c11*c22;
s6 = s5+lambda*logtmp2*pow(LW,3.0)*c12*c21-lambda*logtmp2*pow(LW,3.0)*c11*c22;
s7 = s6-lambda*pow(LW,3.0)*c12*c21;
s3 = s7+2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc11dc11 = s1*s2;
s1 = -c22*c21/4.0;
s5 = 2.0*mu*pow(LW,2.0)*tmp2+4.0*mu*pow(LW,2.0)*c11*c22+4.0*mu*LW*c11*c22+4.0*mu*tmp2;
s4 = s5+4.0*mu*LW*tmp2-4.0*mu*pow(LW,2.0)*c12*c21-4.0*mu*LW*c12*c21+2.0*mu*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c12*c21;
s5 = s4-lambda*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c11*c22+lambda*pow(LW,3.0)*c11*c22+lambda*pow(LW,2.0)*c11*c22;
s6 = s5+lambda*logtmp2*pow(LW,3.0)*c12*c21-lambda*logtmp2*pow(LW,3.0)*c11*c22;
s7 = s6-lambda*pow(LW,3.0)*c12*c21;
s3 = s7+2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc11dc12 = s1*s2;
s1 = -c22*c12/4.0;
s5 = 2.0*mu*pow(LW,2.0)*tmp2+4.0*mu*pow(LW,2.0)*c11*c22+4.0*mu*LW*c11*c22+4.0*mu*tmp2;
s4 = s5+4.0*mu*LW*tmp2-4.0*mu*pow(LW,2.0)*c12*c21-4.0*mu*LW*c12*c21+2.0*mu*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c12*c21;
s5 = s4-lambda*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c11*c22+lambda*pow(LW,3.0)*c11*c22+lambda*pow(LW,2.0)*c11*c22;
s6 = s5+lambda*logtmp2*pow(LW,3.0)*c12*c21-lambda*logtmp2*pow(LW,3.0)*c11*c22;
s7 = s6-lambda*pow(LW,3.0)*c12*c21;
s3 = s7+2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc11dc21 = s1*s2;
s3 = mu*tmp2*c12*c21/2.0+mu*LW*c11*c11*c22*c22/2.0+lambda*pow(LW,3.0)*c11*c11*c22*c22/4.0+lambda*pow(LW,2.0)*c11*c11*c22*c22/4.0-mu*pow(LW,3.0)*c12*c12*c21*c21/2.0;
s4 = s3-mu*pow(LW,2.0)*c12*c12*c21*c21-mu*LW*c12*c12*c21*c21/2.0;
s2 = s4+mu*c22*c11*tmp2/2.0+mu*LW*tmp2*c12*c21+mu*pow(LW,2.0)*tmp2*c12*c21/2.0;
s4 = s2-lambda*logtmp2*pow(LW,3.0)*c11*c22*c12*c21/4.0;
s3 = s4-lambda*logtmp2*pow(LW,2.0)*c11*c22*c12*c21/2.0-lambda*logtmp2*LW*c11*c11*c22*c22/4.0-lambda*pow(LW,3.0)*c11*c22*c12*c21/4.0;
s4 = s3-lambda*pow(LW,2.0)*c11*c22*c12*c21/4.0+mu*pow(LW,3.0)*c11*c22*c12*c21/2.0;
s5 = s4+mu*pow(LW,2.0)*c11*c22*c12*c21;
s1 = s5+lambda*logtmp2*pow(LW,3.0)*c12*c12*c21*c21/4.0+lambda*logtmp2*LW*c12*c12*c21*c21/4.0+lambda*logtmp2*pow(LW,2.0)*c12*c12*c21*c21/2.0;
s2 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
ddpsirdc11dc22 = s1*s2;
s1 = c21*c22/4.0;
s6 = lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s5 = s6+2.0*lambda*logtmp2*LW*c11*c22+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s6 = s5-2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21;
s4 = s6-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5-2.0*mu*pow(LW,3.0)*c11*c22+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc12dc11 = s1*s2;
s1 = -c21*c21/4.0;
s6 = lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s5 = s6+2.0*lambda*logtmp2*LW*c11*c22+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s6 = s5-2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21;
s4 = s6-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5-2.0*mu*pow(LW,3.0)*c11*c22+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc12dc12 = s1*s2;
s3 = -mu*LW*c12*c12*c21*c21/2.0-lambda*pow(LW,3.0)*c12*c12*c21*c21/4.0-lambda*pow(LW,2.0)*c12*c12*c21*c21/4.0+mu*pow(LW,3.0)*c11*c11*c22*c22/2.0+mu*pow(LW,2.0)*c11*c11*c22*c22;
s4 = s3+mu*c21*c12*tmp2/2.0+mu*pow(LW,2.0)*tmp2*c11*c22/2.0;
s2 = s4+mu*LW*tmp2*c11*c22-mu*pow(LW,2.0)*c12*c21*c11*c22+mu*tmp2*c11*c22/2.0;
s3 = s2+lambda*logtmp2*LW*c12*c12*c21*c21/4.0+lambda*pow(LW,3.0)*c12*c21*c11*c22/4.0+lambda*pow(LW,2.0)*c12*c21*c11*c22/4.0+mu*LW*c11*c11*c22*c22/2.0;
s4 = s3-mu*pow(LW,3.0)*c12*c21*c11*c22/2.0+lambda*logtmp2*pow(LW,2.0)*c12*c21*c11*c22/2.0;
s5 = s4+lambda*logtmp2*pow(LW,3.0)*c12*c21*c11*c22/4.0;
s1 = s5-lambda*logtmp2*pow(LW,3.0)*c11*c11*c22*c22/4.0-lambda*logtmp2*LW*c11*c11*c22*c22/4.0-lambda*logtmp2*pow(LW,2.0)*c11*c11*c22*c22/2.0;
s2 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
ddpsirdc12dc21 = s1*s2;
s1 = c21*c11/4.0;
s6 = lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s5 = s6+2.0*lambda*logtmp2*LW*c11*c22+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s6 = s5-2.0*lambda*logtmp2*LW*c12*c21-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21;
s4 = s6-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5-2.0*mu*pow(LW,3.0)*c11*c22+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc12dc22 = s1*s2;
s1 = c12*c22/4.0;
s5 = 4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s4 = s5-2.0*mu*pow(LW,3.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22;
s5 = s4+lambda*pow(LW,3.0)*c12*c21-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s6 = s5-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c12*c21;
s7 = s6+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s3 = s7+2.0*lambda*logtmp2*LW*c11*c22+lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc21dc11 = s1*s2;
s4 = -lambda*logtmp2*pow(LW,3.0)*c11*c11*c22*c22/4.0-lambda*logtmp2*LW*c11*c11*c22*c22/4.0;
s3 = s4-lambda*logtmp2*pow(LW,2.0)*c11*c11*c22*c22/2.0+lambda*logtmp2*pow(LW,3.0)*c21*c12*c11*c22/4.0-mu*LW*c21*c21*c12*c12/2.0;
s2 = s3+mu*tmp2*c11*c22/2.0+mu*LW*c11*c11*c22*c22/2.0-lambda*pow(LW,3.0)*c21*c21*c12*c12/4.0-lambda*pow(LW,2.0)*c21*c21*c12*c12/4.0+mu*pow(LW,3.0)*c11*c11*c22*c22/2.0;
s3 = s2+mu*pow(LW,2.0)*c11*c11*c22*c22+mu*c12*c21*tmp2/2.0+mu*pow(LW,2.0)*tmp2*c11*c22/2.0+mu*LW*tmp2*c11*c22;
s4 = s3-mu*pow(LW,2.0)*c21*c12*c11*c22-mu*pow(LW,3.0)*c21*c12*c11*c22/2.0;
s1 = s4+lambda*logtmp2*LW*c21*c21*c12*c12/4.0+lambda*logtmp2*pow(LW,2.0)*c21*c12*c11*c22/2.0+lambda*pow(LW,3.0)*c21*c12*c11*c22/4.0+lambda*pow(LW,2.0)*c21*c12*c11*c22/4.0;
s2 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
ddpsirdc21dc12 = s1*s2;
s1 = -c12*c12/4.0;
s5 = 4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s4 = s5-2.0*mu*pow(LW,3.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22;
s5 = s4+lambda*pow(LW,3.0)*c12*c21-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s6 = s5-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c12*c21;
s7 = s6+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s3 = s7+2.0*lambda*logtmp2*LW*c11*c22+lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc21dc21 = s1*s2;
s1 = c12*c11/4.0;
s5 = 4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s4 = s5-2.0*mu*pow(LW,3.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22;
s5 = s4+lambda*pow(LW,3.0)*c12*c21-4.0*mu*tmp2-4.0*mu*LW*tmp2-2.0*mu*pow(LW,2.0)*tmp2;
s6 = s5-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21-2.0*lambda*logtmp2*LW*c12*c21;
s7 = s6+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22;
s3 = s7+2.0*lambda*logtmp2*LW*c11*c22+lambda*logtmp2*pow(LW,3.0)*c11*c22-lambda*logtmp2*pow(LW,3.0)*c12*c21;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc21dc22 = s1*s2;
s3 = mu*LW*c22*c22*c11*c11/2.0-mu*pow(LW,3.0)*c12*c12*c21*c21/2.0-mu*pow(LW,2.0)*c12*c12*c21*c21-mu*LW*c12*c12*c21*c21/2.0+lambda*pow(LW,2.0)*c22*c22*c11*c11/4.0;
s4 = s3+lambda*pow(LW,3.0)*c22*c22*c11*c11/4.0+mu*LW*tmp2*c12*c21;
s2 = s4+mu*c11*c22*tmp2/2.0-lambda*logtmp2*pow(LW,3.0)*c22*c11*c12*c21/4.0-lambda*logtmp2*pow(LW,2.0)*c22*c11*c12*c21/2.0;
s3 = s2-lambda*pow(LW,3.0)*c22*c11*c12*c21/4.0-lambda*pow(LW,2.0)*c22*c11*c12*c21/4.0-lambda*logtmp2*LW*c22*c22*c11*c11/4.0+mu*pow(LW,3.0)*c22*c11*c12*c21/2.0;
s4 = s3+mu*pow(LW,2.0)*c22*c11*c12*c21+mu*tmp2*c12*c21/2.0;
s5 = s4+mu*pow(LW,2.0)*tmp2*c12*c21/2.0;
s1 = s5+lambda*logtmp2*pow(LW,2.0)*c12*c12*c21*c21/2.0+lambda*logtmp2*pow(LW,3.0)*c12*c12*c21*c21/4.0+lambda*logtmp2*LW*c12*c12*c21*c21/4.0;
s2 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
ddpsirdc22dc11 = s1*s2;
s1 = c11*c21/4.0;
s6 = -4.0*mu*LW*tmp2-2.0*lambda*logtmp2*LW*c12*c21;
s5 = s6-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c11*c22;
s6 = s5+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22-2.0*mu*pow(LW,2.0)*tmp2;
s4 = s6-lambda*logtmp2*pow(LW,3.0)*c12*c21+lambda*logtmp2*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c11*c22;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21-4.0*mu*tmp2;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
ddpsirdc22dc12 = s1*s2;
s1 = c11*c12/4.0;
s6 = -4.0*mu*LW*tmp2-2.0*lambda*logtmp2*LW*c12*c21;
s5 = s6-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c11*c22;
s6 = s5+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22-2.0*mu*pow(LW,2.0)*tmp2;
s4 = s6-lambda*logtmp2*pow(LW,3.0)*c12*c21+lambda*logtmp2*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c11*c22;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21-4.0*mu*tmp2;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc22dc21 = s1*s2;
s1 = -c11*c11/4.0;
s6 = -4.0*mu*LW*tmp2-2.0*lambda*logtmp2*LW*c12*c21;
s5 = s6-2.0*lambda*logtmp2*pow(LW,2.0)*c12*c21+2.0*lambda*logtmp2*LW*c11*c22;
s6 = s5+2.0*lambda*logtmp2*pow(LW,2.0)*c11*c22-2.0*mu*pow(LW,2.0)*tmp2;
s4 = s6-lambda*logtmp2*pow(LW,3.0)*c12*c21+lambda*logtmp2*pow(LW,3.0)*c11*c22-2.0*mu*pow(LW,3.0)*c11*c22;
s5 = s4+4.0*mu*pow(LW,2.0)*c12*c21+4.0*mu*LW*c12*c21-4.0*mu*pow(LW,2.0)*c11*c22-4.0*mu*LW*c11*c22;
s3 = s5+lambda*pow(LW,3.0)*c12*c21+lambda*pow(LW,2.0)*c12*c21-lambda*pow(LW,3.0)*c11*c22-lambda*pow(LW,2.0)*c11*c22+2.0*mu*pow(LW,3.0)*c12*c21-4.0*mu*tmp2;
s4 = 1/(pow(detr,3.0))/pow(1.0+LW,3.0);
s2 = s3*s4;
ddpsirdc22dc22 = s1*s2;
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( jj = 0 ; jj < FACET_VERTS ; jj++ )
{
f_info->hess[j][jj][i][i] +=
area*(dpsirdc11*ddc11dv[j][i][jj]
+dpsirdc12*ddc21dv[j][i][jj]
+dpsirdc21*ddc12dv[j][i][jj]
+dpsirdc22*ddc22dv[j][i][jj]);
for ( ii = 0 ; ii < SDIM ; ii++ )
f_info->hess[j][jj][i][ii] +=
area*((ddpsirdc11dc11+ddpsirdc12dc11+ddpsirdc21dc11+ddpsirdc22dc11)*dc11dv[j][i]
+(ddpsirdc11dc12+ddpsirdc12dc12+ddpsirdc21dc12+ddpsirdc22dc12)*dc12dv[j][i]
+(ddpsirdc11dc21+ddpsirdc12dc21+ddpsirdc21dc21+ddpsirdc22dc21)*dc21dv[j][i]
+(ddpsirdc11dc22+ddpsirdc12dc22+ddpsirdc21dc22+ddpsirdc22dc22)*dc22dv[j][i]);
}
return energy;
}
/* Lambert W function.
Was ~/C/LambertW.c written K M Briggs Keith dot Briggs at bt dot com 97 May 21.
Revised KMB 97 Nov 20; 98 Feb 11, Nov 24, Dec 28; 99 Jan 13; 00 Feb 23; 01 Apr 09
Computes Lambert W function, principal branch.
See LambertW1.c for -1 branch.
Returned value W(z) satisfies W(z)*exp(W(z))=z
test data...
W(1)= 0.5671432904097838730
W(2)= 0.8526055020137254914
W(20)=2.2050032780240599705
To solve (a+b*R)*exp(-c*R)-d=0 for R, use
R=-(b*W(-exp(-a*c/b)/b*d*c)+a*c)/b/c
Test:
gcc -DTESTW LambertW.c -o LambertW -lm && LambertW
Library:
gcc -O3 -c LambertW.c
*/
REAL LambertW(z)
REAL z;
{
int i;
const REAL eps=4.0e-16, em1=0.3678794411714423215955237701614608;
REAL p,e,t,w;
if (z<-em1 || !is_finite(z)) {
fprintf(stderr,"LambertW: bad argument %g, exiting.\n",z); exit(1);
}
if (0.0==z) return 0.0;
if (z<-em1+1e-4) { /* series near -em1 in sqrt(q) */
double q=z+em1,r=sqrt(q),q2=q*q,q3=q2*q;
w = -1.0
+2.331643981597124203363536062168*r
-1.812187885639363490240191647568*q
+1.936631114492359755363277457668*r*q
-2.353551201881614516821543561516*q2
+3.066858901050631912893148922704*r*q2
-4.175335600258177138854984177460*q3
+5.858023729874774148815053846119*r*q3
-8.401032217523977370984161688514*q3*q; /* error approx 1e-16 */
fprintf(stderr,"LambertW expression 1: W(%15.12g) = %15.12g \n",z,w);
return w;
}
/* initial approx for iteration... */
if (z<1.0) { /* series near 0 */
p=sqrt(2.0*(2.7182818284590452353602874713526625*z+1.0));
w=-1.0+p*(1.0+p*(-0.333333333333333333333+p*0.152777777777777777777777));
} else
w=log(z); /* asymptotic */
if (z>3.0) w-=log(w); /* useful? */
for (i=0; i<10; i++) { /* Halley iteration */
e=exp(w);
t=w*e-z;
p=w+1.0;
t/=e*p-0.5*(p+1.0)*t/p;
w-=t;
if (fabs(t)array_spec.dim != 2 || ex->array_spec.sizes[0] != 2 || ex->array_spec.sizes[1] != 2 )
kb_error(3204,
"Facet extra attribute elastic_basis must have dimension [2][2].\n",
RECOVERABLE);
ex = &EXTRAS(FACET)[coeff_attr];
if ( ex->array_spec.dim != 1 || ex->array_spec.sizes[0] != 6 )
kb_error(3205,
"Facet extra attribute elastic_coeff must have 1 dimension and size 6.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: general_linear_elastic_all()
*
* purpose: energy, gradient, and hessian for linear_elastic method.
*/
REAL general_linear_elastic_all ARGS((struct qinfo *,int));
REAL general_linear_elastic_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL s[2][2],*sptr; /* pointer to extra attributes */
REAL **side;
REAL q11,q12,q21,q22; /* Q entries */
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL * coeff; /* elastic coeff extra attribute */
REAL elastic_coeff[2][2][2][2];
REAL f11,f12,f21,f22;
REAL c11,c12,c21,c22;
REAL energy;
REAL dc11dv[FACET_VERTS][MAXCOORD];
REAL dc12dv[FACET_VERTS][MAXCOORD];
REAL dc21dv[FACET_VERTS][MAXCOORD];
REAL dc22dv[FACET_VERTS][MAXCOORD];
REAL ddc11dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc12dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc21dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc22dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
int i,j,ii,jj;
coeff = (REAL*)get_extra(f_info->id,coeff_attr);
elastic_coeff[0][0][0][0] = coeff[0];
elastic_coeff[1][1][1][1] = coeff[1];
elastic_coeff[0][0][1][1] = coeff[2];
elastic_coeff[1][1][0][0] = coeff[2];
elastic_coeff[0][0][0][1] = coeff[3]/2;
elastic_coeff[0][0][1][0] = coeff[3]/2;
elastic_coeff[0][1][0][0] = coeff[3]/2;
elastic_coeff[1][0][0][0] = coeff[3]/2;
elastic_coeff[1][1][1][0] = coeff[4]/2;
elastic_coeff[0][1][1][1] = coeff[4]/2;
elastic_coeff[1][0][1][1] = coeff[4]/2;
elastic_coeff[1][1][0][1] = coeff[4]/2;
elastic_coeff[1][0][1][0] = coeff[5]/4;
elastic_coeff[1][0][0][1] = coeff[5]/4;
elastic_coeff[0][1][0][1] = coeff[5]/4;
elastic_coeff[0][1][1][0] = coeff[5]/4;
/* get unstrained sides in columns of S and get inverse */
sptr = (REAL*)get_extra(f_info->id,elastic_base_attr);
s[0][0] = sptr[0]; s[1][0] = sptr[1]; s[0][1] = sptr[2]; s[1][1] = sptr[3];
det = s[0][0]*s[1][1] - s[0][1]*s[1][0];
if ( det == 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,
"general_linear_elastic: Facet %s has unstrained area 0.\n",
ELNAME(f_info->id));
kb_error(3206,errmsg,RECOVERABLE);
}
area = fabs(det)/2;
q11 = s[1][1]/det; q12 = -s[0][1]/det; q21 = -s[1][0]/det; q22 = s[0][0]/det;
/* Gram matrix of strained sides */
side = f_info->sides[0];
f11 = SDIM_dot(side[0],side[0]);
f21 = f12 = SDIM_dot(side[0],side[1]);
f22 = SDIM_dot(side[1],side[1]);
/* Strain matrix */
c11 = (q11*f11*q11 + q11*f12*q21 + q21*f21*q11 + q21*f22*q21 - 1)/2;
c12 = (q11*f11*q12 + q11*f12*q22 + q21*f21*q12 + q21*f22*q22)/2;
c21 = c12;
c22 = (q12*f11*q12 + q12*f12*q22 + q22*f21*q12 + q22*f22*q22 - 1)/2;
energy = c11*c11*elastic_coeff[0][0][0][0]
+ c11*c12*elastic_coeff[0][0][0][1]
+ c11*c22*elastic_coeff[0][0][1][1]
+ c11*c21*elastic_coeff[0][0][1][0]
+ c12*c11*elastic_coeff[0][1][0][0]
+ c12*c12*elastic_coeff[0][1][0][1]
+ c12*c22*elastic_coeff[0][1][1][1]
+ c12*c21*elastic_coeff[0][1][1][0]
+ c21*c11*elastic_coeff[1][0][0][0]
+ c21*c12*elastic_coeff[1][0][0][1]
+ c21*c22*elastic_coeff[1][0][1][1]
+ c21*c21*elastic_coeff[1][0][1][0]
+ c22*c11*elastic_coeff[1][1][0][0]
+ c22*c12*elastic_coeff[1][1][0][1]
+ c22*c22*elastic_coeff[1][1][1][1]
+ c22*c21*elastic_coeff[1][1][1][0] ;
energy *= area/2;
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < SDIM ; i++ )
{
dc11dv[1][i] = (q11*2*side[0][i]*q11 + q11*side[1][i]*q21 + q21*side[1][i]*q11 )/2;
dc11dv[2][i] = (q11*side[0][i]*q21 + q21*side[0][i]*q11 + q21*2*side[1][i]*q21 )/2;
dc12dv[1][i] = (q11*2*side[0][i]*q12 + q11*side[1][i]*q22 + q21*side[1][i]*q12 )/2;
dc12dv[2][i] = (q11*side[0][i]*q22 + q21*side[0][i]*q12 + q21*2*side[1][i]*q22 )/2;
dc21dv[1][i] = dc12dv[1][i];
dc21dv[2][i] = dc12dv[2][i];
dc22dv[1][i] = (q12*2*side[0][i]*q12 + q12*side[1][i]*q22 + q22*side[1][i]*q12 )/2;
dc22dv[2][i] = (q12*side[0][i]*q22 + q22*side[0][i]*q12 + q22*2*side[1][i]*q22 )/2;
dc11dv[0][i] = -(dc11dv[1][i] + dc11dv[2][i]);
dc12dv[0][i] = -(dc12dv[1][i] + dc12dv[2][i]);
dc21dv[0][i] = -(dc21dv[1][i] + dc21dv[2][i]);
dc22dv[0][i] = -(dc22dv[1][i] + dc22dv[2][i]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[j][i] = area*(
c11*dc11dv[j][i]*elastic_coeff[0][0][0][0]
+ c11*dc12dv[j][i]*elastic_coeff[0][0][0][1]
+ c11*dc22dv[j][i]*elastic_coeff[0][0][1][1]
+ c11*dc21dv[j][i]*elastic_coeff[0][0][1][0]
+ c12*dc11dv[j][i]*elastic_coeff[0][1][0][0]
+ c12*dc12dv[j][i]*elastic_coeff[0][1][0][1]
+ c12*dc22dv[j][i]*elastic_coeff[0][1][1][1]
+ c12*dc21dv[j][i]*elastic_coeff[0][1][1][0]
+ c21*dc11dv[j][i]*elastic_coeff[1][0][0][0]
+ c21*dc12dv[j][i]*elastic_coeff[1][0][0][1]
+ c21*dc22dv[j][i]*elastic_coeff[1][0][1][1]
+ c21*dc21dv[j][i]*elastic_coeff[1][0][1][0]
+ c22*dc11dv[j][i]*elastic_coeff[1][1][0][0]
+ c22*dc12dv[j][i]*elastic_coeff[1][1][0][1]
+ c22*dc22dv[j][i]*elastic_coeff[1][1][1][1]
+ c22*dc21dv[j][i]*elastic_coeff[1][1][1][0]);
/* don't need to divide by 2 here, since only doing
derivative of second term and using symmetry */
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
ddc11dv[1][i][1] = (q11*2*q11)/2;
ddc11dv[1][i][2] = ( q11*q21 + q21*q11 )/2;
ddc11dv[2][i][1] = (q11*q21 + q21*q11 )/2;
ddc11dv[2][i][2] = (q21*2*q21)/2;
ddc12dv[1][i][1] = (q11*2*q12 )/2;
ddc12dv[1][i][2] = ( q11*q22 + q21*q12 )/2;
ddc12dv[2][i][1] = (q11*q22 + q21*q12)/2;
ddc12dv[2][i][2] = (q21*2*q22 )/2;
ddc21dv[1][i][1] = ddc12dv[1][i][1];
ddc21dv[1][i][2] = ddc12dv[1][i][2];
ddc21dv[2][i][1] = ddc12dv[2][i][1];
ddc21dv[2][i][2] = ddc12dv[2][i][2];
ddc22dv[1][i][1] = (q12*2*q12)/2;
ddc22dv[1][i][2] = (q12*q22 + q22*q12)/2;
ddc22dv[2][i][1] = (q12*q22 + q22*q12)/2;
ddc22dv[2][i][2] = (q22*2*q22)/2;
for ( j = 1 ; j < FACET_VERTS; j++ )
{
ddc11dv[0][i][j] = -(ddc11dv[1][i][j] + ddc11dv[2][i][j]);
ddc12dv[0][i][j] = -(ddc12dv[1][i][j] + ddc12dv[2][i][j]);
ddc21dv[0][i][j] = -(ddc21dv[1][i][j] + ddc21dv[2][i][j]);
ddc22dv[0][i][j] = -(ddc22dv[1][i][j] + ddc22dv[2][i][j]);
ddc11dv[j][i][0] = -(ddc11dv[j][i][1] + ddc11dv[j][i][2]);
ddc12dv[j][i][0] = -(ddc12dv[j][i][1] + ddc12dv[j][i][2]);
ddc21dv[j][i][0] = -(ddc21dv[j][i][1] + ddc21dv[j][i][2]);
ddc22dv[j][i][0] = -(ddc22dv[j][i][1] + ddc22dv[j][i][2]);
}
ddc11dv[0][i][0] = -(ddc11dv[1][i][0] + ddc11dv[2][i][0]);
ddc12dv[0][i][0] = -(ddc12dv[1][i][0] + ddc12dv[2][i][0]);
ddc21dv[0][i][0] = -(ddc21dv[1][i][0] + ddc21dv[2][i][0]);
ddc22dv[0][i][0] = -(ddc22dv[1][i][0] + ddc22dv[2][i][0]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( jj = 0 ; jj < FACET_VERTS ; jj++ )
{
f_info->hess[j][jj][i][i] += area*(
c11*ddc11dv[j][i][jj]*elastic_coeff[0][0][0][0]
+ c11*ddc12dv[j][i][jj]*elastic_coeff[0][0][0][1]
+ c11*ddc22dv[j][i][jj]*elastic_coeff[0][0][1][1]
+ c11*ddc21dv[j][i][jj]*elastic_coeff[0][0][1][0]
+ c12*ddc11dv[j][i][jj]*elastic_coeff[0][1][0][0]
+ c12*ddc12dv[j][i][jj]*elastic_coeff[0][1][0][1]
+ c12*ddc22dv[j][i][jj]*elastic_coeff[0][1][1][1]
+ c12*ddc21dv[j][i][jj]*elastic_coeff[0][1][1][0]
+ c21*ddc11dv[j][i][jj]*elastic_coeff[1][0][0][0]
+ c21*ddc12dv[j][i][jj]*elastic_coeff[1][0][0][1]
+ c21*ddc22dv[j][i][jj]*elastic_coeff[1][0][1][1]
+ c21*ddc21dv[j][i][jj]*elastic_coeff[1][0][1][0]
+ c22*ddc11dv[j][i][jj]*elastic_coeff[1][1][0][0]
+ c22*ddc12dv[j][i][jj]*elastic_coeff[1][1][0][1]
+ c22*ddc22dv[j][i][jj]*elastic_coeff[1][1][1][1]
+ c22*ddc21dv[j][i][jj]*elastic_coeff[1][1][1][0]);
for ( ii = 0 ; ii < SDIM ; ii++ )
f_info->hess[j][jj][i][ii] += area*(
dc11dv[jj][ii]*dc11dv[j][i]*elastic_coeff[0][0][0][0]
+ dc11dv[jj][ii]*dc12dv[j][i]*elastic_coeff[0][0][0][1]
+ dc11dv[jj][ii]*dc22dv[j][i]*elastic_coeff[0][0][1][1]
+ dc11dv[jj][ii]*dc21dv[j][i]*elastic_coeff[0][0][1][0]
+ dc12dv[jj][ii]*dc11dv[j][i]*elastic_coeff[0][1][0][0]
+ dc12dv[jj][ii]*dc12dv[j][i]*elastic_coeff[0][1][0][1]
+ dc12dv[jj][ii]*dc22dv[j][i]*elastic_coeff[0][1][1][1]
+ dc12dv[jj][ii]*dc21dv[j][i]*elastic_coeff[0][1][1][0]
+ dc21dv[jj][ii]*dc11dv[j][i]*elastic_coeff[1][0][0][0]
+ dc21dv[jj][ii]*dc12dv[j][i]*elastic_coeff[1][0][0][1]
+ dc21dv[jj][ii]*dc22dv[j][i]*elastic_coeff[1][0][1][1]
+ dc21dv[jj][ii]*dc21dv[j][i]*elastic_coeff[1][0][1][0]
+ dc22dv[jj][ii]*dc11dv[j][i]*elastic_coeff[1][1][0][0]
+ dc22dv[jj][ii]*dc12dv[j][i]*elastic_coeff[1][1][0][1]
+ dc22dv[jj][ii]*dc22dv[j][i]*elastic_coeff[1][1][1][1]
+ dc22dv[jj][ii]*dc21dv[j][i]*elastic_coeff[1][1][1][0]);
}
return energy;
} /* end general_linear_elastic_all() */
/**************************************************************
*
* function: general_linear_elastic_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL general_linear_elastic_energy(f_info)
struct qinfo *f_info;
{
return general_linear_elastic_all(f_info,METHOD_VALUE);
}
/**************************************************************
*
* function: general_linear_elastic_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL general_linear_elastic_gradient(f_info)
struct qinfo *f_info;
{
return general_linear_elastic_all(f_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: general_linear_elastic_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL general_linear_elastic_hessian(f_info)
struct qinfo *f_info;
{
return general_linear_elastic_all(f_info,METHOD_HESSIAN);
}
/***********************************************************************/
/************************************************************************
Named method: dirichlet_elastic
Dirichlet elastic strain energy on facets.
For conformal mappings.
Let S be Gram matrix of unstrained facet (dots of sides).
Let Q be the inverse of S.
Let F be Gram matrix of strained facet.
Let C = FQ, the linear deformation matrix
Then energy density is
Tr(CC^T)
Each facet extra attribute array form_factors[3] = {s11,s12,s22}
where sij = dot(si,sj) and s1 = (v1-v0), s2 = (v2-v0).
************************************************************************/
#define FORM_FACTORS_NAME "form_factors"
extern int form_factors_attr; /* number of form_factors extra attribute */
/***************************************************************
*
* function: dirichlet_elastic_init()
*
* purpose: Make sure needed extra attributes are present.
*
*
*/
void dirichlet_elastic_init(mode,mi)
int mode; /* energy or gradient or hessian */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(4529,"dirichlet_elastic method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(4150,"dirichlet_elastic method only for SOAPFILM model.\n",
RECOVERABLE);
form_factors_attr = find_attribute(FACET,FORM_FACTORS_NAME);
if ( form_factors_attr < 0 ) /* not found */
kb_error(4152,"Facet extra attribute form_factors real[3] missing. Needed by dirichlet_elastic.\n",RECOVERABLE);
if ( EXTRAS(FACET)[form_factors_attr].array_spec.datacount < 3 )
kb_error(4153,"Facet extra attribute form_factors must have size 3.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: dirichlet_elastic_all()
*
* purpose: energy, gradient, and hessian for dirichlet_elastic method.
*/
REAL dirichlet_elastic_all ARGS((struct qinfo *,int));
REAL dirichlet_elastic_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL *s; /* pointer to extra attributes */
REAL **side;
REAL q11,q12,q22; /* Q entries */
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL f11,f12,f22;
REAL c11,c22;
REAL energy;
REAL dc11dv[FACET_VERTS][MAXCOORD];
REAL dc22dv[FACET_VERTS][MAXCOORD];
REAL ddc11dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc22dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
int i,j,jj;
s = (REAL*)get_extra(f_info->id,form_factors_attr);
det = s[0]*s[2] - s[1]*s[1];
if ( det <= 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,"dirichlet_elastic: Facet %s has unstrained area <= 0.\n",
ELNAME(f_info->id));
kb_error(4154,errmsg,RECOVERABLE);
}
area = sqrt(det)/2;
q11 = s[2]/det; q12 = -s[1]/det; q22 = s[0]/det;
side = f_info->sides[0];
f11 = SDIM_dot(side[0],side[0]);
f12 = SDIM_dot(side[0],side[1]);
f22 = SDIM_dot(side[1],side[1]);
c11 = f11*q11 + f12*q12;
c22 = f12*q12 + f22*q22;
energy = (c11 + c22)*area;
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < SDIM ; i++ )
{
dc11dv[1][i] = 2*side[0][i]*q11 + side[1][i]*q12;
dc11dv[2][i] = side[0][i]*q12;
dc22dv[1][i] = side[1][i]*q12;
dc22dv[2][i] = side[0][i]*q12 + 2*side[1][i]*q22;
dc11dv[0][i] = -(dc11dv[1][i] + dc11dv[2][i]);
dc22dv[0][i] = -(dc22dv[1][i] + dc22dv[2][i]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[j][i] = (dc11dv[j][i] + dc22dv[j][i]) * area;
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
ddc11dv[1][i][1] = 2*q11;
ddc11dv[1][i][2] = q12;
ddc11dv[2][i][1] = q12;
ddc11dv[2][i][2] = 0.0;
ddc22dv[1][i][1] = 0.0;
ddc22dv[1][i][2] = q12;
ddc22dv[2][i][1] = q12;
ddc22dv[2][i][2] = 2*q22;
for ( j = 1 ; j < FACET_VERTS; j++ )
{
ddc11dv[0][i][j] = -(ddc11dv[1][i][j] + ddc11dv[2][i][j]);
ddc22dv[0][i][j] = -(ddc22dv[1][i][j] + ddc22dv[2][i][j]);
ddc11dv[j][i][0] = -(ddc11dv[j][i][1] + ddc11dv[j][i][2]);
ddc22dv[j][i][0] = -(ddc22dv[j][i][1] + ddc22dv[j][i][2]);
}
ddc11dv[0][i][0] = -(ddc11dv[1][i][0] + ddc11dv[2][i][0]);
ddc22dv[0][i][0] = -(ddc22dv[1][i][0] + ddc22dv[2][i][0]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( jj = 0 ; jj < FACET_VERTS ; jj++ )
{
f_info->hess[j][jj][i][i] +=
(ddc11dv[j][i][jj] + ddc22dv[j][i][jj]) * area;
}
return energy;
}
/**************************************************************
*
* function: dirichlet_elastic_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL dirichlet_elastic_energy(f_info)
struct qinfo *f_info;
{
return dirichlet_elastic_all(f_info,METHOD_VALUE);
}
/**************************************************************
*
* function: dirichlet_elastic_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL dirichlet_elastic_gradient(f_info)
struct qinfo *f_info;
{
return dirichlet_elastic_all(f_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: dirichlet_elastic_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL dirichlet_elastic_hessian(f_info)
struct qinfo *f_info;
{
return dirichlet_elastic_all(f_info,METHOD_HESSIAN);
}
evolver-2.30c.dfsg/src/Makefile 0000644 0001753 0001753 00000023346 11410765113 016665 0 ustar hazelsct hazelsct # Makefile for Surface Evolver
SHELL= /bin/sh
# INSTRUCTIONS: Customize this makefile for your system by choosing
# your compiler (cc or gcc or whatever), and then uncomment the
# appropriate CFLAGS, GRAPH, and GRAPHLIB definitions for your system.
# If lines need to be modified for your system, please let me know
# at brakke@susqu.edu.
# The following systems have their own sections:
# Generic Unix
# Linux OpenGL
# Linux Xwindows
# cygwin
# Mac OSX
# Sun Xwindows
# 32-bint Solaris OpenGL
# 64-bint Solaris OpenGL
# NOTE: -DOOGL should be specified in CFLAGS if you want Evolver to
# be able to use geomview. And -DOOGL is harmless in any case.
# NOTE: You can use the readline input editing system (if your system has it)
# by adding -DUSE_READLINE to CFLAGS and -lreadline -lcurses to GRAPHLIB.
# But beware; readline may be incompatible with using geomview.
# Also, the readline code was contributed by a user for version 2.30,
# and may be incompatible with readline libraries on some systems (Mac,
# for instance).
#-----------------------------------------------------------------------------
# Pick your compiler, and add any options you want, such as optimization
CC= cc
#CC= gcc
#---------------------Start of system choices---------------------------------
# Remove #'s from following 3 lines for generic Unix without builtin graphics.
# Add -DOOGL to CFLAGS if you are using geomview.
#CFLAGS= -DGENERIC
#GRAPH= nulgraph.o
#GRAPHLIB=
#---- Generic Unix -----------------------------------------------------------
# Remove #'s from following 3 lines for generic Unix with X-windows.
# Add -DOOGL to CFLAGS if you are using geomview.
# You might have to add something like -I/usr/X11R6/include to CFLAGS if
# there is a problem finding Xlib.h while compiling xgraph.c, and add
# -L/usr/X11R6/lib to GRAPHLIB.
#CFLAGS= -DGENERIC
#GRAPH= xgraph.o
#GRAPHLIB= -lX11
#some places might have -lX11-mit
#----- Linux OpenGL ----------------------------------------------------------
# Remove #'s from following 3 lines for LINUX with OpenGL GLUT graphics.
# The graphics are on a second thread, so pthreads are needed.
# NOTE: -DPTRHEADS is necessary with glutgraph.o.
#CFLAGS= -DLINUX -DOOGL -DPTHREADS
#GRAPH= glutgraph.o
#GRAPHLIB= -lGL -lGLU -lglut -lpthread
# NOTE: It has been reported to me that RedHat 9 needs the following line
# for GRAPHLIB, but earlier and later versions do okay with the GRAPHLIB
# line just above.
#GRAPHLIB= -lGL -lGLU -lglut -L/usr/X11R6/lib -lXi -lXmu -lpthread
#------ Linux Xwindows ------------------------------------------------------
# Remove #'s from following 3 lines for LINUX with crummy Xwindows graphics.
# You may have to modify the X11 lib path given here.
#CFLAGS= -DLINUX -DOOGL
#GRAPH= xgraph.o
#GRAPHLIB= -L/usr/X11R6/lib -lX11
#-------- cygwin --------------------------------------------------------------
# Remove #'s from the following three lines for cygwin.
#CFLAGS= -DLINUX -DOOGL -DPTHREADS
#GRAPH= glutgraph.o
#GRAPHLIB= -lglut -lglu32 -lopengl32 -lpthread
#------- Mac OSX -------------------------------------------------------------
# Remove #'s from following 5 lines for MAC OSX with OpenGL GLUT graphics.
#INC=/System/Library/Frameworks/GLUT.framework/Versions/A/Headers
#CFLAGS= -DLINUX -DPTHREADS -DOOGL -DMAC_OS_X -I$(INC)
#GRAPH= glutgraph.o
#GLDIR=/System/Library/Frameworks/OpenGL.framework/Libraries
#GRAPHLIB= -L$(GLDIR) -lGL -lGLU -lobjc -framework GLUT
#------- Sun Xwindows --------------------------------------------------------
# Remove #'s from following 3 lines for SUNs or SPARCSTATIONs with X-windows
# WARNING: If you use -O2 optimization, you may have to compile popfilm.c
# without optimization, because sun optimization may hang.
#CFLAGS= -DSUN -DOOGL -I/usr/openwin/include
#GRAPH= xgraph.o
#GRAPHLIB= -L/usr/openwin/lib -lX11
#------- 32-bint Solaris OpenGL ------------------------------------------------------
# 32-bit SOLARIS with GLUT. The GLUT graphics window runs in a separate
# thread; -DPTHREADS enables threads in Evolver source code, and -mt
# enables it in the Solaris cc compiler. For the gcc compiler, use -pthreads
# instead of -mt.
# You should check to see that the GLUTHOME directory listed below exists;
# it may be some other place on your machine. If you can't find it,
# download glut-3.7b.sparc_solaris.tar.gz from www.sun.com.
#GLUTHOME= /usr/local/sparc_solaris/glut-3.7
#INCLUDE= -I/usr/openwin/include -I$(GLUTHOME)/include
#CFLAGS= -DSUN -DOOGL -DGLUT -DPTHREADS -mt $(INCLUDE)
#GRAPH= glutgraph.o
#GRAPHLIB= -L/usr/openwin/lib -lX11 -L$(GLUTHOME)/lib/glut -lglut -lGL -lGLU -lXmu
#------- 64-bint Solaris OpenGL ------------------------------------------------------
# 64-bit SOLARIS with GLUT. Also see 32 bit comments above.
# You should check to see that the GLUTHOME directory listed below exists;
# it may be some other place on your machine. If you can't find it,
# download glut-3.7b.sparc_solaris_64.tar.gz from www.sun.com.
#GLUTHOME= /usr/local/sparc_solaris_64bit/glut-3.7
#INCLUDE= -I/usr/openwin/include -I$(GLUTHOME)/include
#CFLAGS= -DSUN -DOOGL -DGLUT -DPTHREADS -mt $(INCLUDE) -m64
#GRAPH= glutgraph.o
#GRAPHLIB= -L/usr/openwin/lib -lX11 -L$(GLUTHOME)/lib/glut -lglut -lGL -lGLU -lXmu
#Note on Solaris:
#SOLARISFLAGS= -L/usr/ucblib -lucb -R/usr/ucblib -lnsl -lsocket
#are needed for some programs on Solaris; but not this one -- they're poison
#for Evolver!
#-----------------------------------------------------------------------------
# Remove #'s from following 3 lines for DEC Alpha with X-windows
# Add -DOOGL to CFLAGS if you have the X version of geomview.
#CFLAGS= -DDECALPHA -O -Olimit 2000
#GRAPH= xgraph.o
#GRAPHLIB= -lX11
#-----------------------------------------------------------------------------
# IRIX 4, with old gl graphics
# Remove #'s from the following three lines for Iris workstations with
# geomview. Those with R4000 CPUs or above may add -mips2 to CFLAGS.
#CFLAGS = -DIRIS -DOOGL -O2 -Olimit 3000
#GRAPH= iriszgraph.o
#GRAPHLIB= -lgl_s -lmalloc -lc_s
#-----------------------------------------------------------------------------
# IRIX 5
# Remove #'s from the following three lines for Iris workstations with
# geomview. Those with R4000 CPUs or above may add -mips2 to CFLAGS.
#CFLAGS = -DIRIS -DOOGL -O2 -Olimit 3000
#GRAPH= xgraph.o
#GRAPHLIB= -lmalloc -lX11
#-----------------------------------------------------------------------------
# IRIX 5, parallel
# Remove #'s from the following three lines for Iris workstations with
# multiple processors and geomview. OK for single processors, too.
# Those with R4000 CPUs or above may add -mips2 to CFLAGS.
#CFLAGS = -DIRIS -DOOGL -DSGI_MULTI -O2 -Olimit 3000 -mips2
#GRAPH= xgraph.o
#GRAPHLIB= -lmalloc -lX11
#-----------------------------------------------------------------------------
# IRIX 6
# Remove #'s from the following three lines for Iris workstations with
# IRIX 6.x operating system. Add -DSGI_MULTI to CLFAGS if you
# have multiple processors.
#CFLAGS = -DIRIS -DOOGL -O2 -OPT:Olimit=10000
#GRAPH= xgraph.o
#GRAPHLIB= -lmalloc -lX11
#-----------------------------------------------------------------------------
# Remove #'s from following 3 lines for HP workstation
# Omit -Aa if you're using gcc
#CFLAGS= -Aa -D_HPUX_SOURCE -I/usr/include/X11R5
#GRAPH= xgraph.o
#GRAPHLIB= -L/usr/lib/X11R5 -lX11
#-----------------------------------------------------------------------------
# Remove #'s from following 3 lines for NeXTStep without screen graphics
# (see separate ftp archive evolver.next.tar.Z for graphics version)
#CFLAGS= -DNeXT
#GRAPH= nulgraph.o
#GRAPHLIB=
#-------------------End of system-specific options----------------------------
OBJ= calcforc.o variable.o trirevis.o stringl.o stringq.o model.o\
fixvol.o query.o matrix.o grapher.o painter.o filml.o filmq.o\
torvol.o lexinit.o graphgen.o modify.o userio.o boundary.o\
curtest.o display.o yexparse.o lexyy.o ytab.o hessian.o\
evaltree.o cnstrnt.o verpopst.o popfilm.o machine.o veravg.o \
pixgraph.o tmain.o tordup.o wulff.o help.o psgraph.o check.o \
utility.o skeleton.o storage.o dump.o iterate.o filgraph.o zoom.o\
softimag.o mvgraph.o diffuse.o sqcurve.o klein.o\
command.o hidim.o simplex.o metric.o torus.o quotient.o alice.o\
sdrv.o odrv.o userfunc.o kusner.o simequi2.o\
geomgraph.o symtable.o exprint.o quantity.o meanint.o mindeg.o\
dodecGroup.o registry.o khyp.o gauss.o knot1.o eval_all.o\
lexinit2.o evalmore.o knot2.o knot3.o teix.o sqcurve2.o\
hessian2.o hessian3.o method1.o method2.o method3.o bk.o\
method4.o method5.o eval_sec.o sqcurve3.o metis.o lagrange.o
evolver: makemark $(OBJ) $(GRAPH)
$(CC) $(CFLAGS) $(OBJ) $(GRAPH) $(GRAPHLIB) -o evolver -lm
# This is to get global dependencies on the main header files.
makemark: skeleton.h storage.h model.h web.h
if [[ -z "$(GRAPH)" ]] ; then (echo "ERROR: You need to uncomment your system's lines in Makefile.") ; fi
rm *.o || true
touch makemark
.c.o:
$(CC) $(CFLAGS) -c $<
# lexyy.c and ytab.c should only be remade when interface
# language is changed, which users shouldn't be touching.
#lexyy.c: datafile.lex express.h ytab.c lex.h
# lex datafile.lex
# sed '/#ident/d' t.c
# sed '/int \* p, int m/s/(int \* p, int m)/(p,m) int *p,m;/' lexyy.c
# rm lex.yy.c
#ytab.c: command.yac express.h
# yacc -d command.yac
# sed '/#ident/d' tmp.c
# sed '/malloc()/d' ytab.c
# rm tmp.c
# cp y.tab.h ytab.h
# rm y.tab.c y.tab.h
ytab.h: ytab.c
lexinit.o: lex.h lexinit.c express.h ytab.h
query.o: lex.h ytab.h query.c
evaltree.o: evaltree.c lex.h ytab.h express.h
eval_all.o: eval_all.c lex.h ytab.h express.h
eval_sec.o: eval_all.c lex.h ytab.h express.h
yexparse.o: yexparse.c lex.h ytab.h express.h
exprint.o: exprint.c lex.h ytab.h express.h
tmain.o: tmain.c include.h
evolver-2.30c.dfsg/src/filml.c 0000644 0001753 0001753 00000053506 11410765113 016475 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* file: filml.c
*
* Contents: Functions calculating energy, volume, and their
* gradients for the LINEAR SOAPFILM model.
*/
#include "include.h"
REAL wee_area = 0.0;
/*********************************************************************
*
* Function: facet_energy_l()
*
* Purpose: Calculates energy due to facet for LINEAR SOAPFILM.
* Also does facet quantity integrands.
*/
void facet_energy_l(f_id,mode)
facet_id f_id;
int mode; /* AREA_ONLY or ALL_ENERGY */
{
int i,j;
REAL side[FACET_EDGES][MAXCOORD];
REAL normal[MAXCOORD];
REAL wulff[MAXCOORD]; /* energy covector to area normal vector */
REAL energy;
body_id b_id;
REAL *x[FACET_VERTS];
REAL unwrap_x[FACET_VERTS][MAXCOORD];
REAL z[FACET_VERTS]; /* for calculating average z*z */
REAL zz; /* for average z*z, for gravity */
REAL u; /* gravitational energy */
facetedge_id fe_id;
vertex_id v_id[FACET_VERTS];
REAL ss,st,tt;
REAL det;
#ifdef THREADS
struct thread_data *data = GET_THREAD_DATA;
#endif
int_val = ordinal(get_original(f_id))+1; /* for eval of file parameters */
/* get side vectors */
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
v_id[i] = get_fe_tailv(fe_id);
x[i] = unwrap_x[i];
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_id,x,NULL); /* in tail order */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = x[ii][j] - x[i][j];
z[i] = x[i][2];
}
if ( web.metric_flag )
{ if ( klein_metric_flag )
energy = klein_area(x);
else energy = simplex_energy_metric(v_id,x);
set_facet_area(f_id,energy);
goto skip_from_metric;
}
/* calculate surface tension energy */
ss = SDIM_dot(side[0],side[0]);
st = SDIM_dot(side[0],side[1]);
tt = SDIM_dot(side[1],side[1]);
det = ss*tt-st*st;
if ( det > 0.0 ) energy = sqrt(det)/2;
else energy = 0.0;
set_facet_area(f_id,energy);
if ( mode == AREA_ONLY ) return;
if ( web.wulff_flag )
{
/* calculate normal */
cross_prod(side[0],side[1],normal);
(*get_wulff)(normal,wulff);
energy = SDIM_dot(wulff,normal)/2;
}
/* do square curvature if wanted */
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE )
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy(v_id,side);
skip_from_metric:
#ifdef THREADS
if ( threadflag )
data->total_area = data->total_area + energy; /* Borland C bug */
else
#endif
binary_tree_add(web.total_area_addends,energy);
if ( get_fattr(f_id) & DENSITY )
energy = energy * get_facet_density(f_id); /* Borland C bug */
/* add gravitational energy, vector potential z*z/2*k */
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{
zz = (z[0]*z[0]+z[1]*z[1]+z[2]*z[2]+z[0]*z[1]+z[1]*z[2]+z[0]*z[2])/6;
u = zz*(side[0][0]*side[1][1]-side[0][1]*side[1][0])/2/2;
/* half for area, half from potential */
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
energy += u*get_body_density(b_id)*web.grav_const;
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
energy -= u*get_body_density(b_id)*web.grav_const;
}
#ifdef THREADS
if ( threadflag )
data->total_energy = data->total_energy + energy; /* Borland C bug */
else
#endif
binary_tree_add(web.total_energy_addends,energy);
} /* end facet_energy_l() */
/************************************************************************
*
* Function: facet_force_l()
*
* Purpose: Calculates all forces on control points due to facet and
* accumulates them at each control point.
*/
void facet_force_l(f_id)
facet_id f_id;
{
REAL side[FACET_EDGES][MAXCOORD];
REAL normal[MAXCOORD];
REAL wulff[MAXCOORD]; /* area vector covector for energy */
REAL temp[MAXCOORD];
int i,j;
REAL area;
facetedge_id fe_id;
REAL *x[FACET_VERTS];
REAL z[FACET_VERTS]; /* for gravitational forces */
body_id b_id;
REAL density = get_facet_density(f_id);
vertex_id v_id[FACET_VERTS];
edge_id e_id[FACET_EDGES];
REAL unwrap_x[FACET_VERTS][MAXCOORD];
WRAPTYPE wraps[FACET_VERTS];
REAL forces[FACET_VERTS][MAXCOORD]; /* total forces from this facet */
REAL *forceptr[FACET_VERTS]; /* pointers to forces */
REAL ss,st,tt;
memset((char*)forces,0,sizeof(forces)); /* set to 0 */
int_val = ordinal(get_original(f_id))+1; /* for eval of file parameters */
/* get side vectors */
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
e_id[i] = get_fe_edge(fe_id);
v_id[i] = get_edge_tailv(e_id[i]);
x[i] = unwrap_x[i];
forceptr[i] = forces[i];
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_id,x,wraps); /* verts in tail order */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = x[ii][j] - x[i][j];
z[i] = x[i][2];
}
if ( web.metric_flag )
{ if ( klein_metric_flag )
{ klein_area_grad(x,forceptr);
for ( i = 0 ; i < FACET_VERTS ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
forceptr[i][j] *= density;
area = klein_area(x);
}
else
{ simplex_force_metric(v_id,x,density,forceptr);
area = simplex_energy_metric(v_id,x);
}
goto end_euclidean;
}
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_force(v_id,e_id,side);
/* calculate area */
ss = SDIM_dot(side[0],side[0]);
st = SDIM_dot(side[0],side[1]);
tt = SDIM_dot(side[1],side[1]);
area = ss*tt-st*st;
if ( area < 0.0 ) area = 0.0; /* stupid inaccurate computers! */
area = sqrt(area)/2;
set_facet_area(f_id,area);
/* an error check, and accommodation for possibly deliberately
degenerate triangles on boundary */
if ( area <= wee_area )
{ facetedge_id ffe;
ffe = fe_id;
sprintf(errmsg,"WARNING! Zero area for facet %s.\n",ELNAME(f_id));
outstring(errmsg);
if ( itdebug )
{
outstring("Facet-edges and side vectors: \n");
for ( i = 0 ; i < FACET_EDGES ; i++, ffe = get_next_edge(ffe) )
{
sprintf(msg," %8lX %18.15f %18.15f %18.15f\n",ffe,
(DOUBLE)side[i][0],(DOUBLE)side[i][1],(DOUBLE)side[i][2]);
outstring(msg);
}
prompt("Hit RETURN to continue.",msg,msgmax);
}
return;
}
/* get energy covector */
if ( web.wulff_flag )
{
/* calculate normal */
cross_prod(side[0],side[1],normal);
(*get_wulff)(normal,wulff);
if ( get_fattr(f_id) & DENSITY )
for ( i = 0 ; i < SDIM ; i++ )
wulff[i] *= density;
/* force on each vertex */
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{ int k;
j = (i+1)%FACET_EDGES; /* opposite side */
cross_prod(side[j],wulff,temp);
for ( k = 0 ; k < SDIM ; k++ ) forces[i][k] += temp[k]/2;
}
}
else
{ REAL coeff = density/4/area;
int k;
for ( k = 0 ; k < SDIM ; k++ )
{ forces[0][k] += coeff*(side[0][k]*tt - st*side[1][k]);
forces[1][k] -= coeff*(side[0][k]*tt - st*side[1][k]);
forces[1][k] += coeff*(ss*side[1][k] - st*side[0][k]);
forces[2][k] -= coeff*(ss*side[1][k] - st*side[0][k]);
}
}
/* gravity forces, negative of gravity energy gradient */
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{ REAL zz; /* average z*z */
REAL gdensity; /* net density difference of bodies across facet */
REAL normz; /* facet normal component in z direction */
zz = (z[0]*z[0]+z[1]*z[1]+z[2]*z[2]+z[0]*z[1]+z[1]*z[2]+z[0]*z[2])/6;
b_id = get_facet_body(f_id);
gdensity = 0.0;
if ( valid_id(b_id) )
gdensity += get_body_density(b_id);
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
gdensity -= get_body_density(b_id);
normz = side[0][0]*side[1][1] - side[0][1]*side[1][0];
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{
j = (i+1)%FACET_EDGES; /* opposite side */
forces[i][0] += web.grav_const*gdensity*side[j][1]*zz/4;
forces[i][1] -= web.grav_const*gdensity*side[j][0]*zz/4;
forces[i][2] -= web.grav_const*gdensity*normz*(z[i]+z[0]+z[1]+z[2])/24;
}
}
end_euclidean:
/* accumulate star area around each vertex and edge */
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{ edge_id ee_id;
vertex_id vv_id;
ee_id = get_fe_edge(fe_id);
vv_id = get_edge_headv(ee_id);
add_vertex_star(vv_id,area);
add_edge_star(ee_id,area);
fe_id = get_next_edge(fe_id);
}
/* add to totals, unwrapping if necessary */
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{ REAL *force;
REAL wforce[MAXCOORD]; /* unwrapped forces */
force = get_force(v_id[i]);
if ( web.symmetry_flag )
{ (*sym_form_pullback)(get_coord(v_id[i]),wforce,forces[i],wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
force[j] += wforce[j];
}
else
{ for ( j = 0 ; j < SDIM ; j++ )
force[j] += forces[i][j];
}
}
} /* end facet_force_l() */
/**********************************************************************
*
* Function: facet_volume_l()
*
* Purpose: Find triangle's contribution to volumes of neighboring bodies.
* Volumes with respect to origin are calculated for each
* face, and then oriented contributions added for each body.
*/
void facet_volume_l(f_id)
facet_id f_id;
{
body_id b_id0,b_id1;
facetedge_id fe_id;
REAL vol;
if ( get_fattr(f_id) & NONCONTENT ) return;
int_val = ordinal(get_original(f_id))+1; /* for eval of file parameters */
b_id0 = get_facet_body(f_id);
b_id1 = get_facet_body(facet_inverse(f_id));
if ( !valid_id(b_id0) && !valid_id(b_id1) ) return;
if ( web.symmetric_content )
{ vertex_id v1,v2,v3;
facetedge_id next_fe;
fe_id = get_facet_fe(f_id);
next_fe = get_next_edge(fe_id);
v1 = get_fe_tailv(fe_id);
v2 = get_fe_headv(fe_id);
v3 = get_fe_headv(next_fe);
vol = triple_prod(get_coord(v1), get_coord(v2), get_coord(v3))/6;
}
else
{ MAT2D(x,MAXCOORD,MAXCOORD);
get_facet_verts(f_id,x,NULL);
vol = (x[0][2]+x[1][2]+x[2][2])/6*
((x[1][0]-x[0][0])*(x[2][1]-x[0][1])-(x[1][1]-x[0][1])*(x[2][0]-x[0][0]));
}
/* add to body volumes */
if ( valid_id(b_id0) )
add_body_volume(b_id0,vol);
if ( valid_id(b_id1) )
add_body_volume(b_id1,-vol);
} /* end facet_volume_l() */
/******************************************************************
*
* Function: film_grad_l()
*
* Purpose: Compute volume gradients for vertices on facets.
* Also fixed quantity gradients.
*/
#define NEWTORVOL
void film_grad_l()
{
body_id bi_id; /* identifier for body i */
body_id bj_id; /* identifier for body j */
facetedge_id fe;
vertex_id v_id;
facet_id f_id;
facetedge_id fe_id;
int i,k;
volgrad *vgptr;
REAL z;
REAL side[FACET_EDGES][MAXCOORD];
REAL normal[MAXCOORD];
REAL *x[FACET_VERTS]; /* coordinates of vertices */
REAL unwrap_x[FACET_VERTS][MAXCOORD];
#ifdef NEWTORVOL
struct qinfo f_info; /* for calling q_facet_torus_volume */
if ( web.torus_flag )
q_info_init(&f_info,METHOD_GRADIENT);
#endif
if ( sym_flags & NEED_FORM_UNWRAPPING )
kb_error(1035,"Have to do convert_to_quantities with this symmetry group.\n",RECOVERABLE);
FOR_ALL_FACETS(f_id)
{
WRAPTYPE wraps[3];
int_val = ordinal(get_original(f_id))+1; /* for eval of file parameters */
bi_id = get_facet_body(f_id);
bj_id = get_facet_body(facet_inverse(f_id));
if ( (!valid_id(bi_id) || !(get_battr(bi_id) & (FIXEDVOL|PRESSURE)) )
&& (!valid_id(bj_id) || !(get_battr(bj_id) & (FIXEDVOL|PRESSURE)) ) )
continue;
if ( web.torus_flag )
{
#ifdef NEWTORVOL
int n;
vertex_id v_ids[FACET_EDGES];
/* get basic info */
fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i ++ )
{ v_ids[i] = get_fe_tailv(fe);
fe = get_next_edge(fe);
}
f_info.id = f_id;
q_facet_setup(NULL,&f_info,NEED_SIDE|TORUS_MODULO_MUNGE|ORIENTABLE_METHOD);
q_facet_torus_volume_grad(&f_info);
if ( valid_id(bi_id) && (get_battr(bi_id) & (FIXEDVOL|PRESSURE)) )
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v_ids[i]);
vgptr->bb_id = bi_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] += f_info.grad[i][n];
}
if ( valid_id(bj_id) && (get_battr(bj_id) & (FIXEDVOL|PRESSURE)) )
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v_ids[i]);
vgptr->bb_id = bj_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] -= f_info.grad[i][n];
}
#else
/* kludge copy from torvol_project, so could ditch torvol_project */
REAL *v[FACET_VERTS]; /* pointers to three vertex coordinates */
int j;
REAL adj[FACET_EDGES][MAXCOORD]; /* torus wrap adjustments for edge */
vertex_id v_ids[FACET_VERTS];
int n;
REAL g[MAXCOORD];
/* get basic info */
fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i ++ )
{
v_ids[i] = get_fe_tailv(fe);
v[i] = get_coord(get_fe_tailv(fe));
get_edge_adjust(get_fe_edge(fe),adj[i]);
fe = get_next_edge(fe);
}
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
int m;
REAL ga[MAXCOORD],gb[MAXCOORD],gc[MAXCOORD],gd[MAXCOORD],
ge[MAXCOORD],gf[MAXCOORD]; /* gradient parts */
j = (i+1)%FACET_EDGES;
k = (i+2)%FACET_EDGES;
/* basic tetrahedron */
cross_prod(v[j],v[k],ga);
/* torus wrap corrections */
/* two-vertex term */
cross_prod(adj[j],v[j],gb); /* - */
cross_prod(adj[i],v[k],gc); /* + */
cross_prod(adj[k],v[j],gd); /* + */
cross_prod(adj[j],v[k],ge); /* - */
/* one-vertex term */
cross_prod(adj[k],adj[i],gf);
/* add parts to existing gradient */
for ( m = 0 ; m < SDIM ; m++ )
g[m] = (ga[m] + (-gb[m]+gc[m]+gd[m]-ge[m])/2 + gf[m])/6;
if ( valid_id(bi_id) && (get_battr(bi_id) & (FIXEDVOL|PRESSURE)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v_ids[i]);
vgptr->bb_id = bi_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] += g[n];
}
if ( valid_id(bj_id) && (get_battr(bj_id) & (FIXEDVOL|PRESSURE)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v_ids[i]);
vgptr->bb_id = bj_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] -= g[n];
}
}
#endif
}
else
{
vertex_id v[3];
/* get side vectors */
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
get_fe_side(fe_id,side[i]);
v[i] = get_fe_headv(fe_id);
x[i] = get_coord(v[i]);
fe_id = get_next_edge(fe_id);
}
if ( web.symmetry_flag )
{
for ( i = 0 ; i < FACET_VERTS ; i++ ) x[i] = unwrap_x[i];
get_facet_verts(f_id,x,wraps);
/* have to readjust indexing for agreement with nonsym way..
kludge, but don't want to risk massive changes */
for ( i = 0 ; i < FACET_VERTS ; i++ ) x[i] = unwrap_x[(i+1)%3];
for ( i = 0 ; i < SDIM ; i++ )
{ side[0][i] = x[0][i] - x[2][i];
side[1][i] = x[1][i] - x[0][i];
side[2][i] = x[2][i] - x[1][i];
}
}
if ( web.symmetric_content )
{
/* do each of the three vertices */
fe = get_facet_fe(f_id);
for ( k = 0 ; k < FACET_VERTS ; k++, fe = get_next_edge(fe) )
{
fe_id = get_next_edge(fe);
v_id = get_fe_headv(fe_id);
if ( get_vattr(v_id) & FIXED ) continue;
cross_prod(get_coord(get_fe_tailv(fe)),
get_coord(get_fe_headv(fe)),normal);
if ( valid_id(bi_id) && (get_battr(bi_id) & (PRESSURE|FIXEDVOL)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v_id);
vgptr->bb_id = bi_id;
for ( i = 0 ; i < SDIM ; i++ )
vgptr->grad[i] += normal[i]/6.0;
}
if ( valid_id(bj_id) && (get_battr(bj_id) & (PRESSURE|FIXEDVOL)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v_id);
vgptr->bb_id = bj_id;
for ( i = 0 ; i < SDIM ; i++ )
vgptr->grad[i] -= normal[i]/6.0;
}
}
}
else
{ /* content from integrating z dx dy */
/* get centroid z (divide by 3 later) */
for ( i = 0,z = 0.0; i < FACET_EDGES ; i++ ) z += x[i][2];
/* calculate normal */
cross_prod(side[0],side[1],normal);
/* now do each of the three vertices */
fe = get_facet_fe(f_id);
for ( k = 0 ; k < FACET_VERTS ; k++, fe = get_next_edge(fe) )
{
fe_id = get_next_edge(fe);
v_id = get_fe_headv(fe_id);
if ( get_vattr(v_id) & FIXED ) continue;
if ( valid_id(bi_id) && (get_battr(bi_id) & (PRESSURE|FIXEDVOL)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v_id);
vgptr->bb_id = bi_id;
vgptr->grad[0] += -side[k][1]*z/6.0;
vgptr->grad[1] += side[k][0]*z/6.0;
vgptr->grad[2] += normal[2]/6.0;
}
if ( valid_id(bj_id) && (get_battr(bj_id) & (PRESSURE|FIXEDVOL)) )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v_id);
vgptr->bb_id = bj_id;
vgptr->grad[0] -= -side[k][1]*z/6.0;
vgptr->grad[1] -= side[k][0]*z/6.0;
vgptr->grad[2] -= normal[2]/6.0;
}
}
}
} /* end torus/nontorus */
} /* end facet loop */
#ifdef NEWTORVOL
if ( web.torus_flag )
q_info_free(&f_info);
#endif
} /* end film_grad_l() */
/*******************************************************************
*
* Function: film_constr_grad()
*
* Purpose: Add cell volume gradients due to constraint integrals.
* And quantity integrals.
*/
void film_constr_grad()
{
edge_id e_id;
REAL side[MAXCOORD];
REAL tgrad[MAXCOORD];
REAL hgrad[MAXCOORD];
REAL grad;
int i,j,k,m,sign,bodysign=0;
REAL green[MAXCOORD];
REAL green_deriv[MAXCOORD][MAXCOORD];
REAL midpt[MAXCOORD];
REAL *tcoord,*hcoord;
struct constraint *constr;
vertex_id headv,tailv;
facetedge_id fe,first_fe;
FOR_ALL_EDGES(e_id)
{
struct volgrad *vgptri;
facet_id f_id;
ATTR attr = get_eattr(e_id);
conmap_t *conmap = get_e_constraint_map(e_id); /* only hit constraints */
if ( attr & FIXED ) continue;
if ( !(attr & CONSTRAINT) ) continue;
headv = get_edge_headv(e_id);
tailv = get_edge_tailv(e_id);
tcoord = get_coord(tailv);
hcoord = get_coord(headv);
int_val = ordinal(get_original(e_id))+1; /* for eval of file parameters */
for ( j = 0 ; j < SDIM ; j++ )
side[j] = hcoord[j] - tcoord[j];
if ( !(attr & BDRY_CONTENT) ) continue;
if ( web.modeltype == QUADRATIC )
{ constr_vol_grad_q(e_id);
continue;
}
else if ( web.modeltype == LAGRANGE )
kb_error(1036,"constr_vol_grad(): Cannot do LAGRANGE model.\n",RECOVERABLE);
if ( attr & NEGBOUNDARY ) sign = -1;
else sign = 1;
if ( inverted(e_id) ) sign = -sign;
for ( i = 0 ; i < SDIM ; i++ )
tgrad[i] = hgrad[i] = 0.0;
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
{
constr = get_constraint(conmap[j]);
if ( constr->compcount != SDIM ) continue;
if ( !(constr->attr & CON_CONTENT) ) continue;
for ( m = 0 ; m < gauss1D_num ; m++ )
{
for ( i = 0 ; i < SDIM ; i++ )
midpt[i] = gauss1Dpt[m]*hcoord[i] + (1 - gauss1Dpt[m])*tcoord[i];
for ( i = 0 ; i < SDIM ; i++ )
eval_all(constr->convect[i],midpt,SDIM,&green[i],
green_deriv[i],e_id);
for ( i = 0 ; i < SDIM ; i++ )
{
for ( k = 0,grad = 0.0 ; k < SDIM ; k++ )
grad += side[k]*green_deriv[k][i];
tgrad[i] += sign*gauss1Dwt[m]*((1-gauss1Dpt[m])*grad - green[i]);
hgrad[i] += sign*gauss1Dwt[m]*(gauss1Dpt[m]*grad + green[i]);
}
}
}
fe = first_fe = get_edge_fe(e_id);
if ( valid_id(fe) ) do
{ f_id = get_fe_facet(fe);
vgptri = get_vertex_vgrad(tailv);
for ( ; vgptri ; vgptri = vgptri->chain )
{
if ( !valid_id(vgptri->bb_id) ) continue; /* skip quantities */
if ( !equal_id(get_facet_body(f_id),vgptri->bb_id) )
{ if ( !equal_id(get_facet_body(inverse_id(f_id)),vgptri->bb_id) )
continue;
else bodysign = -sign;
}
else bodysign = sign;
for ( i = 0 ; i < SDIM ; i++ )
vgptri->grad[i] += bodysign*tgrad[i];
}
vgptri = get_vertex_vgrad(headv);
for ( ; vgptri ; vgptri = vgptri->chain )
{
if ( !valid_id(vgptri->bb_id) ) continue; /* skip quantities */
if ( !equal_id(get_facet_body(f_id),vgptri->bb_id) )
{ if ( !equal_id(get_facet_body(inverse_id(f_id)),vgptri->bb_id) )
continue;
else bodysign = -sign;
}
else bodysign = sign;
for ( i = 0 ; i < SDIM ; i++ )
vgptri->grad[i] += bodysign*hgrad[i];
}
fe = get_next_facet(fe);
} while ( valid_id(fe) && !equal_id(fe,first_fe) );
}
} /* end film_constr_grad() */
evolver-2.30c.dfsg/src/curtest.c 0000644 0001753 0001753 00000020157 11410765113 017057 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* File: curtest.c
*
* Purpose: Test curvature of quadratic soapfilms to see if
* the curvature is monotone.
*
*/
#include "include.h"
/*********************************************************************
*
* Function: curtest()
*
* Purpose: Overall control of curvature testing.
*
*/
void curtest()
{
facet_id f_id;
edge_id e_id;
int retval;
int edgetally[3],facettally[3];
int i;
if ( web.modeltype != QUADRATIC )
{ outstring("Cannot only do curvature sign test on QUADRATIC model.\n");
return;
}
for ( i = 0 ; i < 3; i++ )
edgetally[i] = facettally[i] = 0;
FOR_ALL_FACETS(f_id)
{
retval = curtest_facet(f_id);
if ( retval < 0 ) facettally[0]++;
else if ( retval == 0 ) facettally[1]++;
else facettally[2]++;
}
FOR_ALL_EDGES(e_id)
{
facetedge_id fe1,fe2;
fe1 = get_edge_fe(e_id);
if ( !valid_id(fe1) ) continue;
/* ensure orientation lines up with original definition */
if ( inverted(get_fe_facet(fe1)) )
{ invert(e_id);
invert(fe1);
}
fe2 = get_next_facet(fe1);
if ( equal_id(fe1,fe2) ) continue; /* only 1 facet on edge */
if ( !equal_id(fe1,get_next_facet(fe2)) ) continue; /* more than 2 */
retval = curtest_edge(e_id,fe1,fe2);
if ( retval < 0 ) edgetally[0]++;
else if ( retval == 0 ) edgetally[1]++;
else edgetally[2]++;
}
/* report results */
sprintf(msg,"\nPositive curvature edges: %6d\n",edgetally[2]);
outstring(msg);
sprintf(msg,"Negative curvature edges: %6d\n",edgetally[0]);
outstring(msg);
sprintf(msg,"Mixed curvature edges: %6d\n",edgetally[1]);
outstring(msg);
sprintf(msg,"Positive curvature facets: %6d\n",facettally[2]);
outstring(msg);
sprintf(msg,"Negative curvature facets: %6d\n",facettally[0]);
outstring(msg);
sprintf(msg,"Mixed curvature facets: %6d\n\n",facettally[1]);
outstring(msg);
}
/*******************************************************************
*
* Function: curtest_edge()
*
* Purpose: See if two facets meet along an edge with monotone
* meeting angle.
*
* Return: Sign of (normal 1) x (normal 2) . (edge)
* +1 for all positive
* -1 for all negative
* 0 otherwise
*/
/* evaluation points of cubic angle polynomial */
REAL uu[4] = {0.0, 0.7, 1.3, 2.0}; /* parameter along edge, 0 < u < 2 */
/* coefficients for finding polynomial coefficients */
REAL b1 = 0.3, b2 = 0.09, b3 = 0.027, denom = 1.0/(1 - 0.09);
int curtest_edge(e_id,fe_1,fe_2)
edge_id e_id; /* the edge */
facetedge_id fe_1,fe_2; /* link edge with facets */
{
REAL *x[2][FACET_CTRL]; /* pointers to sets of vertices, starting along edge */
REAL h[4]; /* values of curvature polynomial */
REAL a[4]; /* polynomial coefficients */
int i,j,k;
int sign; /* return value */
REAL tu[MAXCOORD]; /* common tangent along edge */
REAL tv[2][MAXCOORD]; /* the other tangent for each face */
REAL discr; /* quadratic formula discriminant */
REAL r[2]; /* quadratic roots */
REAL val; /* curvature values */
/* gather vertex coordinates */
x[0][0] = x[1][0] = get_coord(get_edge_tailv(e_id));
x[0][1] = x[1][1] = get_coord(get_edge_midv(e_id));
x[0][2] = x[1][2] = get_coord(get_edge_headv(e_id));
x[0][3] = get_coord(get_fe_midv(get_next_edge(fe_1)));
x[1][3] = get_coord(get_fe_midv(get_next_edge(fe_2)));
x[0][4] = get_coord(get_fe_headv(get_next_edge(fe_1)));
x[1][4] = get_coord(get_fe_headv(get_next_edge(fe_2)));
x[0][5] = get_coord(get_fe_midv(get_prev_edge(fe_1)));
x[1][5] = get_coord(get_fe_midv(get_prev_edge(fe_2)));
/* calculate test triple product at 4 points (it being cubic) */
for ( i = 0 ; i < 4 ; i++ )
{
/* edge tangent */
for ( j = 0 ; j < SDIM ; j++ )
{
tu[j] = x[0][0][j]*(uu[i] - 1.5) + 2*x[0][1][j]*(1 - uu[i])
+ x[0][2][j]*(uu[i] - 0.5);
for ( k = 0 ; k < 2 ; k++ )
tv[k][j] = x[k][0][j]*(uu[i] - 1.5) - x[k][1][j]*uu[i]
+ x[k][3][j]*uu[i] - 0.5*x[k][4][j]
+ x[k][5][j]*(2.0 - uu[i]);
}
h[i] = triple_prod(tv[0],tv[1],tu);
}
/* see if signs at endpoints same or opposite */
if ( (h[0] > 0.0) != (h[3] > 0.0) ) return 0;
if ( h[0] > 0.0 ) sign = 1;
else sign = -1;
/* get polynomial coefficients */
/* (remapping to points -1, -0.3, 0.3, 1) */
a[0] = (h[1] + h[2] - b2*(h[0] + h[3]))/denom;
a[1] = (h[2] - h[1] - b3*(h[3] - h[0]))/denom;
a[2] = (h[0] - h[2] + h[3] - h[1])/denom;
a[3] = (b1*(h[3] - h[0]) - (h[2] - h[1]))/denom;
/* now decide on sign of cubic polynomial fitting h[] */
/* find max and min points */
discr = a[2]*a[2] - 3*a[1]*a[3];
if ( discr <= 0.0 ) return sign; /* no critical points */
discr = sqrt(discr);
r[0] = (-a[2] + discr)/3/a[3];
r[1] = (-a[2] - discr)/3/a[3];
for ( i = 0 ; i < 2 ; i++ )
{ if ( (r[i] < -1.0) || (r[i] > 1.0) ) continue;
val = a[0] + r[i]*(a[1] + r[i]*(a[2] + r[i]*a[3]));
if ( (val > 0.0) != (h[0] > 0.0) ) return 0;
}
return sign;
}
/*******************************************************************
*
* Function: curtest_facet()
*
* Purpose: See if a facet has constant sign mean curvature.
*
* Return: Sign of curvature with respect to oriented facet:
* +1 for all positive
* -1 for all negative
* 0 otherwise
*/
int curtest_facet(f_id)
facet_id f_id;
{
REAL *x[FACET_CTRL]; /* pointers to coordinates */
facetedge_id fe;
REAL tt[2][2][MAXCOORD]; /* position second partials */
REAL tutu,tvtv,tutv,t[2][MAXCOORD];
int i,j,k,m;
int sign = 0; /* return value 1 or -1 at end if all same curvature */
REAL u,v;
REAL vv[MAXCOORD]; /* first variation vector, sort of */
REAL h; /* curvature at test point */
/* gather vertices */
fe = get_facet_fe(f_id);
x[0] = get_coord(get_fe_tailv(fe));
x[1] = get_coord(get_fe_midv(fe));
fe = get_next_edge(fe);
x[2] = get_coord(get_fe_tailv(fe));
x[3] = get_coord(get_fe_midv(fe));
fe = get_next_edge(fe);
x[4] = get_coord(get_fe_tailv(fe));
x[5] = get_coord(get_fe_midv(fe));
/* calculate position second partials (independent of u,v) */
for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < 2 ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
{ tt[i][j][k] = 0.0;
for ( m = 0 ; m < FACET_CTRL ; m++ )
tt[i][j][k] += poly2partial[m][i][j]*x[m][k];
}
/* loop for sampling curvature */
for ( u = 0.0 ; u < 2.00001 ; u += 0.4 )
for ( v = 0.0 ; u+v < 2.00001 ; v += 0.4 )
{
/* inner loop does test at one point */
/* calculate tangents */
for ( i = 0 ; i < 2 ; i++ )
for ( k = 0 ; k < SDIM ; k++ )
{ t[i][k] = 0.0;
for ( m = 0 ; m < FACET_CTRL ; m++ )
t[i][k] += intpoly6part(m,i,u,v)*x[m][k];
}
/* tangent dot products */
tutu = SDIM_dot(t[0],t[0]);
tutv = SDIM_dot(t[0],t[1]);
tvtv = SDIM_dot(t[1],t[1]);
/* assemble variation vector */
for ( k = 0 ; k < SDIM ; k++ )
vv[k] = 2*tutv*tt[0][1][k] - tutu*tt[1][1][k] - tvtv*tt[0][0][k];
/* test normal component */
h = triple_prod(t[0],t[1],vv);
if ( h > 0.0 )
{ if ( sign == 0 ) sign = 1;
else if ( sign < 0 ) return 0;
}
else
if ( sign == 0 ) sign = -1;
else if ( sign > 0 ) return 0;
/* end inner loop */
}
return sign;
}
evolver-2.30c.dfsg/src/oglgraph.c 0000644 0001753 0001753 00000162123 11410765113 017171 0 ustar hazelsct hazelsct /*********************************************************************
*
* File: oglgraph.c
*
* Contents: OpenGL display for Surface Evolver
* For OpenGL Version 1.1
*/
/* This runs in a separate thread from the main program, so it avoids
calling kb_error, since that would longjump to the wrong place.
Except for WARNINGS, which are OK since kb_error just returns.
*/
/* Some timings in various OpenGL drawing modes:
(done with cat.fe and gtime.cmd)(list, arrays exclude setup time)
(done in 'u' mode for 10 drawings; time for one reported here)
(flat shading for no arrays; doesn't matter for others)
facets edges no arrays display list arrays indexed arrays strips
6144 9132 0.2224 0.1500 0.1021 0.0691 0.0420
24576 37056 0.8552 0.5740 0.3846 0.2544 0.1292
98304 147840 3.4059 1.4932 1.0154 0.4888
98304 0 1.6513 0.6630 0.5208 0.5348 0.2223
393216 0 7.8273 3.2527 2.1140 2.1827 0.8720
To get a sense of the set-up times, here are recalc times,
flat shading except for strips.
facets edges no arrays display list arrays indexed arrays strips
6144 9132 0.32 1.2319 0.3796 0.5558 0.9143
24576 37056 0.9164 11.1961 1.0064 1.6804 2.9993
98304 147840 3.6503 4.2781 6.9260 12.5481
On transforms, using srol.8.fe
Transforms facets edges arrays indexed arrays strips
24 196608 297216 3.3058 2.2122 1.2307
A little slower than one would expect, maybe due to normal flipping??
Or memory caching? But at least set-up is fast.
*/
#undef DOUBLE
#if defined(WIN32) || defined(_WIN32)
#undef FIXED
#include
HWND hwnd;
#else
#include
#define CALLBACK
#endif
#include "include.h"
static char opengl_version[20]; /* from glGetString */
int close_flag = 0; /* whether close_show has been done */
vertex_id focus_vertex_id; /* rotate and zoom focus */
static float rgba[16][4];
static long win_id; /* graphics window id */
#ifdef TC
static void *th; /* draw_thread handle */
#else
static unsigned long th;
#endif
/* screen corners */
static double scrx[4],scry[4];
static double aspect = 1;
static double xscale=2.8/400,yscale=2.8/400;
static GLsizei xsize,ysize; /* window size */
static int initz_flag = 0; /* z buffer */
static float projmat[16]; /* for saving projection matrix */
#define P_ORTHO 0
#define P_PERSP 1
static int projmode = P_ORTHO; /* kind of projection to do */
#define NO_STEREO 0
#define CROSS_STEREO 1
static int stereomode = NO_STEREO;
#define NOLIST 0
#define NORMALLIST 1
#define RESETLIST 2
static int dlistflag = NOLIST; /* whether to use display list */
static int facetshow_flag = 1; /* whether to show facets */
static GLfloat linewidth = 1.0;
static REAL edge_bias = 0.005; /* amount edges drawn in front */
static int arraysflag=0; /* whether to use OpenGL 1.1 arrays */
struct vercol { float c[4]; float n[3]; float x[3]; int inx; };
static struct vercol *fullarray;
static int amax; /* allocated size of final array */
static int edgestart,edgecount,facetstart,facetcount;
static int vertexcount;
static struct vercol *edgearray,*facetarray;
static int emax,fmax; /* allocated */
static long arrays_timestamp; /* for remembering surface version */
static int interleaved_flag = 1; /* whether to do arrays as interleaved */
static int indexing_flag = 1; /* whether to use indexed arrays (smaller,but random access) */
static int *indexarray;
static int strips_flag; /* whether to do GL strips */
static int strip_color_flag; /* whether to color facets according to strip number */
static void make_strips(void);
static void make_indexlists(void);
struct stripstruct { int mode; /* GL_TRIANGLE_STRIP or GL_LINE_STRIP */
int start; /* starting offset in indexarray */
int count; /* number of vertices in strip */
};
static struct stripstruct *striparray;
static int stripcount; /* size of striparray */
static int estripcount; /* number of edge strips */
static int fstripcount; /* number of facet strips */
static int *stripdata;
static int doing_lazy; /* whether oglgraph should do transforms itself */
static int q_flag; /* whether to print drawing stats */
static REAL gleps = 1e-5; /* tolerance for identifying vertices */
// Note: using indexed arrays seems not to have any particular benefits.
/********************************************************************
*
* function: enlarge_edge_array()
*
* purpose: Expand the space for the edge list
*/
void enlarge_edge_array(void)
{ int more = emax + 10;
edgearray = (struct vercol*)kb_realloc((char*)edgearray,
(emax+more)*sizeof(struct vercol));
emax += more;
}
/********************************************************************
*
* function: enlarge_facet_array()
*
* purpose: Expand the space for the facet list
*/
void enlarge_facet_array(void)
{ int more = web.skel[FACET].count + 10;
facetarray = (struct vercol*)kb_realloc((char*)facetarray,
(fmax+more)*sizeof(struct vercol));
fmax += more;
}
/***********************************************************************
*
* function: kb_glNormal3fv() etc.
*
* purpose: Either save current normal in kb_norm[] for later list entry,
* or pass it on to gl.
*/
static float kb_norm[3] = { 0.0, 0.0, 1.0 }; /* state of normal vector */
void kb_glNormal3fv(float *v) /* save for edges and facets */
{ if ( !arraysflag ) glNormal3fv(v);
else { kb_norm[0] = v[0]; kb_norm[1] = v[1]; kb_norm[2] = v[2]; }
}
void kb_glNormal3dv(REAL *v) /* save for edges and facets */
{ kb_norm[0] = (float)v[0]; kb_norm[1] = (float)v[1]; kb_norm[2] = (float)v[2];
if ( !arraysflag ) glNormal3fv(kb_norm);
}
void kb_glAntiNormal3dv(REAL *v) /* save for edges and facets */
{ kb_norm[0] = -(float)v[0]; kb_norm[1] = -(float)v[1]; kb_norm[2] = -(float)v[2];
if ( !arraysflag ) glNormal3fv(kb_norm);
}
/***********************************************************************
*
* function: e_glColor()
*
* purpose: Either save current edge color in er,eg,eb for later list entry,
* or pass it on to gl.
*/
static float er,eg,eb,ea; /* current edge color */
void e_glColor(int c)
{
if ( edge_rgb_color_attr > 0 )
{
if ( !arraysflag ) glColor4ubv((const GLubyte*)&c);
else
{ er=(float)(((c>>24)&0xFF)/255.); eg=(float)(((c>>16)&0xFF)/255.);
eb=(float)(((c>>8)&0xFF)/255.); ea= (float)(((c)&0xFF)/255.);
}
}
else
{ if ( !arraysflag ) glColor4fv(rgba[c]);
else
{ er = rgba[c][0]; eg = rgba[c][1]; eb = rgba[c][2]; ea = rgba[c][3]; }
}
}
/*********************************************************************
*
* function: e_glVertex3dv()
*
* purpose: Either save current edge data in edge list, or pass on to gl.
*/
void e_glVertex3dv(double *x)
{ if ( !arraysflag ) { glVertex3dv(x); return; }
if ( edgecount > emax-5 ) enlarge_edge_array();
edgearray[edgecount].c[0] = er;
edgearray[edgecount].c[1] = eg;
edgearray[edgecount].c[2] = eb;
edgearray[edgecount].c[3] = ea;
edgearray[edgecount].x[0] = (float)x[0];
edgearray[edgecount].x[1] = (float)x[1];
edgearray[edgecount].x[2] = (float)x[2];
edgearray[edgecount].n[0] = kb_norm[0];
edgearray[edgecount].n[1] = kb_norm[1];
edgearray[edgecount].n[2] = kb_norm[2];
edgecount++;
}
/***********************************************************************
*
* function: f_glColor()
*
* purpose: Either save current facet color in fr,fg,fb for later list entry,
* or pass it on to gl.
*/
static float fr,fg,fb,fa; /* current facet color */
void f_glColor(int c)
{
if ( facet_rgb_color_attr > 0 )
{
if ( !arraysflag ) glColor4ubv((const GLubyte*)&c);
else
{ fr=(float)(((c>>24)&0xFF)/255.); fg=(float)(((c>>16)&0xFF)/255.);
fb=(float)(((c>>8)&0xFF)/255.); fa=(float)(((c)&0xFF)/255.);
}
}
else
{ if ( !arraysflag ) glColor4fv(rgba[c]);
else
{ fr = rgba[c][0]; fg = rgba[c][1]; fb = rgba[c][2]; fa = rgba[c][3]; }
}
}
/*********************************************************************
*
* function: f_glVertex3dv()
*
* purpose: Either save current facet data in facet list, or pass on to gl.
*/
void f_glVertex3dv(double *x)
{ if ( !arraysflag ) { glVertex3dv(x); return; }
if ( facetcount > fmax-5 ) enlarge_facet_array();
facetarray[facetcount].c[0] = fr;
facetarray[facetcount].c[1] = fg;
facetarray[facetcount].c[2] = fb;
facetarray[facetcount].c[3] = fa;
facetarray[facetcount].x[0] = (float)x[0];
facetarray[facetcount].x[1] = (float)x[1];
facetarray[facetcount].x[2] = (float)x[2];
facetarray[facetcount].n[0] = kb_norm[0];
facetarray[facetcount].n[1] = kb_norm[1];
facetarray[facetcount].n[2] = kb_norm[2];
facetcount++;
}
/* gl matrices have vector on left! */
typedef double Matrix[4][4];
Matrix vt3 = /* gl transform matrix */
{ {0.,0.,1.,0.},
{1.,0.,0.,0.},
{0.,-1.,0.,0.},
{0.,0.,0.,1.} };
Matrix vt3p = /* gl transform matrix, perspective version */
{ {0.,0.,1.,0.},
{1.,0.,0.,0.},
{0.,1.,0.,0.},
{0.,0.,0.,1.} };
Matrix vt2 = /* gl transform matrix */
{ {2.,0.,0.,0.}, /* can't figure why I need the 2's */
{0.,-2.,0.,0.},
{0.,0.,2.,0.},
{0.,0.,0.,1.} };
Matrix flip = /* gl transform matrix */
{ {1.,0.,0.,0.},
{0.,1.,0.,0.},
{0.,0.,-1.,0.},
{0.,0.,0.,1.} };
Matrix flip2D = /* gl transform matrix */
{ {1.,0.,0.,0.},
{0.,-1.,0.,0.},
{0.,0.,1.,0.},
{0.,0.,0.,1.} };
static long prev_timestamp; /* for remembering surface version */
#define MM_ROTATE 1
#define MM_TRANSLATE 2
#define MM_SCALE 3
#define MM_SPIN 4
#define MM_SLICE 5
static int mouse_mode = MM_ROTATE;
static int newarraysflag = 0; /* to cause rebuild of arrays */
static int dindex = 1; /* display list object index */
void CALLBACK draw_screen ARGS((void));
void Ogl_init(void)
{
}
void Ogl_finish(void)
{
}
void graph_new_surface(void)
{ /* to account for global deallocation at start of new surface */
fullarray = NULL;
edgearray = NULL;
facetarray = NULL;
indexarray = NULL;
striparray = NULL;
stripdata = NULL;
}
void init_Oglz ARGS((void));
int oldx,oldy,newx,newy; /* for tracking motion */
int basex=0,basey=0; /* translation to do on object */
/************************************************************************
*
* function: pick_func()
*
* purpose: To handle mouse picking of element. Invoked by right click.
*/
#define PICKBUFLENGTH 500
GLuint pickbuf[PICKBUFLENGTH];
void CALLBACK pick_func(AUX_EVENTREC *rec)
{ GLint hits, viewport[4];
int i,n;
unsigned int enearz = 0xFFFFFFFF;
unsigned int fnearz = 0xFFFFFFFF;
facet_id f_id = NULLID;
edge_id e_id = NULLID;
vertex_id v_id = NULLID;
int count;
glSelectBuffer(PICKBUFLENGTH,pickbuf);
glGetIntegerv(GL_VIEWPORT,viewport);
glMatrixMode(GL_PROJECTION);
glPushMatrix();
glRenderMode(GL_SELECT); /* see what picked when drawn */
glLoadIdentity();
gluPickMatrix(rec->data[0],rec->data[1],4,4,viewport);
glMultMatrixf(projmat);
if ( SDIM >= 3 ) glMultMatrixd(flip[0]); /* don't know why, but need */
else glMultMatrixd(flip2D[0]);
if ( arraysflag ) /* no picking during arrays */
{ arraysflag = 0; graph_timestamp = ++global_timestamp;
draw_screen();
arraysflag = 1; graph_timestamp = ++global_timestamp;
} else
draw_screen();
hits = glRenderMode(GL_RENDER); /* back to ordinary drawing */
if ( hits < 0 )
{ hits = PICKBUFLENGTH/4; /* buffer overflow */
kb_error(2541,
"Pick buffer overflow; selected element may not be foreground element.\n",
WARNING);
}
for ( i=0, n=0 ; (i < hits) && (n < PICKBUFLENGTH-4) ; i++, n += count + 3 )
{
count = pickbuf[n];
switch ( id_type(pickbuf[n+3]) )
{ case FACET:
if ( pickbuf[n+1] < fnearz )
{ f_id = pickbuf[n+3]; fnearz = pickbuf[n+1]; }
break;
case EDGE:
if ( pickbuf[n+1] < enearz )
if ( (pickbuf[n+3] != NULLEDGE) || !valid_id(e_id) )
{ e_id = pickbuf[n+3]; enearz = pickbuf[n+1]; }
break;
}
}
printf("\n");
if ( valid_id(e_id) )
{ /* check for vertex in common to picked edges */
for ( i = 0, n = 0 ; (i < hits) && (n < PICKBUFLENGTH-4) ; i++, n += count+3 )
{ element_id id,ee_id;
int ii,nn,ccount;
count = pickbuf[n];
id = pickbuf[n+3];
if ( (id_type(id) == EDGE) && valid_id(id) )
{ vertex_id v1 = get_edge_headv(id);
vertex_id v2 = get_edge_tailv(id);
for ( ii = i+1, nn = n+count+3 ; (ii < hits) && (n < PICKBUFLENGTH-4) ; ii++, nn += ccount + 3 )
{ ccount = pickbuf[nn];
ee_id = pickbuf[nn+3];
if ( (id_type(ee_id) == EDGE) && valid_id(ee_id)
&& !equal_element(id,ee_id) )
{ if ( v1 == get_edge_tailv(ee_id) )
{ v_id = v1; break; }
if ( v1 == get_edge_headv(ee_id) )
{ v_id = v1; break; }
if ( v2 == get_edge_tailv(ee_id) )
{ v_id = v2; break; }
if ( v2 == get_edge_headv(ee_id) )
{ v_id = v2; break; }
}
}
}
}
if ( valid_id(v_id) )
{ pickvnum = loc_ordinal(v_id) + 1;
sprintf(msg,"Picked vertex %d\n",pickvnum);
outstring(msg);
}
pickenum = loc_ordinal(e_id) + 1;
sprintf(msg,"Picked edge %d\n",pickenum);
outstring(msg);
}
else if ( e_id == NULLEDGE )
outstring("Picked facet subdivision edge.\n");
if ( valid_id(f_id) )
{ pickfnum = loc_ordinal(f_id) + 1;
sprintf(msg,"Picked facet %d\n",pickfnum);
outstring(msg);
}
outstring(current_prompt);
glMatrixMode(GL_PROJECTION);
glPopMatrix();
} /* end pick_func */
/***********************************************************
*
* function: mouse_down_func()
*
* purpose: Called on left button down, records position.
*/
void CALLBACK mouse_down_func(AUX_EVENTREC *rec)
{ oldx = (short)rec->data[0]; oldy = (short)rec->data[1];
}
/***********************************************************
*
* function: mouse_up_func()
*
* purpose: Called on left button up, records position as base.
*/
void CALLBACK mouse_up_func(AUX_EVENTREC *rec)
{
basex = newx;
basey = newy;
}
/*******************************************************************
*
* function: mouse_loc_func()
*
* purpose: Called as mouse moves with left button down, this
* moves surface according to current mouse_mode.
*/
void CALLBACK mouse_loc_func(AUX_EVENTREC *rec)
{ int i,j;
newx = (short)rec->data[0];
newy =(short)rec->data[1];
switch ( mouse_mode )
{ case MM_ROTATE:
mat_mult(to_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
fix_ctm(view,(double)( newx-oldx),-(double)(newy - oldy));
mat_mult(from_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case MM_SCALE:
mat_mult(to_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
for(i = 0 ; i < HOMDIM-1; i++ )
for ( j = 0 ; j < HOMDIM ; j++ )
view[i][j] *= 1.0 +0.002*(newx-oldx);
mat_mult(from_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
break;
case MM_SCALE: /* slicing altitude */
slice_coeff[SDIM] += (newx-oldx)*xscale;
break;
case MM_TRANSLATE:
if ( SDIM == 2 )
{ view[0][2] += (newx-oldx)*xscale;
view[1][2] -= (newy-oldy)*yscale;
to_focus[0][2] -= (newx-oldx)*xscale;
to_focus[1][2] += (newy-oldy)*yscale;
from_focus[0][2] += (newx-oldx)*xscale;
from_focus[1][2] -= (newy-oldy)*yscale;
} else
{
view[1][HOMDIM-1] += (newx-oldx)*xscale;
view[2][HOMDIM-1] -= (newy-oldy)*yscale;
to_focus[1][HOMDIM-1] -= (newx-oldx)*xscale;
to_focus[2][HOMDIM-1] += (newy-oldy)*yscale;
from_focus[1][HOMDIM-1] += (newx-oldx)*xscale;
from_focus[2][HOMDIM-1] -= (newy-oldy)*yscale;
};
break;
case MM_SPIN: /* about z axis */
{ MAT2D(rot,MAXCOORD+1,MAXCOORD+1);
REAL dth;
REAL dang; /* fourth dimension */
for ( i = 0 ; i < HOMDIM ; i++ )
{ for ( j = 0 ; j < HOMDIM ; j++ )
rot[i][j] = 0.0;
rot[i][i] = 1.0;
}
dth = (newx - oldx)/300.0*M_PI;
dang = (newy - oldy)/300.0*M_PI;
if ( SDIM == 2 )
{ rot[0][0] = rot[1][1] = cos(dth);
rot[0][1] = -(rot[1][0] = sin(dth));
} else
{ rot[1][1] = rot[2][2] = cos(dth);
rot[1][2] = -(rot[2][1] = sin(dth));
}
mat_mult(to_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
mat_mult(rot,view,view,HOMDIM,HOMDIM,HOMDIM);
mat_mult(from_focus,view,view,HOMDIM,HOMDIM,HOMDIM);
}
break;
}
oldx = newx; oldy = newy;
}
/************************************************************************
*
* function: reshape_func()
*
* purpose: handle window resize messages.
*/
void CALLBACK reshape_func ( GLsizei x, GLsizei y )
{ xsize = x; ysize = y;
aspect = (double)y/x;
glViewport(0,0,x,y);
if ( aspect > 1 ) { xscale = 2.8/aspect/x; yscale = 2.8/y; }
else { xscale = 2.8/x; yscale = 2.8*aspect/y; }
if ( x < y )
{ minclipx = -1.5; maxclipx = 1.5;
minclipy = -1.5*y/x; maxclipy = 1.5*y/x;
}
else
{ minclipx = -1.5*x/y; maxclipx = 1.5*x/y;
minclipy = -1.5; maxclipy = 1.5;
}
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
if ( (projmode == P_PERSP) || stereomode )
{
gluPerspective((float)(y/1600.*180/3.14159),1/aspect,1.0,20.0);
if ( SDIM == 2 ) glMultMatrixd(vt2[0]);
else glMultMatrixd(vt3p[0]); /* rotate axes */
}
else
{
if ( aspect <= 1.0 )
{ glOrtho(scrx[0],scrx[2],aspect*scry[0],aspect*scry[2],-20.0,20.0);
minclipx = scrx[0]; maxclipx = scrx[2];
minclipy = aspect*scry[2]; maxclipy = aspect*scry[0];
}
else
{ glOrtho(scrx[0]/aspect,scrx[2]/aspect,scry[0],scry[2],-20.0,20.0);
minclipx = scrx[0]/aspect; maxclipx = scrx[2]/aspect;
minclipy = scry[2]; maxclipy = scry[0];
}
if ( SDIM == 2 ) glMultMatrixd(vt2[0]); /* upside down */
else glMultMatrixd(vt3[0]); /* upside down and rotate axes */
}
glGetFloatv(GL_PROJECTION_MATRIX,projmat); // save
}
/***********************************************************************
*
* Functions: key callbacks
*
* purpose: handle keystrokes in graphics window.
*/
void CALLBACK up_arrow (void) { view_transform("\036"); }
void CALLBACK down_arrow (void) { view_transform("\037"); }
void CALLBACK left_arrow (void) { view_transform("\035"); }
void CALLBACK right_arrow (void) { view_transform("\034"); }
void CALLBACK r_key (void) { mouse_mode = MM_ROTATE; }
void CALLBACK t_key (void) { mouse_mode = MM_TRANSLATE; }
void CALLBACK z_key (void) { mouse_mode = MM_SCALE; }
void CALLBACK c_key (void) { mouse_mode = MM_SPIN;}
void CALLBACK l_key (void) { if ( slice_view ) mouse_mode = MM_SLICE;}
void CALLBACK b_key (void)
{ edge_bias -= 0.001;
sprintf(msg,"\nEdge front bias now %f\n",edge_bias); outstring(msg);
outstring(current_prompt);
}
void CALLBACK B_key (void)
{ edge_bias += 0.001;
sprintf(msg,"\nEdge front bias now %f\n",edge_bias); outstring(msg);
outstring(current_prompt);
}
void CALLBACK R_key (void)
{
resize();
}
void CALLBACK minus_key (void)
{ if ( linewidth > 0.6 ) { linewidth -= 0.5; glLineWidth(linewidth);} }
void CALLBACK plus_key (void)
{ if ( linewidth < 9.9 ) { linewidth += 0.5; glLineWidth(linewidth);}}
void CALLBACK e_key (void)
{ edgeshow_flag = !edgeshow_flag; graph_timestamp = ++global_timestamp;
newarraysflag = 1;}
void CALLBACK f_key (void)
{ facetshow_flag = !facetshow_flag; graph_timestamp = ++global_timestamp;
newarraysflag = 1;}
void CALLBACK g_key (void)
{ normflag = !normflag; graph_timestamp = ++global_timestamp;
newarraysflag = 1;}
void CALLBACK m_key (void) { view_transform("m"); }
void CALLBACK i_key (void) { interleaved_flag = !interleaved_flag;
outstring(interleaved_flag ? "Interleaving ON.\n":"Interleaving OFF.\n");
outstring(current_prompt);
newarraysflag = 1;
}
void CALLBACK I_key (void) { indexing_flag = !indexing_flag;
outstring(indexing_flag ? "Array indexing ON.\n":"Array indexing OFF.\n");
outstring(current_prompt);
newarraysflag = 1;
}
void CALLBACK S_key (void) { strips_flag = !strips_flag;
outstring(strips_flag ? "Element strips ON.\n":"Element strips OFF.\n");
outstring(current_prompt);
normflag = 1; /* gourard shading */
indexing_flag = 1;
newarraysflag = 1;
}
void CALLBACK Y_key (void) /* color strips */
{ int *fcolors;
int i;
fcolors = (int*)temp_calloc(web.skel[FACET].maxcount,sizeof(int));
for ( i = 0 ; i < web.skel[FACET].maxcount ; i++ )
fcolors[i] = get_facet_color(i);
if ( !strips_flag ) S_key(); /* make sure strips on */
strip_color_flag = 1;
newarraysflag = 1;
draw_screen(); /* get facets colored */
newarraysflag = 1;
draw_screen(); /* draw colored facets */
strip_color_flag = 0;
for ( i = 0 ; i < web.skel[FACET].maxcount ; i++ )
set_facet_color(i,fcolors[i]);
temp_free((char*)fcolors);
}
void CALLBACK F_key (void)
{
if ( pickvnum > 0 )
{ int i,m;
REAL *x,xx[MAXCOORD];
REAL focus[MAXCOORD];
focus_vertex_id = get_ordinal_id(VERTEX,pickvnum-1);
x = get_coord(focus_vertex_id);
for ( m = 0 ; m < SDIM ; m++ ) xx[m] = x[m];
if ( torus_display_mode == TORUS_CLIPPED_MODE )
{
for ( m = 0 ; m < SDIM ; m++ )
{ int wrap = (int)floor(SDIM_dot(web.inverse_periods[m],x));
for ( i = 0 ; i < SDIM ; i++ )
xx[i] -= wrap*web.torus_period[m][i];
}
}
matvec_mul(view,xx,focus,HOMDIM-1,HOMDIM-1);
for ( i = 0 ; i < SDIM ; i++ )
{ to_focus[i][HOMDIM-1] = -focus[i] - view[i][HOMDIM-1];
from_focus[i][HOMDIM-1] = focus[i] + view[i][HOMDIM-1];
}
}
}
void CALLBACK D_key (void)
{ dlistflag = dlistflag ? NOLIST:RESETLIST;
if ( dlistflag ) outstring("\nOpenGL display list now ON.\n");
else outstring("\nOpenGL display list now OFF.\n");
outstring(current_prompt);
graph_timestamp = ++global_timestamp; /* force recalculate arrays */
}
void CALLBACK a_key (void)
{ if ( strcmp(opengl_version,"1.1") < 0 )
{ sprintf(errmsg,"Vertex arrays require OpenGL version at least 1.1. This is %s.\n",
opengl_version);
kb_error(2542,errmsg,WARNING);
return;
}
arraysflag = !arraysflag;
if ( arraysflag )
{ /* Workaround really bizarre line-drawing bug */
if ( linewidth == 1.0 ) { linewidth = 0.5; glLineWidth(0.5); }
outstring("\nOpenGL vertex arrays now ON.\n");
glInterleavedArrays(GL_C4F_N3F_V3F,0,(void*)fullarray);
newarraysflag = 1;
}
else
{
glDisableClientState(GL_COLOR_ARRAY);
glDisableClientState(GL_NORMAL_ARRAY);
glDisableClientState(GL_VERTEX_ARRAY);
outstring("\nOpenGL vertex_arrays now OFF.\n");
}
outstring(current_prompt);
}
void CALLBACK s_key (void)
{ stereomode = (stereomode==NO_STEREO) ? CROSS_STEREO:NO_STEREO;
if (stereomode)
{ if ( dlistflag == NOLIST ) dlistflag = RESETLIST;}
else if ( arraysflag ) dlistflag = NOLIST;
reshape_func(xsize,ysize);
}
void CALLBACK p_key (void)
{ if ( stereomode )
outstring("\nOpenGL projection now CROSS-EYED STEREO.\n");
else if ( projmode==P_ORTHO )
{ projmode=P_PERSP; outstring("\nOpenGL projection now PERSPECTIVE.\n");}
else
{ projmode=P_ORTHO; outstring("\nOpenGL projection now ORTHOGONAL.\n");}
outstring(current_prompt);
reshape_func(xsize,ysize);
}
void CALLBACK Q_key (void)
{ q_flag = !q_flag;
outstring(q_flag ? "\nPrinting drawing stats ON\n":"\nPrinting drawing stats OFF\n");
outstring(current_prompt);
}
void CALLBACK help_key (void)
{ outstring("\nGraphics window help:\n");
outstring("Left mouse: move Right mouse: pick\n");
outstring("Graphics window keys:\n");
outstring(mouse_mode==MM_ROTATE?"r Rotate mode for left mouse button, now ACTIVE\n":
"r Rotate mode for left mouse button\n");
outstring(mouse_mode==MM_TRANSLATE?"t Translate mode for left mouse button, now ACTIVE\n":
"t Translate mode for left mouse button\n");
outstring(mouse_mode==MM_SCALE?"z Zoom mode for left mouse button, now ACTIVE\n":
"z Zoom mode for left mouse button\n");
outstring(mouse_mode==MM_SPIN?"c Clockwise/counterclockwise mode, now ACTIVE\n":
"c Clockwise/counterclockwise mode\n");
outstring("W Widen edges\n");
outstring("w Narrow edges\n");
outstring("B Increase edge front bias by 0.001\n");
outstring("b Decrease edge front bias by 0.001\n");
outstring(normflag? "g Gourard shading (smooth shading) toggle, now ON\n":
"g Gourard shading (smooth shading) toggle, now OFF\n" );
outstring("R Reset view\n");
outstring("m Center image\n");
outstring(edgeshow_flag?"e Toggle showing all edges, now ON\n":
"e Toggle showing all edges, now OFF\n");
outstring(facetshow_flag?"f Toggle showing facets, now ON\n":
"f Toggle showing facets, now OFF\n");
outstring(projmode==P_PERSP?"p Toggle orthogonal/perspective projection, now perspective\n":
"p Toggle orthogonal/perspective projection, now orthogonal\n");
outstring("s Toggle cross-eyed stereo\n");
outstring("F Set rotate/zoom focus to last picked vertex\n");
outstring("arrow keys translate image\n");
outstring("H Guru-level help items\n");
outstring(current_prompt);
}
void CALLBACK H_key(void) /* guru level help */
{
outstring("\nFollowing for fiddling with OpenGL drawing modes:\n");
outstring(normflag? "g Gourard shading (smooth shading) toggle, now ON\n":
"g Gourard shading (smooth shading) toggle, now OFF\n" );
outstring(dlistflag?"D Toggle using display list, now ON\n":
"D Toggle using display list, now OFF\n");
outstring(arraysflag?"a Toggle using vertex and color arrays, now ON\n"
:"a Toggle using vertex and color arrays, now OFF\n");
outstring(indexing_flag ? "I Indexed vertex arrays, now ON\n"
: "I Indexed vertex arrays, now OFF\n");
outstring(interleaved_flag ? "i Interleaved vertex arrays, now ON\n"
: "i Interleaved vertex arrays, now OFF\n");
outstring(strips_flag?
"S Use element strips, now ON (indexed elements automatically turned on)\n"
:"S Use element strips, now OFF\n");
outstring("Y One-time coloring of strips generated in S mode.\n");
outstring(" Caution: assumes display facets same as real, with no gaps.\n");
outstring("Q Toggle printing some statistics during drawing\n");
outstring(current_prompt);
}
/* lighting info for surface */
static GLfloat mat_specular[] = {.5f,.5f,.5f,1.0f};
static GLfloat mat_shininess[] = {10.0f};
static GLfloat mat_diffuse[] = {1.0f,1.0f,1.0f,1.0f};
static GLfloat mat_white[] = {1.0f,1.0f,1.0f,1.0f};
static GLfloat mat_emission[] = {0.3f,0.3f,0.3f,1.0f};
#define INTENSITY1 0.5f
static GLfloat light0_position[] = {1.0f,0.0f,1.0f,0.0f}; // front
static GLfloat light0_diffuse[] = {INTENSITY1,INTENSITY1,INTENSITY1,1.0f};
static GLfloat light0_ambient[] = {.3f,.3f,.3f,1.0f};
#define INTENSITY2 0.5f
static GLfloat light1_position[] = {0.0f,0.0f,1.0f,0.0f}; // above
static GLfloat light1_diffuse[] = {INTENSITY2,INTENSITY2,INTENSITY2,1.0f};
static GLfloat light_none[] = {0.f,0.f,0.f,.0f};
/*****************************************************************
*
* function: draw_thread()
*
* purpose: Create OpenGL display thread and window.
*/
//unsigned long __stdcall draw_thread(void *arglist)
void __cdecl draw_thread(void *arglist)
{ int i,j;
draw_thread_id = GetCurrentThreadId();
for ( i = 0 ; i < 16 ; i++ )
for ( j = 0 ; j < 4 ; j++ )
rgba[i][j] = (float)rgb_colors[i][j];
background_color = LIGHTBLUE;
auxInitPosition(0,0,400,400);
auxInitDisplayMode(AUX_DOUBLE | AUX_RGBA | AUX_DEPTH);
auxInitWindow(datafilename);
auxMouseFunc(AUX_LEFTBUTTON,AUX_MOUSEUP,mouse_up_func);
auxMouseFunc(AUX_LEFTBUTTON,AUX_MOUSELOC,mouse_loc_func);
auxMouseFunc(AUX_LEFTBUTTON,AUX_MOUSEDOWN,mouse_down_func);
auxMouseFunc(AUX_RIGHTBUTTON,AUX_MOUSEDOWN,pick_func);
auxKeyFunc(AUX_UP,up_arrow);
auxKeyFunc(AUX_LEFT,left_arrow);
auxKeyFunc(AUX_RIGHT,right_arrow);
auxKeyFunc(AUX_DOWN,down_arrow);
auxKeyFunc(AUX_t,t_key);
auxKeyFunc(AUX_z,z_key);
auxKeyFunc(AUX_r,r_key);
auxKeyFunc(AUX_l,l_key);
auxKeyFunc(AUX_R,R_key);
auxKeyFunc(AUX_D,D_key);
auxKeyFunc(AUX_p,p_key);
auxKeyFunc(AUX_s,s_key);
auxKeyFunc(AUX_S,S_key);
auxKeyFunc(AUX_Y,Y_key);
auxKeyFunc(AUX_e,e_key);
auxKeyFunc(AUX_f,f_key);
auxKeyFunc(AUX_g,g_key);
auxKeyFunc(AUX_F,F_key);
auxKeyFunc(AUX_c,c_key);
auxKeyFunc(AUX_B,B_key);
auxKeyFunc(AUX_b,b_key);
auxKeyFunc(AUX_W,plus_key);
auxKeyFunc(AUX_w,minus_key);
auxKeyFunc(AUX_h,help_key);
auxKeyFunc(AUX_H,H_key);
auxKeyFunc(AUX_a,a_key);
auxKeyFunc(AUX_m,m_key);
auxKeyFunc(AUX_i,i_key);
auxKeyFunc(AUX_I,I_key);
auxKeyFunc(AUX_Q,Q_key);
auxReshapeFunc(reshape_func);
hwnd = auxGetHWND();
ShowWindow(hwnd,SW_SHOW);
SetWindowPos(hwnd,HWND_NOTOPMOST ,0,0,0,0,
SWP_NOSIZE | SWP_NOMOVE);
SetForegroundWindow(hwnd);
glDepthFunc(GL_LEQUAL);
glEnable(GL_DEPTH_TEST);
glEnable(GL_NORMALIZE);
glEnable(GL_COLOR_MATERIAL);
glColorMaterial(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE);
//glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, mat_specular);
//glMaterialfv(GL_FRONT_AND_BACK, GL_SHININESS, mat_shininess);
glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, mat_white);
//glMaterialfv(GL_FRONT_AND_BACK, GL_EMISSION, mat_emission);
glEnable(GL_LIGHTING);
glLightfv(GL_LIGHT0, GL_POSITION, light0_position);
glLightfv(GL_LIGHT0, GL_DIFFUSE, light0_diffuse);
glLightfv(GL_LIGHT0, GL_AMBIENT, light0_ambient);
glLightfv(GL_LIGHT1, GL_POSITION, light1_position);
glLightfv(GL_LIGHT1, GL_DIFFUSE, light1_diffuse);
glLightfv(GL_LIGHT0, GL_SPECULAR, light_none);
glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE);
/* screen corners */
scrx[0] = scrx[1] = -1.4;
scrx[2] = scrx[3] = 1.4;
scry[0] = scry[3] = 1.4;
scry[1] = scry[2] = -1.4;
go_display_flag = 1; /* default, since fast graphics */
/* version check */
strncpy(opengl_version,glGetString(GL_VERSION),sizeof(opengl_version));
if ( strcmp(opengl_version,"1.1") >= 0 ) arraysflag = 1;
auxMainLoop(draw_screen);
//return 0;
}
/************************************************************************
*
* function: init_Oglz()
*
* purpose: start up graphics thread
*/
#include
void init_Oglz(void)
{ int n;
if ( !initz_flag )
{ initz_flag = 1;
if ( !to_focus )
{ to_focus = dmatrix(0,MAXCOORD,0,MAXCOORD);
from_focus = dmatrix(0,MAXCOORD,0,MAXCOORD);
for ( n = 0 ; n <= MAXCOORD ; n++ )
to_focus[n][n] = from_focus[n][n] = 1.0;
}
//th = CreateThread(NULL,0,draw_thread,0,0,&draw_thread_id);
th=_beginthread(draw_thread,0,0);
}
}
/****************************************************************
*
* function: Oglz_start()
*
* purpose: To be called at the start of each Evolver-initiated redraw.
*/
void Oglz_start(void)
{
if ( initz_flag == 0 ) init_Oglz();
SetWindowText(hwnd,datafilename);
if ( !to_focus )
{ int n;
to_focus = dmatrix(0,MAXCOORD,0,MAXCOORD);
from_focus = dmatrix(0,MAXCOORD,0,MAXCOORD);
for ( n = 0 ; n <= MAXCOORD ; n++ )
to_focus[n][n] = from_focus[n][n] = 1.0;
}
}
/******************************************************************
*
* function: Oglz_edge()
*
* purpose: graph one edge.
*/
void Oglz_edge(
struct graphdata *g,
edge_id e_id)
{
int k;
int e_color;
e_color = g[0].ecolor;
if ( e_color == CLEAR ) return;
if ( (e_color < 0) || (e_color >= IRIS_COLOR_MAX) )
e_color = DEFAULT_EDGE_COLOR;
glLoadName(e_id); // for picking
/* display */
e_glColor(e_color);
glBegin(GL_LINES);
for ( k = 0 ; k < 2 ; k++ )
e_glVertex3dv(g[k].x);
glEnd();
}
/******************************************************************
*
* function: Oglz_facet()
*
* purpose: graph one facet.
*/
static float norm[3];
void Oglz_facet(
struct graphdata *g,
facet_id f_id)
{
int i,k;
REAL len;
facetedge_id fe = NULLID;
/* need normal for lighting */
for ( i = 0 ; i < 3 ; i++ )
{ int ii = (i+1)%3;
int iii = (i+2)%3;
norm[i] = (float)((g[1].x[ii]-g[0].x[ii])*(g[2].x[iii]-g[0].x[iii])
- (g[1].x[iii]-g[0].x[iii])*(g[2].x[ii]-g[0].x[ii]));
}
len = sqrt(dotf(norm,norm,3));
if ( len <= 0.0 ) return;
for ( i = 0 ; i < 3 ; i++ ) norm[i]= (float)(norm[i]/len);
if ( web.hide_flag && (g[0].color != UNSHOWN)
&& facetshow_flag )
{ glLoadName(f_id); // for picking
if ( g[0].color != CLEAR )
{ if ( color_flag ) f_glColor(g->color);
else f_glColor(INDEX_TO_RGBA(WHITE));
kb_glNormal3fv(norm);
glBegin(GL_TRIANGLES);
for ( k = 0 ; k < 3 ; k++ )
{ if ( normflag ) kb_glNormal3dv(g[k].norm);
f_glVertex3dv(g[k].x);
}
glEnd();
}
if ( (g->color != g->backcolor) && (g->backcolor != CLEAR) )
{ REAL x[MAXCOORD];
f_glColor(g->backcolor);
for ( i = 0 ; i < 3 ; i++ ) norm[i] = -norm[i];
kb_glNormal3fv(norm);
glBegin(GL_TRIANGLES);
for ( k = 2 ; k >= 0 ; k-- )
{ for ( i = 0 ; i < 3 ; i++ )
x[i] = g[k].x[i] + thickness*norm[i];
if ( normflag ) kb_glAntiNormal3dv(g[k].norm);
f_glVertex3dv(x);
}
glEnd();
}
}
fe = valid_id(f_id) ? get_facet_fe(f_id) : NULLID;
for ( k = 0 ; k < 3 ; k++, fe = valid_id(fe)?get_next_edge(fe):NULLID )
{
if ( g[k].ecolor == CLEAR ) continue;
if ( !edgeshow_flag || (g[0].color == UNSHOWN) )
{ if ( (g[k].etype&EBITS) == INVISIBLE_EDGE ) continue;
}
glLoadName(g[k].id); /* for picking */
e_glColor(g[k].ecolor);
kb_glNormal3fv(norm);
glBegin(GL_LINES);
if ( normflag ) kb_glNormal3dv(g[k].norm);
e_glVertex3dv(g[k].x);
if ( normflag ) kb_glNormal3dv(g[(k+1)%3].norm);
e_glVertex3dv(g[(k+1)%3].x);
glEnd();
}
}
/**********************************************************************
*
* function: Oglz_end()
*
* purpose: to be called at end of presenting data.
*/
void Oglz_end(void)
{
prev_timestamp = graph_timestamp;
}
void Ogl_close(void)
{ //close_flag = 1;
//InvalidateRect(hwnd,NULL,FALSE);
kb_error(2175,"Sorry, OpenGL version can't restart show after close, so won't close.\n",
WARNING);
graph_timestamp = ++global_timestamp;
draw_screen();
}
void really_close(void)
{
auxCloseWindow();
glDeleteLists(dindex,1);
init_flag = 0;
initz_flag = 0;
win_id = -1;
go_display_flag = 0;
ExitThread(0);
}
/**********************************************************************
*
* function: vercolcomp()
*
* purpose: comparison function for sorting vertex data in case of indexed arrays.
*
*/
int vercolcomp(struct vercol *a, struct vercol *b)
{
int i;
for ( i = 0 ; i < 10 ; i++ )
{ REAL diff = ((float*)a)[i] - ((float*)b)[i];
if ( diff < -gleps ) return -1;
if ( diff > gleps ) return 1;
}
return 0;
}
/***********************************************************************
*
* function: eecomp()
*
* purpose: comparison function for sorting indexed edges
*/
int eecomp(const int *a, const int *b)
{ if ( *a < *b ) return -1;
if ( *a > *b ) return 1;
if ( a[1] > b[1] ) return 1;
if ( a[1] < b[1] ) return -1;
return 0;
}
/**********************************************************************
*
* function: draw_screen()
*
* purpose: Handle redraw messages from operating system.
*/
void CALLBACK draw_screen(void)
{ static int olddim = 0;
Matrix viewf;
int i,j;
ENTER_GRAPH_MUTEX
// Set up longjmp to return here in case of error
if ( setjmp(graphjumpbuf) )
{ return; }
//if ( close_flag ) really_close(); can't restart
/* build arrays if needed */
if ( arraysflag && (
((graph_timestamp != arrays_timestamp) && go_display_flag )
|| newarraysflag || (dlistflag == RESETLIST)) )
{ int oldflag;
if ( fullarray )
{ myfree((char*)fullarray);
fullarray = NULL;
}
edgecount = 0;
emax = (web.representation==SIMPLEX) ? SDIM*web.skel[FACET].count + 100 :
2*web.skel[EDGE].count+10; // 2 vertices per edge
edgearray = (struct vercol *)mycalloc(emax,sizeof(struct vercol));
facetcount = 0; fmax = 3*web.skel[FACET].count+10; // 3 vertices per facet
facetarray = (struct vercol *)mycalloc(fmax,sizeof(struct vercol));
if ( !edgearray || !facetarray )
{ erroutstring("Cannot allocate memory for graphics.\n");
goto bailout;
}
graph_start = Oglz_start;
graph_facet = Oglz_facet;
graph_edge = Oglz_edge;
graph_end = Oglz_end;
init_graphics = Ogl_init;
finish_graphics = Ogl_finish;
close_graphics = Ogl_close;
//glDisableClientState(GL_COLOR_ARRAY);
//glDisableClientState(GL_NORMAL_ARRAY);
//glDisableClientState(GL_VERTEX_ARRAY);
oldflag = markedgedrawflag;
markedgedrawflag = 1;
if ( !transform_colors_flag )
lazy_transforms_flag = 1; /* for graphgen use */
doing_lazy = lazy_transforms_flag; /* for use by oglgraph.c */
arrays_timestamp = graph_timestamp; /* here to prevent stale data */
graphgen(); /* fill in arrays */
lazy_transforms_flag = 0;
markedgedrawflag = oldflag;
if ( q_flag )
{ sprintf(msg,"\n%d edges, %d facets\n",edgecount/2,facetcount/3);
outstring(msg);
}
/* doing this here since facet_alpha_flag set in graphgen */
if ( facet_alpha_flag ) glEnable(GL_BLEND);
else glDisable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
/* unify lists */
fullarray = (struct vercol *)kb_realloc((char*)edgearray,
(edgecount+facetcount)*sizeof(struct vercol));
memcpy((char*)(fullarray+edgecount),(char*)facetarray,facetcount*sizeof(struct vercol));
myfree((char*)facetarray); facetarray = NULL; edgearray = NULL;
edgestart = 0; facetstart = edgecount;
/* Workaround really bizarre line-drawing bug */
if ( linewidth == 1.0 ) { linewidth = (float)1.1; glLineWidth(linewidth); }
if ( indexing_flag )
{
make_indexlists();
if ( q_flag )
{ sprintf(msg,"After indexing: %d unique vertices, %d unique edges\n",
vertexcount,edgecount/2);
outstring(msg);
}
if ( strips_flag ) make_strips();
}
/* declare arrays to OpenGL */
if ( interleaved_flag )
glInterleavedArrays(GL_C4F_N3F_V3F,sizeof(struct vercol),(void*)fullarray);
else // kludge for broken nVidia Detonater 2.08 driver
{ static float *colorarray;
if ( colorarray ) myfree((char*)colorarray);
colorarray = (float*)mycalloc(edgecount+facetcount,4*sizeof(float));
for ( i = 0 ; i < edgecount+facetcount ; i++ )
for ( j = 0 ; j < 4 ; j++ )
colorarray[4*i+j] = fullarray[i].c[j];
glColorPointer(4,GL_FLOAT,0,colorarray);
glNormalPointer(GL_FLOAT,sizeof(struct vercol),fullarray->n);
glVertexPointer(3,GL_FLOAT,sizeof(struct vercol),fullarray->x);
}
newarraysflag = 0;
if ( dlistflag )
{
glNewList(dindex,GL_COMPILE);
if ( indexing_flag )
{
glDrawElements(GL_TRIANGLES,facetcount,GL_UNSIGNED_INT,indexarray+facetstart);
glMatrixMode(GL_PROJECTION);
glTranslated(edge_bias,0.0,0.0); /* edges in front */
glDrawElements(GL_LINES,edgecount,GL_UNSIGNED_INT,indexarray+edgestart);
glTranslated(-edge_bias,0.0,0.0);
glMatrixMode(GL_MODELVIEW);
}
else
{
glDrawArrays(GL_TRIANGLES,facetstart,facetcount);
glMatrixMode(GL_PROJECTION);
glTranslated(edge_bias,0.0,0.0); /* edges in front */
glDrawArrays(GL_LINES,edgestart,edgecount);
glTranslated(-edge_bias,0.0,0.0);
glMatrixMode(GL_MODELVIEW);
}
glEndList();
dlistflag = NORMALLIST;
}
if ( q_flag ) outstring(current_prompt);
}
else
if ( (dlistflag != NORMALLIST) ||
((graph_timestamp != prev_timestamp) && go_display_flag ) )
{ /* regenerate display list */
graph_start = Oglz_start;
graph_facet = Oglz_facet;
graph_edge = Oglz_edge;
graph_end = Oglz_end;
init_graphics = Ogl_init;
finish_graphics = Ogl_finish;
close_graphics = Ogl_close;
if ( dlistflag != NOLIST )
{ glNewList(dindex,GL_COMPILE);
graphgen();
glEndList();
dlistflag = NORMALLIST;
}
}
if ( SDIM != olddim )
{ reshape_func(xsize,ysize); /* in case dimension changes */
olddim = SDIM;
}
glEnable(GL_LIGHT0);
//glEnable(GL_LIGHT1);
/* clear screen and zbuffer */
glClearColor(rgba[background_color][0],
rgba[background_color][1],
rgba[background_color][2],
rgba[background_color][3]
);
glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT );
if ( backcull_flag ) { glEnable(GL_CULL_FACE); }
else { glDisable(GL_CULL_FACE); }
glDepthFunc(GL_LEQUAL); /* so later things get drawn */
glMatrixMode(GL_MODELVIEW);
for ( i = 0 ; i < 4 ; i++ )
for ( j = 0 ; j < 4 ; j++ )
viewf[i][j] = view[(j<3)?j:(SDIM)][(i<3)?i:(SDIM)];
if ( SDIM == 2 )
{ for ( i = 0 ; i < 3 ; i++ ) viewf[i][2] = viewf[2][i] = 0.0;
viewf[2][2] = 1.0;
}
/* transpose, picking first 3 coordinates */
if ( (projmode == P_PERSP) || stereomode )
if ( SDIM == 2 ) viewf[3][2] -= 16;
else viewf[3][0] -= 16.0;
glLoadMatrixd(viewf[0]);
// for picking
if ( !arraysflag ) { glInitNames(); glPushName(0);}
// Now the actual drawing
if ( dlistflag )
{ if ( stereomode )
{ int w = (SDIM==2) ? 0 : 1;
// Stereo mode always perspective
viewf[3][w] -= 1.5; glLoadMatrixd(viewf[0]); glCallList(dindex);
viewf[3][w] += 3.0; glLoadMatrixd(viewf[0]); glCallList(dindex);
}
else glCallList(dindex);
}
else if ( arraysflag )
{ int i,j,m;
for ( m = 0 ; (m < transform_count) || (m < 1) ; m++ )
{ float tmat[4][4]; /* transform matrix in proper form */
if ( transforms_flag && doing_lazy && view_transform_det
&& (view_transform_det[m] == -1.0) )
{ /* have to flip normals */
for ( i = 0 ; i < edgecount+facetcount ; i++ )
for ( j = 0 ; j < 3 ; j++ )
fullarray[i].n[j] *= -1.0;
}
if ( transforms_flag && doing_lazy && view_transforms )
{ int hi = (SDIM <= 3) ? SDIM : 3;
for ( i = 0 ; i < hi; i++ )
{ for ( j = 0 ; j < hi; j++ )
tmat[i][j] = (float)view_transforms[m][j][i];
for ( ; j < 3 ; j++ ) tmat[i][j] = 0.0;
tmat[i][3] = (float)view_transforms[m][i][SDIM];
}
for ( ; i < 3 ; i++ )
{ for ( j = 0 ; j < 4 ; j++ ) tmat[i][j] = 0.0;
tmat[i][i] = 1.0;
}
for ( j = 0 ; j < hi ; j++ )
tmat[3][j] = (float)view_transforms[m][SDIM][j];
for ( ; j < 3 ; j++ )
tmat[3][j] = 0.0;
tmat[3][3] = (float)view_transforms[m][SDIM][SDIM];
glMatrixMode(GL_MODELVIEW);
glPushMatrix();
glMultMatrixf((float*)tmat);
}
if ( strips_flag )
{ int i;
/* do facets first, then edges in front */
for ( i = estripcount ; i < stripcount ; i++ )
glDrawElements(striparray[i].mode,striparray[i].count,GL_UNSIGNED_INT,stripdata+striparray[i].start);
glMatrixMode(GL_PROJECTION);
glTranslated(edge_bias,0.0,0.0);
for ( i = 0 ; i < estripcount ; i++ )
glDrawElements(striparray[i].mode,striparray[i].count,GL_UNSIGNED_INT,stripdata+striparray[i].start);
glTranslated(-edge_bias,0.0,0.0);
}
else if ( indexing_flag )
{
glDrawElements(GL_TRIANGLES,facetcount,GL_UNSIGNED_INT,indexarray+facetstart);
glMatrixMode(GL_PROJECTION);
glTranslated(edge_bias,0.0,0.0);
glDrawElements(GL_LINES,edgecount,GL_UNSIGNED_INT,indexarray+edgestart);
glTranslated(-edge_bias,0.0,0.0);
}
else
{
glDrawArrays(GL_TRIANGLES,facetstart,facetcount);
glMatrixMode(GL_PROJECTION);
glTranslated(edge_bias,0.0,0.0);
glDrawArrays(GL_LINES,edgestart,edgecount);
glTranslated(-edge_bias,0.0,0.0);
}
if ( transforms_flag && doing_lazy )
{ glMatrixMode(GL_MODELVIEW); glPopMatrix(); }
if ( transforms_flag && doing_lazy && view_transform_det && (view_transform_det[m] == -1.0) )
{ /* have to flip normals back */
for ( i = 0 ; i < edgecount+facetcount ; i++ )
for ( j = 0 ; j < 3 ; j++ )
fullarray[i].n[j] *= -1.0;
}
if ( !doing_lazy || !transforms_flag ) break;
} /* end transform loop */
} /* end arrays_flag */
else /* not using display list or arrays */
{
graphgen();
}
glFlush();
auxSwapBuffers();
bailout:
LEAVE_GRAPH_MUTEX;
}
/***********************************************************************
*
* function: display()
*
* purpose: called by Evolver to display on screen.
*/
void display(void)
{ close_flag = 0;
Oglz_start();
InvalidateRect(hwnd,NULL,FALSE); /* generate redraw message */
}
/****************************************************************************
*
* function: make_strips()
*
* purpose: Converts indexed arrays of edges and triangles to strips
* for more efficient plotting.
* Input: global array indexarray
* global variables edgecount,facetcount
* Output: striparray
*/
int ecomp(const void *a, const void *b)
{ int ai = indexarray[edgestart+*(int*)a];
int bi = indexarray[edgestart+*(int*)b];
if ( ai < bi ) return -1;
if ( bi < ai ) return 1;
return 0;
}
struct festruct { int v[3]; /* head and tail and opposite vertices */
int f; /* facet on left */
};
int fecomp ( const struct festruct *a, const struct festruct *b)
{ if ( a->v[0] < b->v[0] ) return -1;
if ( a->v[0] > b->v[0] ) return 1;
if ( a->v[1] < b->v[1] ) return -1;
if ( a->v[1] > b->v[1] ) return 1;
return 0;
}
void make_strips()
{ int *edgeinx; /* oriented edge numbers, sorted by first vertex */
int *evlist; /* vertex indexed list of offsets into edgeinx */
int v;
int i,k,kk;
int *estripno; /* number of current strip */
int *fstripno; /* number of current strip */
int stripnum;
int dataspot;
struct festruct *felist;
int striplength[3]; /* for testing 3 ways from each starting facet */
int *trialstrip; /* for unerasing markings */
int bestlength;
int *bestverts;
int *bestfacets;
int way;
int bestway;
/* strip arrays */
if ( stripdata ) myfree((char*)stripdata);
if ( striparray ) myfree((char*)striparray);
stripdata = (int*)mycalloc(edgecount+facetcount,sizeof(int));
striparray = (struct stripstruct *)mycalloc(edgecount/2+facetcount/3,
sizeof(struct stripstruct));
dataspot = 0; stripnum = 0;
/* edges */
/* make list indexed by vertex */
/* in einx, entry is 2*edgeindex+orientationbit */
edgeinx = (int *)temp_calloc(edgecount,sizeof(int));
for ( i = 0 ; i < edgecount ; i++ )
{ edgeinx[i] = i; } /* using bit for orientation */
qsort((void*)edgeinx,edgecount,sizeof(int),FCAST ecomp);
/* find where individual vertex segments start */
evlist = (int *)temp_calloc(edgecount+1,sizeof(int));
for ( i = 0, v = 0 ; i < edgecount ; i++ )
{ while ( indexarray[edgestart+edgeinx[i]] > v ) evlist[++v] = i;
}
evlist[++v] = i; /* last sentinel */
/* now make strips. start with some edge and just keep going. */
estripno = (int*)temp_calloc(edgecount/2,sizeof(int));
for ( i = 0 ; i < edgecount/2 ; i++ )
{ int nexte,headv;
if ( estripno[i] ) continue;
/* new strip */
striparray[stripnum].mode = GL_LINE_STRIP;
striparray[stripnum].start = dataspot;
nexte = 2*i;
for (;;)
{
estripno[nexte>>1] = stripnum+1;
headv = indexarray[edgestart+(nexte^1)];
stripdata[dataspot++] = headv;
for ( k = evlist[headv] ; k < evlist[headv+1] ; k++ )
{ if ( estripno[edgeinx[k]>>1] == 0 )
{ nexte = edgeinx[k];
break;
}
}
if ( k == evlist[headv+1] ) break; /* end of strip */
}
/* flip list around */
for ( k = striparray[stripnum].start, kk = dataspot-1 ; k < kk ; k++,kk-- )
{ int temp = stripdata[k]; stripdata[k] = stripdata[kk];
stripdata[kk] = temp;
}
/* now backwards */
nexte = 2*i+1;
for (;;)
{
estripno[nexte>>1] = stripnum+1;
headv = indexarray[edgestart+(nexte^1)];
stripdata[dataspot++] = headv;
for ( k = evlist[headv] ; k < evlist[headv+1] ; k++ )
{ if ( estripno[edgeinx[k]>>1] == 0 )
{ nexte = edgeinx[k];
break;
}
}
if ( k == evlist[headv+1] ) break; /* end of strip */
}
striparray[stripnum].count = dataspot - striparray[stripnum].start;
stripnum++;
}
estripcount = stripnum;
temp_free((char*)evlist);
temp_free((char*)estripno);
/* facets */
/* make list of edges with left-hand facets */
felist = (struct festruct *)temp_calloc(facetcount,sizeof(struct festruct));
for ( i = 0, k = 0 ; i < facetcount ; i += 3, k++ )
{ felist[i].v[0] = indexarray[facetstart+i];
felist[i].v[1] = indexarray[facetstart+i+1];
felist[i].v[2] = indexarray[facetstart+i+2];
felist[i].f = k;
felist[i+1].v[0] = indexarray[facetstart+i+1];
felist[i+1].v[1] = indexarray[facetstart+i+2];
felist[i+1].v[2] = indexarray[facetstart+i];
felist[i+1].f = k;
felist[i+2].v[0] = indexarray[facetstart+i+2];
felist[i+2].v[1] = indexarray[facetstart+i];
felist[i+2].v[2] = indexarray[facetstart+i+1];
felist[i+2].f = k;
}
qsort((void*)felist,facetcount,sizeof(struct festruct),FCAST fecomp);
fstripno = (int *)temp_calloc(facetcount/3,sizeof(int));
trialstrip = (int *)temp_calloc(facetcount/3+10,sizeof(int));
bestverts = (int *)temp_calloc(facetcount/3+10,sizeof(int));
bestfacets = (int *)temp_calloc(facetcount/3,sizeof(int));
/* now make strips. start with some facet and just keep going. */
for ( i = 0 ; i < facetcount/3 ; i++ )
{ int nextf,va,vb,vc,whichway;
int firstcount,secondcount; /* for checking orientation at start */
if ( fstripno[i] ) continue;
/* new strip */
striparray[stripnum].mode = GL_TRIANGLE_STRIP;
striparray[stripnum].start = dataspot;
bestlength = 0;
for ( way = 0 ; way < 3 ; way++)
{ int m = 0; /* trialstrip index */
dataspot = striparray[stripnum].start;
nextf = 3*i;
stripdata[dataspot++] = va = indexarray[facetstart+nextf+((1+way)%3)];
stripdata[dataspot++] = vb = indexarray[facetstart+nextf+way];
whichway = 1;
for (;;)
{ struct festruct *fe,key;
//find in felist
if ( whichway ) { key.v[0] = va; key.v[1] = vb; }
else { key.v[1] = va; key.v[0] = vb; }
fe = bsearch(&key,(void*)felist,facetcount,sizeof(struct festruct),
FCAST fecomp);
if ( fe==NULL ) break; // done; maybe hit edge of surface
//see if facet done yet
if ( fstripno[fe->f] != 0 ) break; // done in this direction
//add opposite vertex
vc = fe->v[2];
stripdata[dataspot++] = vc;
fstripno[fe->f] = stripnum+1;
trialstrip[m++] = fe->f;
// ready for next time around
va = vb;
vb = vc;
whichway = !whichway;
}
firstcount = dataspot - striparray[stripnum].start;
/* flip list around */
for ( k = striparray[stripnum].start, kk = dataspot-1 ; k < kk ; k++,kk-- )
{ int temp = stripdata[k]; stripdata[k] = stripdata[kk];
stripdata[kk] = temp;
}
/* now backwards */
va = indexarray[facetstart+nextf+way];
vb = indexarray[facetstart+nextf+((way+1)%3)];
whichway = 1;
for (;;)
{ struct festruct *fe,key;
//find in felist
if ( whichway ) { key.v[0] = va; key.v[1] = vb; }
else { key.v[1] = va; key.v[0] = vb; }
fe = bsearch(&key,(void*)felist,facetcount,sizeof(struct festruct),
FCAST fecomp);
if ( fe==NULL ) break; // done; maybe hit edge of surface
//see if facet done yet
if ( fstripno[fe->f] != 0 ) break; // done in this direction
//add opposite vertex
vc = fe->v[2];
stripdata[dataspot++] = vc;
fstripno[fe->f] = stripnum+1;
trialstrip[m++] = fe->f;
// ready for next time around
va = vb;
vb = vc;
whichway = !whichway;
}
striplength[way] = dataspot - striparray[stripnum].start;
secondcount = striplength[way] - firstcount;
// check orientation at start
if ( firstcount & 1 )
{ if ( secondcount & 1 )
{ striplength[way]--; /* omit last, if necessary */
if ( i == trialstrip[m-1] ) i--; /* so loop doesn't skip omitted facet */
}
/* flip order */
for ( k = striparray[stripnum].start,
kk = striparray[stripnum].start+striplength[way]-1 ; k < kk ; k++,kk-- )
{ int temp = stripdata[k]; stripdata[k] = stripdata[kk];
stripdata[kk] = temp;
}
}
if ( striplength[way] > bestlength )
{ bestlength = striplength[way];
bestway = way;
memcpy(bestverts,stripdata+striparray[stripnum].start,bestlength*sizeof(int));
memcpy(bestfacets,trialstrip,(bestlength-2)*sizeof(int));
}
for ( k = 0 ; k < m ; k++ ) /* unmark */
fstripno[trialstrip[k]] = 0;
} /* end ways */
memcpy(stripdata+striparray[stripnum].start,bestverts,bestlength*sizeof(int));
for ( k = 0 ; k < bestlength-2 ; k++ ) /* remark */
{ fstripno[bestfacets[k]] = stripnum+1;
if ( strip_color_flag && (bestfacets[k] < web.skel[FACET].maxcount) )
set_facet_color(bestfacets[k],(stripnum % 14) + 1);
}
striparray[stripnum].count = bestlength;
dataspot = striparray[stripnum].start + bestlength;
stripnum++;
}
temp_free((char*)evlist);
temp_free((char*)estripno);
temp_free((char*)fstripno);
temp_free((char*)trialstrip);
temp_free((char*)bestverts);
temp_free((char*)bestfacets);
stripcount = stripnum;
fstripcount = stripcount - estripcount;
/* cut down arrays to needed size */
stripdata = (int*)kb_realloc((char*)stripdata,dataspot*sizeof(int));
striparray = (struct stripstruct *)kb_realloc((char*)striparray,
stripcount*sizeof(struct stripstruct));
if ( q_flag )
{ sprintf(msg,"After stripping: %d edgestrips, %d facetstrips\n",
estripcount,fstripcount);
outstring(msg);
}
}
/***************************************************************************
*
* function: hashfunc()
*
* purpose: Compute hash value for vertex.
*/
int hashsize; /* size of hashtable */
int hashfunc(struct vercol *a)
{
int h;
int scale = 100000;
double eps = 3.e-6; /* to prevent coincidences */
h = 15187*(int)(scale*a->x[0]+eps);
h += 4021*(int)(scale*a->x[1]+eps);
h += 2437*(int)(scale*a->x[2]+eps);
h += 7043*(int)(scale*a->n[0]+eps);
h += 5119*(int)(scale*a->n[1]+eps);
h += 8597*(int)(scale*a->n[2]+eps);
h += 1741*(int)(scale*a->c[0]+eps);
h += 4937*(int)(scale*a->c[1]+eps);
h += 1223*(int)(scale*a->c[2]+eps);
h = h % hashsize;
if ( h < 0 ) h += hashsize;
return h;
}
/***************************************************************************
*
* function: make_indexlists()
*
* purpose: Uniquify vertex and edge lists, and create index array for
* OpenGL. Also needed for strips.
*/
void make_indexlists()
{ int i,j;
int rawcount = edgecount+facetcount; /* number of unsorted vertices */
struct vercol **hashlist;
float mat[4][4];
/* get reasonable epsilon for identifying vertices */
glGetFloatv(GL_MODELVIEW_MATRIX,mat[0]);
gleps = 1e-5/sqrt(mat[0][0]*mat[0][0]+mat[0][1]*mat[0][1]
+mat[0][2]*mat[0][2]);
/* Uniquify using hash table */
/* qsort here is a time hog */
if ( indexarray ) myfree((char*)indexarray);
indexarray = (int*)mycalloc(rawcount,sizeof(int));
hashlist = (struct vercol**)temp_calloc(2*rawcount,sizeof(struct vercol *));
hashsize = 2*rawcount;
hashlist[hashfunc(fullarray)] = fullarray;
indexarray[0] = 0;
for ( i = 1, j = 1 ; i < rawcount ; i++ )
{ int h = hashfunc(fullarray+i);
while ( hashlist[h] && vercolcomp(hashlist[h],fullarray+i) )
{ h++; if ( h == hashsize ) h = 0; }
if ( hashlist[h] == NULL ) /* new one */
{
fullarray[j] = fullarray[i];
hashlist[h] = fullarray+j;
j++;
}
indexarray[i] = hashlist[h]-fullarray;
}
temp_free((char*)hashlist);
vertexcount = j;
// Uniquify edges
for ( i = edgestart ; i < edgestart+edgecount ; i += 2 )
{ if ( indexarray[i] > indexarray[i+1] )
{ int temp = indexarray[i];
indexarray[i] = indexarray[i+1];
indexarray[i+1] = temp;
}
}
/* qsort here relatively minor in time */
qsort((void*)(indexarray+edgestart),edgecount/2,2*sizeof(int), FCAST eecomp);
for ( i = 2, j = 0 ; i < edgecount ; i += 2 )
{ if ( eecomp(indexarray+edgestart+i,indexarray+edgestart+j) != 0 )
{ j += 2;
if ( i > j )
{ indexarray[edgestart+j] = indexarray[edgestart+i];
indexarray[edgestart+j+1] = indexarray[edgestart+i+1];
}
}
}
if ( edgecount ) edgecount = j+2;
} /* end make_indexlists() */
evolver-2.30c.dfsg/src/painter.c 0000644 0001753 0001753 00000264624 11410765113 017041 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: painter.c
*
* Contents: Routines to accumulate and sort facets for display
* back to front. Not device specific, but calls
* device specific routines for actual display.
* Also does transformations on edges.
* painter_end() uses Newell-Newell-Sancha algorithm
* to depth sort and display facets.
* This version uses a separate quadtree of depth-ordered
* lists from the drawing-order list to minimize comparisons
* needed for large elements.
*/
/* Some timings with version 2.18j on starfish31.dmp (2560 facets)
Without visibility test:
Shape Fund. time,sec filesize
Fund 1 0.093 190,829
Cubelet 12 1.08 2,276,025
Cube 48 4.64 9,100,293
Rhomb 96 9.625 18,199,633
With visibility test:
Shape Fund. time,sec filesize
Fund 1 0.165 168,332
Cubelet 12 1.89 1,444,778
Cube 48 9.56 4,456,944
Rhomb 96 24.7 7,162,980
*/
#include "include.h"
static int count; /* number of facets */
static int maxcount; /* number allocated */
struct tsort *trilist; /* list for depth sorting triangles */
static int gdim = 3; /* dimension doing graphics in */
/* results of comparing depth of facets */
#define DISJOINT 1
#define FIRST_BACK 2
#define SECOND_BACK 4
#define ASPLITTINGB 8
#define BSPLITTINGA 16
#define NOTKNOWN 32
#define COPLANAR 64
#define TEXTRA 100
REAL tableau[7][3]; /* simplex tableau */
void pivot ARGS((int ,int ));
int newell_split ARGS((struct tsort *,struct tsort *,struct tsort *,struct tsort *));
int backstamp; /* for timestamping being at back of list */
int plane_test ARGS((struct tsort *,struct tsort *));
int setquadcode ARGS((struct tsort *));
void find_bbox ARGS((struct tsort *));
int separating_line ARGS((struct tsort*,struct tsort*));
int separating_plane ARGS((struct tsort*,struct tsort*,int));
static int ttcompare(t1,t2) /* depth comparison for sort */
struct tsort **t1,**t2;
{
/* First, compare back z */
if ( t1[0]->mins[2] > t2[0]->mins[2] ) return 1;
if ( t1[0]->mins[2] < t2[0]->mins[2] ) return -1;
/* Break ties with front z */
if ( t1[0]->maxs[2] > t2[0]->maxs[2] ) return 1;
if ( t1[0]->maxs[2] < t2[0]->maxs[2] ) return -1;
/* Finally, break ties with id to get consistent ordering,
independent of how many elements are being sorted */
if ( t1[0]->f_id > t2[0]->f_id ) return 1;
if ( t1[0]->f_id < t2[0]->f_id ) return -1;
return 0;
}
/* quadtree of depth lists */
struct qtree_t { struct tsort *depthhead;
float maxdepth; /* of all in subtree */
} *qtree;
int maxquaddepth = 8; /* maximum depth of quadtree */
int get_quadindex ARGS((unsigned int));
void qdepth_insert ARGS((struct tsort *));
struct tsort *search_subtree ARGS((int,struct tsort *,int *));
/* visibility stuff */
void visibility_stage ARGS((struct tsort *));
void visibility_end ARGS((void));
int vis_count; /* used structures */
int vis_max; /* allocated structures */
struct tsort *vis_list; /* storage */
/*****************************************************************
*
* Function: find_bbox()
*
* Purpose: find 3D bounding box for edge or facet.
*
*/
void find_bbox(t)
struct tsort *t;
{ int n;
REAL dx,dy,len;
if ( (t->flag & 0xF) == EDGE )
{
if ( t->flag & EDGE_ARC )
{ REAL w1[MAXCOORD],w2[MAXCOORD],mag1,mag2,w1w2,center[2],radius;
REAL det,angle1,angle2;
int i;
for (i = 0 ; i < SDIM ; i++ )
{ w1[i] = t->x[1][i] - t->x[0][i];
w2[i] = t->x[2][i] - t->x[0][i];
}
det = w1[0]*w2[1] - w1[1]*w2[0];
mag1 = SDIM_dot(w1,w1); mag2 = SDIM_dot(w2,w2);
w1w2 = w1[0]*w2[0] + w1[1]*w2[1];
for ( n = 0 ; n < gdim ; n++ )
{ /* endpoints first */
if ( t->x[0][n] < t->x[2][n] )
{ t->maxs[n] = t->x[2][n];
t->mins[n] = t->x[0][n];
}
else
{ t->maxs[n] = t->x[0][n];
t->mins[n] = t->x[2][n];
}
}
if ( 4000*det*det > mag1*mag1*mag2 + mag1*mag2*mag2 - 2*mag1*w1w2*mag2 )
{ /* circle rather that straight line */
center[0] = t->x[0][0] + 0.5*(w2[1]*mag1 - w1[1]*mag2)/det;
center[1] = t->x[0][1] + 0.5*(-w2[0]*mag1 + w1[0]*mag2)/det;
radius = sqrt((mag1*mag1*mag2+mag1*mag2*mag2-2*mag1*w1w2*mag2)
/4/det/det);
angle1 = atan2(t->x[0][1]-center[1],t->x[0][0]-center[0]);
angle2 = atan2(t->x[2][1]-center[1],t->x[2][0]-center[0]);
if ( det < 0 )
{ REAL temp = angle1; angle1 = angle2; angle2 = temp; }
if ( angle2 < angle1 ) angle2 += 2*M_PI;
if ( (angle1 < 0.0 && angle2 > 0.0 ) ||
(angle1 < 2*M_PI && angle2 > 2*M_PI) )
t->maxs[0] = (float)(center[0] + radius);
if ( (angle1 < M_PI && angle2 > M_PI ) ||
(angle1 < 3*M_PI && angle2 > 3*M_PI) )
t->mins[0] = (float)(center[0] - radius);
if ( (angle1 < M_PI/2 && angle2 > M_PI/2 ) ||
(angle1 < 5*M_PI/2 && angle2 > 5*M_PI/2) )
t->maxs[1] = (float)(center[1] + radius);
if ( (angle1 < -M_PI/2 && angle2 > -M_PI/2 ) ||
(angle1 < 3*M_PI/2 && angle2 > 3*M_PI/2) )
t->mins[1] = (float)(center[1] - radius);
return;
}
} /* end EDGE_ARC */
else /* just a straight segment */
for ( n = 0 ; n < gdim ; n++ )
{ if ( t->x[0][n] < t->x[1][n] )
{ t->maxs[n] = t->x[1][n];
t->mins[n] = t->x[0][n];
}
else
{ t->maxs[n] = t->x[0][n];
t->mins[n] = t->x[1][n];
}
}
/* adjust extents for thickness */
dx = fabs(t->x[1][0] - t->x[0][0]);
dy = fabs(t->x[1][1] - t->x[0][1]);
len = sqrt(dx*dx+dy*dy);
if ( len > 0.0 )
{ t->maxs[0] += (float)(dy/len*t->width/2);
t->mins[0] -= (float)(dy/len*t->width/2);
t->maxs[1] += (float)(dx/len*t->width/2);
t->mins[1] -= (float)(dx/len*t->width/2);
}
return;
} /* end EDGE */
/* facet */
for ( n = 0 ; n < gdim ; n++ )
{ if ( t->x[0][n] < t->x[1][n] )
{ if ( t->x[2][n] < t->x[0][n] )
{ t->maxs[n] = t->x[1][n];
t->mins[n] = t->x[2][n];
}
else if ( t->x[1][n] < t->x[2][n] )
{ t->maxs[n] = t->x[2][n];
t->mins[n] = t->x[0][n];
}
else
{ t->maxs[n] = t->x[1][n];
t->mins[n] = t->x[0][n];
}
}
else
{ if ( t->x[2][n] < t->x[1][n] )
{ t->maxs[n] = t->x[0][n];
t->mins[n] = t->x[2][n];
}
else if ( t->x[0][n] < t->x[2][n] )
{ t->maxs[n] = t->x[2][n];
t->mins[n] = t->x[1][n];
}
else
{ t->maxs[n] = t->x[0][n];
t->mins[n] = t->x[1][n];
}
}
}
}
/* For setting quadtree code and checking if in bounding box. */
/* Coded for 32 bit ints. */
#define OUTOFBOX 0
#define INTHEBOX 1
int setquadcode(t)
struct tsort *t;
{ unsigned int q = 0; /* the quadcode */
unsigned int bit = 1; /* for shifting to quad bit position */
int n;
REAL midx = (minclipx+maxclipx)/2;
REAL midy = (minclipy+maxclipy)/2;
REAL deltax = (maxclipx-minclipx)/4;
REAL deltay = (maxclipy-minclipy)/4;
if ( t->maxs[0] < minclipx || t->mins[0] > maxclipx || t->maxs[1] < minclipy
|| t->mins[1] > maxclipy ) return OUTOFBOX;
for ( n = 0 ; n < 8 ; n++, deltax /= 2, deltay /= 2 )
{
if ( t->maxs[0] <= midx )
{ q |= bit; midx -= deltax; }
else if ( t->mins[0] >= midx )
{ q |= bit<<1; midx += deltax; }
else break;
bit <<= 2;
if ( t->maxs[1] <= midy )
{ q |= bit; midy -= deltay; }
else if ( t->mins[1] >= midy )
{ q |= bit<<1; midy += deltay; }
else break;
bit <<= 2;
}
t->quadcode = q;
return INTHEBOX;
}
void painter_start()
{ int dummy;
long allocsize;
gdim = (SDIM <= 3) ? SDIM : 3;
/* allocate space for depth sort list */
if ( web.representation == STRING )
{ maxcount = web.skel[EDGE].count + 5;
if ( web.torus_flag ) maxcount *= 2;
}
else
{ if ( web.torus_flag )
if ( torus_display_mode == TORUS_CLIPPED_MODE )
maxcount = 5*web.skel[FACET].count+ bare_edge_count + 5;
else maxcount = 2*web.skel[FACET].count+ bare_edge_count + 5;
else
maxcount = web.skel[FACET].count + bare_edge_count + 5;
}
if ( transforms_flag ) maxcount *= transform_count;
if ( web.dimension > 2 )
maxcount *= web.dimension+1; /* each simplex face becomes facet */
allocsize = (long)maxcount*sizeof(struct tsort);
if ( allocsize >= MAXALLOC )
maxcount = MAXALLOC/sizeof(struct tsort);
trilist = (struct tsort *)temp_calloc(maxcount,sizeof(struct tsort));
count = 0;
vis_count = 0;
vis_list = NULL;
vis_max = 0;
backstamp = 0;
ps_widthattr = find_extra(PS_WIDTHNAME,&dummy);
}
void painter_edge(gdata,e_id)
struct graphdata *gdata;
edge_id e_id;
{
struct tsort *t;
int i,j;
REAL a[MAXCOORD+1],b[MAXCOORD+1];
REAL dx,dy,dz,mag,width;
int ctrl_pts = gdata[0].flags & EDGE_ARC ? 3 : 2;
if ( gdata->color == CLEAR ) return;
if ( count >= maxcount-2 )
{ trilist = (struct tsort *)temp_realloc((char*)trilist,
(maxcount+200)*sizeof(struct tsort));
maxcount += 200;
}
t = trilist + count;
t->flag = EDGE;
t->flag |= (gdata->flags & (EDGE_ARC|LABEL_EDGE|LABEL_HEAD|LABEL_TAIL));
for ( j = SDIM ; j < HOMDIM-1 ; j++ ) a[j] = 0.0; /* filler */
for ( i = 0 ; i < ctrl_pts ; i++ )
{
for ( j = 0 ; (j < SDIM) && (j < HOMDIM-1) ; j++ )
a[j] = gdata[i].x[j];
a[HOMDIM-1] = 1.0;
matvec_mul(view,a,b,HOMDIM,HOMDIM); /* transform */
if ( SDIM <= 2 )
for ( j = 0 ; j < 3 ; j++ ) t->x[i][j] = (float)b[j];
else for ( j = 0 ; j < 3 ; j++ ) t->x[i][j] = (float)b[(j+1)%3];
t->x[i][2] += (float).0001; /* bias edges in front of facets */
}
/* width of edge, in descending order of thickness */
if ( ps_widthattr >= 0 )
width = *EREAL(t->f_id,ps_widthattr);
else if ( gdata->etype & BARE_EDGE ) width = ps_bareedgewidth;
else if ( gdata->etype & FIXED_EDGE ) width = ps_fixededgewidth;
else if ( gdata->etype & CONSTRAINT_EDGE ) width = ps_conedgewidth;
else if ( gdata->etype & BOUNDARY_EDGE ) width = ps_conedgewidth;
else if ( gdata->etype & SINGLE_EDGE ) width = ps_stringwidth;
else if ( gdata->etype & TRIPLE_EDGE ) width = ps_tripleedgewidth;
else width = ps_gridedgewidth; /* regular grid interior edge */
t->width = (float)width;
t->f_id = e_id;
t->color = t->ecolor[0] = gdata->ecolor;
t->etype[0] = gdata->etype;
/* find extents */
find_bbox(t);
/* normal vector, closest to z axis */
dx = t->x[1][0] - t->x[0][0];
dy = t->x[1][1] - t->x[0][1];
dz = t->x[1][2] - t->x[0][2];
t->normal[0] = (float)(dx*dz);
t->normal[1] = (float)(dy*dz);
t->normal[2] = -(float)(dx*dx+dy*dy);
mag = sqrt(dotf(t->normal,t->normal,3));
if ( mag != 0.0 )
for ( i = 0 ; i < 3; i++ ) t->normal[i] /= (float)mag;
if ( setquadcode(t) == OUTOFBOX ) return;
count++;
}
void painter_facet(gdata,f_id)
struct graphdata *gdata;
facet_id f_id;
{
int i,j;
REAL a[MAXCOORD+1],b[FACET_VERTS][MAXCOORD+1];
struct tsort *t;
REAL normal[MAXCOORD],mag;
if ( gdata[0].color == UNSHOWN )
{ /* just do edges */
struct graphdata ggdata[2];
facetedge_id fe=NULLID;
if ( valid_id(f_id) )
fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ if ( (gdata[i].etype&EBITS) == INVISIBLE_EDGE ) continue;
ggdata[0] = gdata[i];
ggdata[0].color = gdata[i].ecolor;
ggdata[1] = gdata[i==2 ? 0 : i+1];
if ( valid_id(fe) )
{ painter_edge(ggdata,get_fe_edge(fe));
fe = get_next_edge(fe);
}
else painter_edge(ggdata,NULLID);
}
return;
}
if ( count >= maxcount )
{ trilist = (struct tsort *)temp_realloc((char*)trilist,
(maxcount+200)*sizeof(struct tsort));
maxcount += 200;
}
t = trilist + count;
t->flag = FACET | (gdata->flags&LABEL_FACET);
t->f_id = f_id;
t->color = gdata[0].backcolor; /* not sure why, but works */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ t->ecolor[i] = gdata[i].ecolor;
t->etype[i] = gdata[i].etype;
t->v_id[i] = gdata[i].v_id;
}
/* accumulate list of triangles to display */
for ( j = SDIM ; j < HOMDIM-1 ; j++ ) a[j] = 0.0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
for ( j = 0 ; (j < SDIM) && (j < HOMDIM-1) ; j++ )
a[j] = gdata[i].x[j];
a[HOMDIM-1] = 1.0;
matvec_mul(view,a,b[i],HOMDIM,HOMDIM); /* transform */
if ( SDIM <= 2 )
{ t->x[i][0] = (float)b[i][0];
t->x[i][1] = (float)b[i][1];
}
else
{ t->x[i][0] = (float)b[i][1];
t->x[i][1] = (float)b[i][2];
t->x[i][2] = (float)b[i][0];
}
}
if ( SDIM <= 2 )
{ t->normal[0] = t->normal[1] = 0.0;
t->normal[2] = 1.0;
}
else
{ vnormal(b[0],b[1],b[2],normal);
mag = sqrt(SDIM_dot(normal,normal));
if ( mag > 0.0 )
{ t->normal[0] = (float)(normal[1]/mag);
t->normal[1] = (float)(normal[2]/mag);
t->normal[2] = (float)(normal[0]/mag);
if ( fabs(t->normal[2]) < 1e-6 ) t->normal[2] = 0.0;
} else
{ t->normal[0] = 0.0f;
t->normal[1] = 0.0f;
t->normal[2] = 1.0f;
}
}
if ( t->normal[2] > (float)0.0 ) /* frontward normal */
{ int c;
vertex_id tv;
for ( i = 0 ; i < gdim ; i++ )
{ float temp = (float)t->x[1][i];
t->x[1][i] = t->x[2][i];
t->x[2][i] = temp;
t->normal[i] = -t->normal[i];
}
c = t->ecolor[0];
t->ecolor[0] = t->ecolor[2];
t->ecolor[2] = c;
c = t->etype[0] ^ LABEL_REVERSED;
t->etype[0] = t->etype[2] ^ LABEL_REVERSED;
t->etype[2] = (short)c;
t->etype[1] ^= LABEL_REVERSED;
t->color = gdata[0].color;
tv = t->v_id[1];
t->v_id[1] = t->v_id[2];
t->v_id[2] = tv;
t->flag |= FLIPPED_FACET;
}
else
{
if ( backcull_flag && (gdata[0].color == gdata[0].backcolor) ) return;
}
/* find extents */
find_bbox(t);
if ( setquadcode(t) == OUTOFBOX ) return;
count++;
}
/* stats for analyzing performance; REAL to handle large counts */
REAL in_back_calls;
REAL box_overlaps;
REAL facetfacet;
REAL facetedge;
REAL edgeedge;
REAL crossings;
REAL swaps;
REAL done;
REAL loopbailouts;
REAL sep_line_calls;
REAL sep_plane_calls;
struct tsort **tlist;
/*struct tsort *depthhead;*/
/*************************************************************************
*
* function: search_subtree()
*
* purpose: search node and subtree of quadtree depth lists for an
* element obscured by given element.
* return: pointer to obscured element, or NULL if none found.
* also retval to indicate type of relationship
*/
struct tsort *search_subtree(qinx,tk,retval)
int qinx; /* index of node in quadtree */
struct tsort *tk; /* given element */
int *retval;
{ struct tsort *tj;
*retval = 0;
/* check overall subtree max depth */
if ( tk->maxs[2] <= qtree[qinx].maxdepth )
return NULL;
/* the node itself */
for ( tj = qtree[qinx].depthhead ; tj != NULL ; tj = tj->next )
{
if ( tj == tk ) continue;
if ( tk->maxs[2] <= tj->mins[2] )
break;
*retval = in_back(tk,tj);
if ( *retval & (FIRST_BACK|COPLANAR|DISJOINT) ) continue;
return tj;
}
/* one child */
tj = search_subtree(2*qinx,tk,retval);
if ( tj ) return tj;
/* other child */
return search_subtree(2*qinx+1,tk,retval);
}
#ifdef XXXXX
/* for debugging */
void loopchecker()
{ int counter;
int qinx;
int i;
for ( i = 0 ; i < count+TEXTRA ; i++ )
if ( tlist[i]->spot != i )
kb_error(2893,"Bad spot\n",RECOVERABLE);
for ( qinx = 0 ; qinx < 0x40000 ; qinx++ )
{ struct tsort *tj;
int q;
struct tsort *slowboat = qtree[qinx].depthhead; /* likewise */
struct tsort *prev = NULL;
if ( slowboat == NULL ) continue;
counter = 0; q = slowboat->quadcode;
if ( qinx != get_quadindex(q) )
kb_error(2585,"Bad qinx.\n",RECOVERABLE);
for ( tj = qtree[qinx].depthhead ; tj != NULL ; prev=tj,tj = tj->next )
{ /* loop detection */
if ( tj->prev != prev )
kb_error(2892,"bad prev\n",RECOVERABLE);
if ( tj->quadcode != q )
kb_error(2891,"Bad qinx.\n",RECOVERABLE);
if ( counter & 1) slowboat = slowboat->next;
if ( (slowboat == tj) && (counter > 1) )
kb_error(2591,"Internal error: loop in loopchecker()\n",
RECOVERABLE);
counter++;
}
}
}
#endif
/**************************************************************************
*
* function: painter_end()
*
* purpose: sort and display facets and edges from trilist.
*/
/* for debugging; just displays list as is after given number of facets */
int debug_k = 0x7FFFFFFF;
void painter_end()
{
int k;
int loopcount; /* for emergency loop bailout */
struct tsort **ll,*tt;
int quadalloc;
int k_top; /* top of tlist */
struct tsort textra[TEXTRA]; /* for triangle fragments */
in_back_calls = box_overlaps = facetfacet = facetedge = edgeedge =
crossings = sep_plane_calls = sep_line_calls = 0;
loopbailouts = 0;
if ( count > maxcount ) count = maxcount; /* in case there was excess */
/* find bounding box */
if ( need_bounding_box )
{ struct tsort *t;
bbox_minx = bbox_miny = 1e20;
bbox_maxx = bbox_maxy = -1e20;
for ( k = 0, t = trilist ; k < count ; k++,t++ )
{ if ( t->mins[0] < bbox_minx ) bbox_minx = (REAL)t->mins[0];
if ( t->mins[1] < bbox_miny ) bbox_miny = (REAL)t->mins[1];
if ( t->maxs[0] > bbox_maxx ) bbox_maxx = (REAL)t->maxs[0];
if ( t->maxs[1] > bbox_maxy ) bbox_maxy = (REAL)t->maxs[1];
}
}
(*init_graphics)();
if ( SDIM == 2 ) /* don't bother with depth */
{ for ( k = 0 ; k < count ; k++ )
visibility_stage(trilist+k);
goto end_exit;
}
/* now sort on min z, moving pointers instead of structures */
/* leaving room at front of list for extra fragments */
tlist = (struct tsort **)temp_calloc(count+TEXTRA,sizeof(struct tsort *));
for ( k = 0, ll=tlist+TEXTRA, tt=trilist ; k < count ; k++ ) *(ll++) = tt++;
qsort((char *)(tlist+TEXTRA),count,sizeof(struct tsort *),FCAST ttcompare);
for ( k = 0 ; k < TEXTRA ; k++ )
{ tlist[k] = textra+k; tlist[k]->spot = k; tlist[k]->flag = 0; }
for ( k = TEXTRA ; k < TEXTRA+count ; k++ )
tlist[k]->spot = k;
/* quadtree of depth lists */
maxquaddepth = 8; /* maybe make this adjustable later */
quadalloc = 2 << (2*maxquaddepth + 1);
qtree = (struct qtree_t *)temp_calloc(quadalloc,sizeof(struct qtree_t));
for ( k = 0 ; k < quadalloc ; k++ )
qtree[k].maxdepth = 1e30f;
for ( k = count+TEXTRA-1 ; k >= TEXTRA ; k-- )
qdepth_insert(tlist[k]);
/* display */
loopcount = 0;
k_top = count+TEXTRA;
for ( k = TEXTRA ; k < k_top ; )
{ struct tsort *tk = tlist[k];
struct tsort *tj;
int sinx,qinx=0;
int retval;
if ( breakflag ) break;
if ( !tk->flag ) { k++; continue; }
/* for debugging and testing */
if ( k > debug_k )
goto draw_it;
/* tk is current candidate back facet */
/* search quadtree list for any z overlap */
/* First, node to root */
qinx = get_quadindex(tk->quadcode);
for ( sinx = qinx >> 1 ; sinx != 0 ; sinx >>= 1 )
{ for ( tj = qtree[sinx].depthhead ; tj != NULL ; tj = tj->next )
{
if ( tj == tk ) continue;
if ( tk->maxs[2] <= tj->mins[2] )
break;
retval = in_back(tk,tj);
if ( retval & (FIRST_BACK|COPLANAR|DISJOINT) ) continue;
goto have_conflict;
}
}
/* now search subtree for conflicts */
tj = search_subtree(qinx,tk,&retval);
if ( tj==NULL ) goto draw_it;
have_conflict:
/* Now have conflict, tk obscuring tj */
/* test for possible looping, and if found, split tk */
if ( (tj->backstamp == backstamp) )
{ int ret;
crossings++;
if ( ++loopcount > count )
{ loopbailouts++; goto draw_it; }
/* need to split */
if ( k < 2 )
{ /* not enough room, so expand tlist allocation, with free at start */
int newsize = 2*k_top;
int n;
struct tsort *more = (struct tsort*)temp_calloc(k_top,sizeof(struct tsort));
tlist = (struct tsort**)temp_realloc((char*)tlist,newsize*sizeof(struct tsort*));
for ( n = 0 ; n < k_top ; n++ )
{ tlist[n+k_top] = tlist[n];
tlist[n] = more+n;
}
for ( n = 0 ; n < newsize ; n++ )
tlist[n]->spot = n;
k += k_top;
k_top = newsize;
}
if( retval & BSPLITTINGA )
{
ret = newell_split(tk,tj,tlist[k-1],tlist[k-2]);
if ( ret )
{
k -= ret;
goto repeat_tests; /* might not have split */
}
}
else if ( retval & ASPLITTINGB )
{
/* try splitting the other way */
ret = newell_split(tj,tk,tlist[k-1],tlist[k-2]);
if ( ret )
{ k -= ret;
goto repeat_tests;
}
}
else if ( ((tk->flag & 0xF) == EDGE) && ((tj->flag & 0xF) == EDGE) )
{
ret = newell_split(tk,tj,tlist[k-1],tlist[k-2]);
if ( ret )
{
k -= ret;
goto repeat_tests; /* might not have split */
}
}
}
tk->backstamp = backstamp;
/* swap tj and tk */
tlist[k] = tj;
tlist[tj->spot] = tk;
tk->spot = tj->spot;
tj->spot = k;
swaps++;
goto repeat_tests;
draw_it:
visibility_stage(tk);
loopcount = 0;
tk->flag = 0; /* to indicate empty structure */
/* remove from depth list */
if ( tk == qtree[qinx].depthhead )
qtree[qinx].depthhead = tk->next;
sinx = qinx;
/* fix up subtree maxdepths */
while ( sinx && ( tk->mins[2] <= qtree[sinx].maxdepth ) )
{ float maxd = 1e30f;
if ( qtree[sinx].depthhead )
maxd = qtree[sinx].depthhead->mins[2];
if ( sinx < (1 << (2*maxquaddepth)) )
{ if ( maxd > qtree[2*sinx].maxdepth )
maxd = qtree[2*sinx].maxdepth;
if ( maxd > qtree[2*sinx+1].maxdepth )
maxd = qtree[2*sinx+1].maxdepth;
}
qtree[sinx].maxdepth = maxd;
sinx >>= 1;
}
if ( tk->prev ) tk->prev->next = tk->next;
if ( tk->next ) tk->next->prev = tk->prev;
repeat_tests:
continue;
}
end_exit:
if ( verbose_flag )
{
printf("in_back_calls: %g\n",in_back_calls);
printf(" facetfacet: %g\n",facetfacet);
printf(" facetedge: %g\n",facetedge);
printf(" edgeedge: %g\n",edgeedge);
printf("box_overlaps: %g\n",box_overlaps);
printf("sep_line_calls: %g\n",sep_line_calls);
printf("sep_plane_calls: %g\n",sep_plane_calls);
printf("crossings: %g\n",crossings);
printf("swaps: %g\n",swaps);
printf("loop bailouts: %g\n",loopbailouts);
}
if ( tlist ) temp_free((char *)tlist);
if ( qtree ) temp_free((char *)qtree);
temp_free((char *)trilist); trilist = NULL;
if ( visibility_test )
visibility_end();
(*finish_graphics)();
} /* end old painter_end() */
/*********************************************************************
*
* function: in_back()
*
* purpose: see if one facet or edge obscures another.
*
* returns DISJOINT, FIRST_BACK, SECOND_BACK, ASPLITTINGB, BSPLITTINGA,
* or COPLANAR (possibly bitwise OR)
*/
int in_back(ta,tb)
struct tsort *ta,*tb;
{
int n;
int retval;
if ( verbose_flag )
{
in_back_calls++;
if ( (ta->flag & 0xF) == FACET )
{ if ( (tb->flag & 0xF) == FACET )
facetfacet++;
else facetedge++;
}
else
{ if ( (tb->flag & 0xF) == FACET )
facetedge++;
else edgeedge++;
}
}
/* quick test with quadcodes */
if ( ((ta->quadcode & tb->quadcode) != ta->quadcode) &&
((ta->quadcode & tb->quadcode) != tb->quadcode) )
return DISJOINT;
/* test x and y extent overlap */
for ( n = 0 ; n < 2 ; n++ )
if ( (tb->maxs[n] <= ta->mins[n]) || (tb->mins[n] >= ta->maxs[n]) )
return DISJOINT;
if ( ta->maxs[2] <= tb->mins[2] ) return FIRST_BACK;
box_overlaps++; /* for verbose stats */
if ( separating_line(ta,tb) == DISJOINT ) return DISJOINT;
retval = plane_test(ta,tb);
if ( retval & (FIRST_BACK|COPLANAR|DISJOINT) ) return retval;
/* now the nitty gritty check to see if they overlap */
#ifdef ZZZ
if ( (ta->flag & 0xF) == FACET )
{ if ( (tb->flag & 0xF) == FACET )
return facetfacetcompare(ta,tb);
else
{ retval = edgefacetcompare(tb,ta);
if ( retval & (FIRST_BACK|SECOND_BACK) )
return retval ^ (FIRST_BACK|SECOND_BACK);
else return retval;
}
}
else
{ if ( (tb->flag & 0xF) == FACET )
return edgefacetcompare(ta,tb);
else
{ retval = edgeedgecompare(tb,ta);
if ( retval & (FIRST_BACK|SECOND_BACK) )
return retval ^ (FIRST_BACK|SECOND_BACK);
else return retval;
}
}
#endif
return retval;
}
/**************************************************************************
*
* function: get_quadindex()
*
* purpose: convert quadcode to index number in quadtree list.
*
*/
int get_quadindex(q)
unsigned int q;
{ int inx,k;
inx = 1;
for ( k = 0 ; k < 2*maxquaddepth ; k++, q >>= 2 )
{ int bits = q & 0x3;
if ( bits == 0 ) return inx;
inx <<= 1;
if ( bits == 2 )
inx++;
}
return inx;
}
/**************************************************************************
*
* function: qdepth_insert()
*
* purpose: insert new fragment in proper place in quadtree depth list.
* For now, crude linear search.
*/
void qdepth_insert(tc)
struct tsort *tc;
{ struct tsort *prev,*next;
int qinx = get_quadindex(tc->quadcode);
int sinx;
/* take care of maxdepths of subtrees */
sinx = qinx;
while ( sinx && (tc->mins[2] < qtree[sinx].maxdepth) )
{ qtree[sinx].maxdepth = tc->mins[2];
sinx >>= 1;
}
prev = NULL;
for ( next=qtree[qinx].depthhead; next != NULL; prev=next, next=next->next )
{
if ( tc->mins[2] < next->mins[2] )
{ tc->next = next;
tc->prev = prev;
if ( prev )
prev->next = tc;
else qtree[qinx].depthhead = tc;
next->prev = tc;
goto qdepth_insert_exit;
}
}
/* at end of list */
if ( prev ) prev->next = tc;
else qtree[qinx].depthhead = tc;
tc->next = NULL;
tc->prev = prev;
qdepth_insert_exit:;
}
/*************************************************************************
*
* function: newell_split()
*
* purpose: split one triangle by plane of another.
*
* return: number of new elements generated.
*/
int newell_split(ta,tb,tc,td)
struct tsort *ta; /* splittee and fragment return */
struct tsort *tb; /* splitter */
struct tsort *tc; /* fragment return */
struct tsort *td; /* fragment return */
{
int i;
REAL d0,d1,d2,db;
int retval;
int tmpspot;
backstamp++; /* clear loop indications */
if ( (tb->flag & 0xF) == EDGE )
{ struct tsort *t;
if ( (ta->flag & 0xF) == EDGE )
{ /* cut first edge in half */
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
for ( i = 0 ; i < gdim ; i++ )
{ float mid = (ta->x[0][i] + ta->x[1][i])/2;
if ( ta->x[0][2] > ta->x[1][2] ) /* ta is back half */
{ ta->x[0][i] = mid; tc->x[1][i] = mid; }
else { ta->x[1][i] = mid; tc->x[0][i] = mid; }
}
for ( i = 0 ; i < gdim ; i++ )
{ ta->mins[i] = (ta->x[0][i]x[1][i]) ? ta->x[0][i] : ta->x[1][i];
tc->mins[i] = (tc->x[0][i]x[1][i]) ? tc->x[0][i] : tc->x[1][i];
ta->maxs[i] = (ta->x[0][i]>ta->x[1][i]) ? ta->x[0][i] : ta->x[1][i];
tc->maxs[i] = (tc->x[0][i]>tc->x[1][i]) ? tc->x[0][i] : tc->x[1][i];
}
/* find_bbox(tc); */
if ( setquadcode(tc) == INTHEBOX )
{ qdepth_insert(tc);
return 1;
}
else { tc->flag = 0; return 0; }
}
t = ta; ta = tb; tb = t; /* swap so edge first */
}
if ( (ta->flag & 0xF) == EDGE ) /* tb assumed to be facet */
{
db = dotf(tb->normal,tb->x[0],gdim);
d0 = dotf(tb->normal,ta->x[0],gdim);
d1 = dotf(tb->normal,ta->x[1],gdim);
/* fill in fragment info */
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
for ( i = 0 ; i < gdim ; i++ )
{ double mid = (((db-d0)*ta->x[1][i] + (d1-db)*ta->x[0][i])/(d1-d0));
if ( ta->x[0][2] < ta->x[1][2] ) /* keep ta as back part */
ta->x[1][i] = tc->x[0][i] = (float)mid;
else ta->x[0][i] = tc->x[1][i] = (float)mid;
}
for ( i = 0 ; i < gdim ; i++ )
{ ta->mins[i] = (ta->x[0][i]x[1][i]) ? ta->x[0][i] : ta->x[1][i];
tc->mins[i] = (tc->x[0][i]x[1][i]) ? tc->x[0][i] : tc->x[1][i];
ta->maxs[i] = (ta->x[0][i]>ta->x[1][i]) ? ta->x[0][i] : ta->x[1][i];
tc->maxs[i] = (tc->x[0][i]>tc->x[1][i]) ? tc->x[0][i] : tc->x[1][i];
}
/* find_bbox(tc); */
if ( setquadcode(tc) == INTHEBOX )
{ qdepth_insert(tc);
return 1;
}
else { tc->flag = 0; return 0; }
}
/* figure out which vertices of ta on same side, and get as 0,1 */
db = dotf(tb->normal,tb->x[0],gdim);
d0 = dotf(tb->normal,ta->x[0],gdim);
d1 = dotf(tb->normal,ta->x[1],gdim);
d2 = dotf(tb->normal,ta->x[2],gdim);
if ( (d0db) && (d1>db) && (d2>db) )
{ return 0; }
retval = 0;
if ( db == d0 ) /* split thru vertex 0 of ta */
{
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
/* fill in fragment info */
for ( i = 0 ; i < gdim ; i++ )
{ ta->x[2][i] = tc->x[1][i] =
(float)(((db-d1)*ta->x[2][i] + (d2-db)*ta->x[1][i])/(d2-d1));
}
/* internal edges invisible */
ta->etype[2] = tc->etype[0] = SPLITTING_EDGE;
retval = 1;
}
if ( db == d1 ) /* split thru vertex 1 of ta */
{
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
/* fill in fragment info */
for ( i = 0 ; i < gdim ; i++ )
{ ta->x[2][i] = tc->x[0][i] =
(float)(((db-d0)*ta->x[2][i] + (d2-db)*ta->x[0][i])/(d2-d0));
}
/* internal edges invisible */
ta->etype[1] = tc->etype[0] = SPLITTING_EDGE;
retval = 1;
}
if ( db == d2 ) /* split thru vertex 2 of ta */
{
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
/* fill in fragment info */
for ( i = 0 ; i < gdim ; i++ )
{ ta->x[1][i] = tc->x[0][i] =
(float)(((db-d0)*ta->x[1][i] + (d1-db)*ta->x[0][i])/(d1-d0));
}
/* internal edges invisible */
ta->etype[1] = tc->etype[2] = SPLITTING_EDGE;
retval = 1;
}
if ( retval == 1 )
{
/* set mins and maxs */
for ( i = 0 ; i < gdim ; i++ )
{ int j;
ta->mins[i] = tc->mins[i] = (float)1e30;
ta->maxs[i] = tc->maxs[i] = (float)(-1e30);
for ( j = 0 ; j < FACET_VERTS ; j++ )
{ if ( ta->x[j][i] < ta->mins[i] ) ta->mins[i] = ta->x[j][i];
if ( tc->x[j][i] < tc->mins[i] ) tc->mins[i] = tc->x[j][i];
if ( ta->x[j][i] > ta->maxs[i] ) ta->maxs[i] = ta->x[j][i];
if ( tc->x[j][i] > tc->maxs[i] ) tc->maxs[i] = tc->x[j][i];
}
}
if ( ta->mins[2] > tc->mins[2] )
{ struct tsort tmp; /* get ta as back part */
tmp = *ta;
*ta = *tc;
*tc = tmp;
tmpspot = ta->spot; ta->spot = tc->spot; tc->spot = tmpspot;
}
/* find_bbox(tc); */
if ( setquadcode(tc) == INTHEBOX )
{ qdepth_insert(tc);
return 1;
}
else { tc->flag = 0; return 0; }
}
if ( (d0-db)*(d2-db) > 0.0 )
{ int c = ta->ecolor[1];
short e = ta->etype[1];
REAL d = d1;
for ( i = 0 ; i < gdim ; i++ )
{ float temp = ta->x[1][i];
ta->x[1][i] = ta->x[0][i]; ta->x[0][i] = ta->x[2][i];
ta->x[2][i] = temp;
}
ta->ecolor[1] = ta->ecolor[0]; ta->ecolor[0] = ta->ecolor[2];
ta->ecolor[2] = c;
ta->etype[1] = ta->etype[0]; ta->etype[0] = ta->etype[2];
ta->etype[2] = e;
d1 = d0; d0 = d2; d2 = d;
}
else if ( (d1-db)*(d2-db) > 0.0 )
{ int c = ta->ecolor[1];
short e = ta->etype[1];
REAL d = d1;
for ( i = 0 ; i < gdim ; i++ )
{ float temp = ta->x[1][i];
ta->x[1][i] = ta->x[2][i]; ta->x[2][i] = ta->x[0][i];
ta->x[0][i] = temp;
}
ta->ecolor[1] = ta->ecolor[2]; ta->ecolor[2] = ta->ecolor[0];
ta->ecolor[0] = c;
ta->etype[1] = ta->etype[2]; ta->etype[2] = ta->etype[0];
ta->etype[0] = e;
d1 = d2; d2 = d0; d0 = d;
}
/* copy all info to fragments */
tmpspot = tc->spot; *tc = *ta; tc->spot = tmpspot;
tmpspot = td->spot; *td = *ta; td->spot = tmpspot;
retval = 2;
/* fill in fragment info */
for ( i = 0 ; i < gdim ; i++ )
{ ta->x[2][i] = tc->x[0][i] = td->x[0][i] =
(float)(((db-d0)*td->x[2][i] + (d2-db)*ta->x[0][i])/(d2-d0));
tc->x[2][i] = td->x[1][i] =
(float)(((db-d1)*td->x[2][i] + (d2-db)*ta->x[1][i])/(d2-d1));
}
/* internal edges invisible */
ta->etype[1] = tc->etype[0] = tc->etype[2] = td->etype[0] = SPLITTING_EDGE;
/* set mins and maxs */
for ( i = 0 ; i < gdim ; i++ )
{ int j;
ta->mins[i] = tc->mins[i] = td->mins[i] = (float)1e30;
ta->maxs[i] = tc->maxs[i] = td->maxs[i] = (float)(-1e30);
for ( j = 0 ; j < 3 ; j++ )
{ if ( ta->x[j][i] < ta->mins[i] ) ta->mins[i] = ta->x[j][i];
if ( tc->x[j][i] < tc->mins[i] ) tc->mins[i] = tc->x[j][i];
if ( td->x[j][i] < td->mins[i] ) td->mins[i] = td->x[j][i];
if ( ta->x[j][i] > ta->maxs[i] ) ta->maxs[i] = ta->x[j][i];
if ( tc->x[j][i] > tc->maxs[i] ) tc->maxs[i] = tc->x[j][i];
if ( td->x[j][i] > td->maxs[i] ) td->maxs[i] = td->x[j][i];
}
}
/* get ta as back part */
if ( (tc->mins[2] < ta->mins[2]) && (tc->mins[2] <= td->mins[2]) )
{ struct tsort tmp; /* get ta as back part */
tmp = *ta;
*ta = *tc;
*tc = tmp;
tmpspot = ta->spot; ta->spot = tc->spot; tc->spot = tmpspot;
}
else if ( td->mins[2] < ta->mins[2] )
{ struct tsort tmp; /* get ta as back part */
tmp = *ta;
*ta = *td;
*td = tmp;
tmpspot = ta->spot; ta->spot = td->spot; td->spot = tmpspot;
}
/* find_bbox(tc); */
/* find_bbox(td); */
if ( setquadcode(tc) == INTHEBOX )
{ qdepth_insert(tc);
if ( setquadcode(td) == INTHEBOX )
qdepth_insert(td);
else { retval--; td->flag = 0; td->next = (struct tsort *)0xFF; }
}
else
{ /* discard tc */
tmpspot = tc->spot;
*tc = *td;
tc->spot = tmpspot;
td->flag = 0; td->next = (struct tsort *)0xAA;
retval--;
if ( setquadcode(tc) == INTHEBOX )
qdepth_insert(tc);
else { retval--; tc->flag = 0; tc->next = (struct tsort *)0xEE; }
}
return retval;
}
/*********************************************************************
*
* function: separating_plane()
*
* purpose: See if two facets have a separating plane in 3D.
* Meant to be called when known the facets overlap in 2D.
*
* returns FIRST_BACK, SECOND_BACK, or ASPLITTINGB | BSPLITTINGA
*/
int separating_plane(ta,tb,depth)
struct tsort *ta,*tb;
int depth; /* to limit recursion to depth 2 */
{ int i,j;
int na,nb; /* vertices on respective elements */
int nna; /* number of vertex pairs to check on ta */
float *a[3],*b[3];
int retval;
REAL da,db,d;
int n,k,bnear=0,beq=0,bfar=0,anear=0,afar=0,aeq=0;
sep_plane_calls++; /* for verbose statistics */
/* see where tb is with respect to ta plane */
if ( (ta->flag & 0xF) == FACET )
{ da = dotf(ta->normal,ta->x[0],gdim);
n = ((tb->flag & 0xF) == FACET) ? 3 : 2;
for ( k = 0 ; k < n ; k++ )
{ d = dotf(ta->normal,tb->x[k],gdim);
if ( d < da - 0.0001 ) { bnear++; continue; }
if ( d < da + 0.0001 ) { beq++; continue; }
bfar++;
}
if ( beq == n )
return ((tb->flag&0xF)==EDGE)?FIRST_BACK:DISJOINT; /* in same plane */
if ( bfar == 0 ) return FIRST_BACK;
}
/* see where ta is with respect to tb plane */
if ( (tb->flag & 0xF) == FACET )
{ db = dotf(tb->normal,tb->x[0],gdim);
n = ((ta->flag & 0xF) == FACET) ? 3 : 2;
for ( k = 0 ; k < n ; k++ )
{ d = dotf(tb->normal,ta->x[k],gdim);
if ( d < db - 0.0001 ) { anear++; continue; }
if ( d < db + 0.0001 ) { aeq++; continue; }
afar++;
}
if ( aeq == n )
return ((ta->flag&0xF)==EDGE)?SECOND_BACK:DISJOINT; /* same plane */
if ( anear == 0 ) return FIRST_BACK;
}
na = (ta->flag & 0xF) == FACET ? 3 : 2;
nna = (ta->flag & 0xF) == FACET ? 3 : 1;
nb = (tb->flag & 0xF) == FACET ? 3 : 2;
for ( i = 0 ; i < nna ; i++ )
for ( j = 0 ; j < nb ; j++ )
{ REAL c[3],d; /* coefficients for plane */
REAL da[3],db[3],minarea,s[3],length,dar[3],dbr[3];
int ii,jj,jjj;
for ( ii = 0 ; ii < na ; ii++ )
a[ii] = ta->x[(i+ii)%na];
for ( jj = 0 ; jj < nb ; jj++ )
b[jj] = tb->x[(j+jj)%nb];
for ( ii = 0 ; ii < 3 ; ii++ ) s[ii] = a[1][ii]-a[0][ii];
length = sqrt(s[0]*s[0]+s[1]*s[1]+s[2]*s[2]);
minarea = 1e-4*length;
c[0] = s[1]*(b[0][2]-a[0][2]) - s[2]*(b[0][1]-a[0][1]);
c[1] = s[2]*(b[0][0]-a[0][0]) - s[0]*(b[0][2]-a[0][2]);
c[2] = s[0]*(b[0][1]-a[0][1]) - s[1]*(b[0][0]-a[0][0]);
if ( c[0]*c[0] + c[1]*c[1] + c[2]*c[2] <= minarea*minarea )
continue; /* degenerate */
d = c[0]*a[0][0] + c[1]*a[0][1] + c[2]*a[0][2];
for ( ii = 2 ; ii < na ; ii++ )
{ dar[ii] = c[0]*a[ii][0] + c[1]*a[ii][1] +c[2]*a[ii][2] - d;
da[ii] = ( dar[ii] < -minarea ? -1.0 : ( dar[ii] > minarea ? 1.0 : 0.0));
}
for ( jj = 1 ; jj < nb ; jj++ )
{ dbr[jj] = c[0]*b[jj][0] + c[1]*b[jj][1] +c[2]*b[jj][2] - d;
db[jj] = ( dbr[jj] < -minarea ? -1.0 : ( dbr[jj] > minarea ? 1.0 : 0.0));
}
/* test opposite sidedness */
for ( jj = 1 ; jj < nb ; jj++ )
for ( jjj = jj+1 ; jjj < nb ; jjj++ )
if ( db[jj]*db[jjj] < 0.0 ) goto keeptrying;
for ( ii = 2 ; ii < na ; ii++ )
for ( jj = 1 ; jj < nb ; jj++ )
if ( da[ii]*db[jj] > 0.0 ) goto keeptrying;
/* have separating plane */
{ REAL asum,bsum;
/* decide which is in front */
for ( ii = 2, asum = 0.0 ; ii < na ; ii++ ) asum += c[2]*da[ii];
for ( jj = 1, bsum = 0.0 ; jj < nb ; jj++ ) bsum += c[2]*db[jj];
if ( asum > 0.0 || bsum < 0.0 ) return SECOND_BACK;
else return FIRST_BACK;
}
keeptrying: ;
}
/* might have case of separating plane having two vertices on tb */
if ( depth == 2 )
return ASPLITTINGB|BSPLITTINGA;
retval = separating_plane(tb,ta,2);
if ( retval == FIRST_BACK )
return SECOND_BACK;
if ( retval == SECOND_BACK )
return FIRST_BACK;
return retval;
}
/*********************************************************************
*
* function: separating_line()
*
* purpose: See if two elements have a separating line in 2D.
* To be called after bounding box tests.
* Includes small tolerance.
*
* returns DISJOINT or NOTKNOWN
*/
int separating_line(ta,tb)
struct tsort *ta,*tb;
{ int i;
int same = 0;
int na,nb; /* vertices on respective elements */
int nna,nnb; /* number of lines to try */
int apos,aneg,bpos,bneg;
float *a[3],*b[3];
REAL width; /* thickness of separating line */
sep_line_calls++; /* for verbose statistics */
/* get edge first, if any */
if ( ((ta->flag & 0xF) == FACET) && ((tb->flag & 0xF) == EDGE ) )
{ struct tsort *tmp = ta; ta = tb; tb = tmp; }
/* want to prevent overlap of facet with thick edge; not going
to worry about edge-edge overlap, since that too weird. */
if ( ((ta->flag & 0xF) == EDGE) && ((tb->flag & 0xF) == FACET ) )
{
width = ta->width/2; /* actually need half-width */
}
else width = -1e-5; /* allow slight overlap for numerical purposes */
na = (ta->flag & 0xF) == FACET ? 3 : 2;
nb = (tb->flag & 0xF) == FACET ? 3 : 2;
nna = (ta->flag & 0xF) == FACET ? 3 : 1;
nnb = (tb->flag & 0xF) == FACET ? 3 : 1;
/* Try using edges of ta */
for ( i = 0 ; i < nna ; i++ )
{ REAL cx,cy,d; /* coefficients for line */
REAL dar[3],dbr[3],minarea;
int ii,jj;
for ( ii = 0 ; ii < na ; ii++ )
a[ii] = ta->x[(i+ii)%na];
for ( jj = 0 ; jj < nb ; jj++ )
b[jj] = tb->x[jj];
cx = a[1][1] - a[0][1]; cy = a[0][0] - a[1][0];
d = cx*a[0][0] + cy*a[0][1];
minarea = width*sqrt(cx*cx + cy*cy);
if ( fabs(minarea) < 1e-20 )
{ same++; continue; /* same point */ }
apos = aneg = bpos = bneg = 0;
for ( ii = 2 ; ii < na ; ii++ )
{ dar[ii] = cx*a[ii][0] + cy*a[ii][1] - d;
if ( dar[ii] > minarea ) apos++;
if ( dar[ii] < -minarea ) aneg++;
}
for ( jj = 0 ; jj < nb ; jj++ )
{ dbr[jj] = cx*b[jj][0] + cy*b[jj][1] - d;
if ( dbr[jj] > minarea ) bpos++;
if ( dbr[jj] < -minarea ) bneg++;
}
/* test opposite sidedness */
if ( apos == (na-2) && bneg == nb ) return DISJOINT;
if ( aneg == (na-2) && bpos == nb ) return DISJOINT;
}
/* Try using edges of tb */
for ( i = 0 ; i < nnb ; i++ )
{ REAL cx,cy,d; /* coefficients for line */
REAL dar[3],dbr[3],minarea;
int ii,jj;
for ( ii = 0 ; ii < nb ; ii++ )
a[ii] = tb->x[(i+ii)%nb];
for ( jj = 0 ; jj < na ; jj++ )
b[jj] = ta->x[jj];
cx = a[1][1] - a[0][1]; cy = a[0][0] - a[1][0];
d = cx*a[0][0] + cy*a[0][1];
width = -1e-5;
minarea = width*sqrt(cx*cx + cy*cy);
if ( fabs(minarea) < 1e-20 )
{ same++; continue; /* same point */ }
apos = aneg = bpos = bneg = 0;
for ( ii = 2 ; ii < nb ; ii++ )
{ dar[ii] = cx*a[ii][0] + cy*a[ii][1] - d;
if ( dar[ii] > minarea ) apos++;
if ( dar[ii] < -minarea ) aneg++;
}
for ( jj = 0 ; jj < na ; jj++ )
{ dbr[jj] = cx*b[jj][0] + cy*b[jj][1] - d;
if ( dbr[jj] > minarea ) bpos++;
if ( dbr[jj] < -minarea ) bneg++;
}
/* test opposite sidedness */
if ( apos == (nb-2) && bneg == na ) return DISJOINT;
if ( aneg == (nb-2) && bpos == na ) return DISJOINT;
}
return NOTKNOWN;
}
/*********************************************************************
*
* function: plane_test()
*
* purpose: See if one facet or edge is in front or back of element plane.
* Suitable for Newell-Newell-Sancha algorithm.
*
* returns DISJOINT, FIRST_BACK, SECOND_BACK, ASPLITTINGB, BSPLITTINGA, or COPLANAR
* Returns FIRST_BACK if guaranteed first does not obscure any of second.
* Possibly bitwise OR of properties.
*/
int plane_test(ta,tb)
struct tsort *ta,*tb;
{
REAL da,db;
int k,n;
int afar=0,aeq=0,anear=0; /* count of ta vertices relative to tb plane */
int bfar=0,beq=0,bnear=0; /* count of tb vertices relative to ta plane */
REAL d;
int retval = NOTKNOWN;
/* if two edges */
if ( ((ta->flag & 0xF) == EDGE) && ((tb->flag & 0xF) == EDGE) )
{ REAL ab1x = tb->x[0][0] - ta->x[0][0];
REAL ab1y = tb->x[0][1] - ta->x[0][1];
REAL ab1z = tb->x[0][2] - ta->x[0][2];
REAL ab2x = tb->x[1][0] - ta->x[0][0];
REAL ab2y = tb->x[1][1] - ta->x[0][1];
REAL ab2z = tb->x[1][2] - ta->x[0][2];
REAL aax = ta->x[1][0] - ta->x[0][0];
REAL aay = ta->x[1][1] - ta->x[0][1];
REAL aaz = ta->x[1][2] - ta->x[0][2];
REAL area = ab1x*ab2y - ab1y*ab2x;
REAL vol = (ab1x*ab2y - ab1y*ab2x)*aaz + (ab1y*ab2z - ab1z*ab2y)*aax
+ (ab1z*ab2x - ab1x*ab2z)*aay;
if ( vol == 0.0 ) return COPLANAR;
if ( area == 0.0 ) return DISJOINT;
if ( area*vol > 0 ) return SECOND_BACK;
return FIRST_BACK;
}
/* see where tb is with respect to ta plane */
da = dotf(ta->normal,ta->x[0],gdim);
n = ((tb->flag & 0xF) == FACET) ? 3 : 2;
for ( k = 0 ; k < n ; k++ )
{
d = dotf(ta->normal,tb->x[k],gdim);
if ( d < da - 0.0001 ) { bnear++; continue; }
if ( d < da + 0.0001 ) { beq++; continue; }
bfar++;
}
if ( beq == n ) return COPLANAR; /* both in same plane */
if ( bfar == 0 ) return FIRST_BACK;
if ( bnear > 0 )
{ if ( (ta->flag & 0xF) == FACET ) retval = ASPLITTINGB; }
else retval = SECOND_BACK;
/* see where ta is with respect to tb plane */
db = dotf(tb->normal,tb->x[0],gdim);
n = ((ta->flag & 0xF) == FACET) ? 3 : 2;
for ( k = 0 ; k < n ; k++ )
{
d = dotf(tb->normal,ta->x[k],gdim);
if ( d < db - 0.0001 ) { anear++; continue; }
if ( d < db + 0.0001 ) { aeq++; continue; }
afar++;
}
if ( aeq == n ) return COPLANAR; /* both in same plane */
if ( anear == 0 ) return FIRST_BACK;
if ( afar > 0 )
{ if ( (tb->flag & 0xf) == FACET ) retval |= BSPLITTINGA; }
else retval |= SECOND_BACK;
/* might still not have properly detected order, so try this */
/*
if ( !(retval & (FIRST_BACK|SECOND_BACK)) )
retval = separating_plane(ta,tb,0);
*/
return retval;
} /* end plane_test() */
/************************************************************************
************************************************************************
Visibility testing. Takes output of depth sort and deletes hidden
elements. Uses sweep line (at random angle) to track topology.
Much like Stuart Sechrest and Donald P. Greenberg, A Visible Polygon
Reconstruction Algorithm, ACM Transactions on Graphics, vol 1, no 1,
Jan 1982, pp 25-42.
General strategy remarks:
The image is broken down into individual polygon edges. Each edge is
"above" or "below" a polygon. For now, each polygon is just a facet,
but this could change if thick edges were added in the form of rectangles.
The algorithm proceeds by moving a sweep line across the image, keeping
track of "active edges" that intersect the sweep line. The active edge
list is altered at "events": edge starts, edge ends, and edge crossings.
The sweep line is tilted at an arbitrary angle to prevent degenerate
vertices, except vertices coincident in projection. Pre-ordered event
lists are kept for edge starts and ends, and a heap for upcoming
crossings.
Attached to each active edge is a list of layers of facets in the area
immediately above it.
*************************************************************************/
int visdebuglevel;
#define VIS_TIMING 1
#define VIS_LAYERCHECK 2
#define VIS_EVENTDUMP 3
struct vis_conedge;
struct vis_vertex;
/* Heap for ordering upcoming events. */
int vis_heap_count; /* heap spots used */
int vis_heap_max; /* heap spots allocated */
struct vis_event *vis_heap;
void vis_insert_heap ARGS((struct vis_event *));
void vis_delete_heap ARGS((int));
void find_next_event ARGS((struct vis_conedge *));
void find_next_event2 ARGS(( struct vis_conedge *, struct vis_conedge *));
void vis_crossing ARGS((struct vis_conedge *,struct vis_conedge *));
int vecount; /* number of edges in edge list */
int vis_crossing_count; /* just for info */
int add_layer ARGS((struct vis_conedge *, struct tsort *));
int delete_layer ARGS((struct vis_conedge *, struct tsort *));
void check_layers ARGS(( struct vis_conedge *, REAL , REAL));
int vvcomp ARGS(( struct vis_vertex *, struct vis_vertex *));
REAL activate_edge ARGS(( struct vis_conedge *));
void check_deactivate ARGS(( struct vis_conedge *));
/* Edge list */
#define MAXLAYERS 20
struct vis_rawedge { struct vis_vertex *v[2]; /* endpoints */
struct tsort *t; /* facet it borders */
struct vis_conedge *conedge;
int flags; /* see below */
};
struct vis_rawedge *vis_rawedges;
struct vis_rawedge **rawplist; /* pointers for sorting */
int vecomp ARGS((struct vis_rawedge **, struct vis_rawedge **));
/* vis_rawedge flag bits */
#define V_FACET_BOTTOM 1
#define V_FACET_TOP 2
#define V_FACET_LEFT 4
#define V_FACET_RIGHT 8
#define V_LAYER_CHECK 0x10
/* Consolidated vertices */
struct vis_vertex { REAL x[2]; /* u, v */
struct vis_vertex **fixup[2]; /* pre-cons reverse pointer */
};
struct vis_vertex *vis_vertices;
int vis_vertex_max;
int vis_vertex_count;
/* Consolidated edges */
struct vis_conedge {
struct vis_vertex *v[2]; /* endpoints */
REAL m; /* line slope */
int rawstart; /* associated raw edge start */
int rawend; /* last associated raw edge */
int use_count; /* times in use as boundary */
struct vis_conedge *prev_active; /* active list pointer */
struct vis_conedge *next_active; /* active list pointer */
int flags; /* see below */
int layers; /* number of layers above edge */
struct tsort **layer; /* facets "above" edge */
int maxlayers; /* allocated space */
int seqno; /* sequence number, for debugging */
};
struct vis_conedge *vis_conedges;
int vis_conedge_max;
int vis_conedge_count;
/* Crossing event */
struct vis_event { REAL time; /* sweep time of event */
int type;
struct vis_conedge *e1;
struct vis_conedge *e2;
struct tsort *t;
};
int vis_event_comp ARGS((struct vis_event *, struct vis_event *));
/* Event types, ordered in way wanted in sorting */
#define V_FACET_END 1
#define V_FACET_TOPMIDDLE 2
#define V_FACET_BOTTOMMIDDLE 3
#define V_FACET_START 4
#define V_EDGE_CROSSING 5
int wrong_middles; /* for some debugging */
/* Margin to shorten edge ends, so don't get spurious crossings */
REAL veps = 1e-14;
/* Active edge list */
struct vis_conedge *active_edge_first;
struct vis_conedge sentinel;
struct vis_vertex sentinelv[4]; /* for sentinel endpoints */
/* List of edges to check for top layer */
struct vis_conedge **check_list;
int check_list_count;
int check_list_max;
void check_visible ARGS((REAL));
/* random tilt coefficients for sweep line */
REAL va = 0.8432848996472634;
REAL vb = 0.5869487870825054;
REAL sweep_u; /* current sweep position */
struct vis_event *facet_events;
int f_event_count;
int facet_start_event ARGS((struct vis_event *));
int facet_middle_event ARGS((struct vis_event *));
int facet_end_event ARGS((struct vis_event *));
/* For brute force verification */
int brute_force_flag = 1;
void brute_force_times ARGS((void));
int brutecount; /* number of brute force times */
struct brute { REAL time;
struct vis_conedge *e1,*e2;
int type;
} *brute_times;
void brute_section ARGS((REAL));
void brute_visible ARGS((REAL));
int maxbrute;
struct brute_cut { REAL v; /* height */
struct vis_edge *e;
} *brute_cuts;
int brute_cut_count;
#ifdef PROFILING_ENABLED
/* Profiling cycle counters */
__int32 visibility_stage_elapsed_time[2];
__int32 visibility_end_elapsed_time[2];
__int32 visibility_end1_elapsed_time[2];
__int32 visibility_end2_elapsed_time[2];
__int32 visibility_end3_elapsed_time[2];
__int32 visibility_end4_elapsed_time[2];
__int32 visibility_end5_elapsed_time[2];
__int32 vis_insert_heap_elapsed_time[2];
__int32 vis_delete_heap_elapsed_time[2];
__int32 vis_crossing_elapsed_time[2];
__int32 facet_start_event_elapsed_time[2];
__int32 facet_middle_event_elapsed_time[2];
__int32 facet_end_event_elapsed_time[2];
__int32 add_layer_elapsed_time[2];
__int32 delete_layer_elapsed_time[2];
__int32 check_visible_elapsed_time[2];
__int32 find_next_event_elapsed_time[2];
__int32 all_visibility_elapsed_time[2];
__int32 activate_edge_elapsed_time[2];
__int32 check_deactivate_elapsed_time[2];
#endif
/************************************************************************
*
* function: visibility_stage()
*
* purpose: Adds element to list for visibility testing.
* Enabled by visibility_test toggle.
*
*/
void visibility_stage(t)
struct tsort *t;
{
PROF_START(all_visibility)
PROF_START(visibility_stage)
if ( !visibility_test )
{ if ( (t->flag & 0xF) == FACET )
(*display_facet)(t);
else (*display_edge)(t);
return;
}
/* accumulate */
if ( vis_list == NULL )
{ vis_max = maxcount;
vis_list = (struct tsort *)temp_calloc(vis_max,sizeof(struct tsort));
}
else if ( vis_count >= vis_max - 1 )
{ vis_list = (struct tsort *)temp_realloc((char*)vis_list,
2*vis_max*sizeof(struct tsort));
vis_max *= 2;
}
vis_list[vis_count++] = *t;
PROF_FINISH(visibility_stage)
PROF_FINISH(all_visibility)
}
/*
FOR DEBUGGING
*/
void active_list_check ARGS((void));
void active_list_check()
{ struct vis_conedge *e;
for ( e = active_edge_first ; e != &sentinel ; e = e->next_active )
{ if ( e->next_active->prev_active != e )
kb_error(2418,"Visibility edge active list bad.\n",RECOVERABLE);
}
}
/************************************************************************
*
* function: vvcomp()
*
* purpose: comparison of vertices, for consolidation
*
*/
int vvcomp(a,b)
struct vis_vertex *a,*b;
{
if ( a->x[0] < b->x[0] ) return -1;
if ( a->x[0] > b->x[0] ) return 1;
if ( a->x[1] < b->x[1] ) return -1;
if ( a->x[1] > b->x[1] ) return 1;
return 0;
}
/************************************************************************
*
* function: vecomp()
*
* purpose: comparison of raw edges, for consolidation
*
*/
int vecomp(a,b)
struct vis_rawedge **a,**b;
{
if ( a[0]->v[0] < b[0]->v[0] ) return -1;
if ( a[0]->v[0] > b[0]->v[0] ) return 1;
if ( a[0]->v[1] < b[0]->v[1] ) return -1;
if ( a[0]->v[1] > b[0]->v[1] ) return 1;
return 0;
}
/************************************************************************
*
* function: visibility_end()
*
* purpose: Run visibility algorithm after accumulation of data.
*
*/
int debug_seq = 0; /* for debugging */
void visibility_end()
{ int k,i,ii,iii,j;
struct tsort *t;
struct vis_rawedge *ve;
struct vis_conedge *vc;
struct vis_vertex *vv;
REAL next_u;
struct vis_event *f_ev;
int facet_event_spot;
int vis_display_count;
int tops,bottoms,lefts,rights;
debug_seq = 0;
PROF_START(all_visibility)
PROF_START(visibility_end)
PROF_START(visibility_end1)
/* List of edges to check top facet for */
check_list_max = 1000;
check_list = (struct vis_conedge **)temp_calloc(check_list_max,
sizeof(struct vis_conedge *));
check_list_count = 0;
/* Sorted list of facet starts, middle vertices, and ends */
facet_events = (struct vis_event *)temp_calloc(3*vis_count,
sizeof(struct vis_event));
f_event_count = 0;
f_ev = facet_events;
/* Populate raw edge and vertex lists */
vis_vertex_max = 3*vis_count;
vis_vertices = (struct vis_vertex *)temp_calloc(vis_vertex_max,
sizeof(struct vis_vertex));
vv = vis_vertices;
vis_vertex_count = 0;
vis_rawedges = (struct vis_rawedge *)temp_calloc(3*vis_count,
sizeof(struct vis_rawedge));
ve = vis_rawedges;
vecount = 0;
for ( k = 0, t = vis_list ; k < vis_count ; k++,t++ )
{ if ( (t->flag & 0xF) == FACET )
{
REAL minu = 1e30, maxu = -1e30;
if ( t->color == CLEAR )
{ t->flag |= VISIBLE; continue; } /* kludge for now */
/* rotate coordinates */
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vv[i].x[0] = va*t->x[i][0] + vb*t->x[i][1];
if ( vv[i].x[0] < minu ) minu = vv[i].x[0];
if ( vv[i].x[0] > maxu ) maxu = vv[i].x[0];
vv[i].x[1] = -vb*t->x[i][0] + va*t->x[i][1];
}
/* now, the edges */
tops = 0; bottoms = 0; lefts = 0; rights = 0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ REAL area;
ii = (i+1 >= FACET_VERTS) ? 0 : i+1;
if ( vv[i].x[0] <= vv[ii].x[0] ) /* leftmost vertex first */
{ ve->v[0] = vv+i;
ve->v[1] = vv+ii;
vv[i].fixup[0] = &ve->v[0]; /* so can adjust edges after sorting vertices */
vv[ii].fixup[1] = &ve->v[1];
} else
{ ve->v[0] = vv+ii;
ve->v[1] = vv+i;
vv[i].fixup[0] = &ve->v[1]; /* so can adjust edges after sorting vertices */
vv[ii].fixup[1] = &ve->v[0];
}
iii = (ii+1 >= FACET_VERTS) ? 0 : ii+1; /* third vertex */
area = (ve->v[1]->x[0]-ve->v[0]->x[0])*(vv[iii].x[1]-ve->v[0]->x[1])
-(vv[iii].x[0]-ve->v[0]->x[0])*(ve->v[1]->x[1]-ve->v[0]->x[1]);
if ( fabs(area) < 1e-14 ) break;
if ( area > 0 )
{ ve->flags |= V_FACET_BOTTOM; bottoms++; }
else { ve->flags |= V_FACET_TOP; tops++; }
if ( ve->v[0]->x[0] == minu )
{ ve->flags |= V_FACET_LEFT; lefts++; }
if ( ve->v[1]->x[0] == maxu )
{ ve->flags |= V_FACET_RIGHT; rights++; }
ve->t = t;
ve++; vecount++;
}
/* check we successfully found things, and skip edge-on facets */
if ( (tops==0) || (bottoms==0) || (lefts!=2) || (rights!=2) )
continue;
/* facet start event */
f_ev->type = V_FACET_START;
f_ev->time = minu;
f_ev->t = t;
for ( i = -FACET_EDGES ; i < 0 ; i++ )
{ if ( ve[i].flags & V_FACET_LEFT )
{ if ( ve[i].flags & V_FACET_BOTTOM )
f_ev->e1 = (struct vis_conedge*)(ve + i);
else f_ev->e2 = (struct vis_conedge*)(ve + i);
}
}
if ( !f_ev->e1 || !f_ev->e2 )
{ f_ev->e1 = f_ev->e2 = NULL; continue; } /* skip edge-on */
f_ev++; f_event_count++;
/* facet middle event */
f_ev->t = t;
for ( i = -FACET_EDGES ; i < 0 ; i++ )
{ if ( ve[i].flags & V_FACET_LEFT )
{ if ( !(ve[i].flags & V_FACET_RIGHT) )
{ f_ev->e1 = (struct vis_conedge*)(ve + i);
f_ev->time = ve[i].v[1]->x[0];
}
}
if ( ve[i].flags & V_FACET_RIGHT )
{ if ( !(ve[i].flags & V_FACET_LEFT) )
f_ev->e2 = (struct vis_conedge*)(ve + i);
}
}
if ( !f_ev->e1 || !f_ev->e2 ) /* skip edge-on */
{ f_ev->e1 = f_ev->e2 = NULL; f_ev--; f_event_count--; continue; }
if ( ((struct vis_rawedge *)f_ev->e1)->flags & V_FACET_BOTTOM )
f_ev->type = V_FACET_BOTTOMMIDDLE;
else f_ev->type = V_FACET_TOPMIDDLE;
f_ev++; f_event_count++;
/* facet end event */
f_ev->type = V_FACET_END;
f_ev->time = maxu;
f_ev->t = t;
for ( i = -FACET_EDGES ; i < 0 ; i++ )
{ if ( ve[i].flags & V_FACET_RIGHT )
{ if ( ve[i].flags & V_FACET_BOTTOM )
f_ev->e1 = (struct vis_conedge*)(ve + i);
else f_ev->e2 = (struct vis_conedge*)(ve + i);
}
}
if ( !f_ev->e1 || !f_ev->e2 ) /* skip edge-on */
{ f_ev->e1 = f_ev->e2 = NULL; f_ev-=2; f_event_count-=2; continue; }
f_ev++; f_event_count++;
vv += FACET_VERTS; vis_vertex_count += FACET_VERTS;
}
else /* lone edge */
{
/* for now, make all lone edges visible */
t->flag |= VISIBLE;
}
}
PROF_FINISH(visibility_end1)
if ( f_event_count == 0 )
goto draw_visible;
PROF_START(visibility_end2)
/* Consolidation of vertices and edges */
/* First, consolidation of vertices */
qsort(vis_vertices,vis_vertex_count,sizeof(struct vis_vertex),FCAST vvcomp);
for ( i = -1, j = 0 ; j < vis_vertex_count ; j++ )
{ int m;
if ( (i < 0) || (vvcomp(vis_vertices+i,vis_vertices+j) != 0) )
{ vis_vertices[++i] = vis_vertices[j];
}
/* use reverse pointers to fix up edges */
for ( m = 0 ; m < 2 ; m++ )
*(vis_vertices[j].fixup[m]) = vis_vertices+i;
}
vis_vertex_count = i+1;
PROF_FINISH(visibility_end2)
/* Next, consolidation of edges. Use intermediate list of pointers,
since events point to raw edges.
*/
PROF_START(visibility_end3)
rawplist = (struct vis_rawedge **)temp_calloc(vecount,
sizeof(struct vis_rawedge *));
for ( i = 0 ; i < vecount ; i++ ) rawplist[i] = vis_rawedges+i;
qsort(rawplist,vecount,sizeof(struct vis_rawedge*),FCAST vecomp);
vis_conedge_max = vecount;
vis_conedges = (struct vis_conedge *) temp_calloc(vis_conedge_max,
sizeof(struct vis_conedge) );
vis_conedges[0].v[0] = rawplist[0]->v[0];
vis_conedges[0].v[1] = rawplist[0]->v[1];
vis_conedges[0].rawstart = 0;
vis_conedges[0].rawend = 0;
rawplist[0]->conedge = vis_conedges;
for ( i = 0, j = 1 ; j < vecount ; j++ )
{ if ( (vis_conedges[i].v[0] != rawplist[j]->v[0]) ||
(vis_conedges[i].v[1] != rawplist[j]->v[1]) )
{ i++;
vis_conedges[i].v[0] = rawplist[j]->v[0];
vis_conedges[i].v[1] = rawplist[j]->v[1];
vis_conedges[i].rawstart = j;
vis_conedges[i].rawend = j;
}
else
vis_conedges[i].rawend++;
rawplist[j]->conedge = vis_conedges+i;
}
i++;
vis_conedges = (struct vis_conedge*)temp_realloc((char*)vis_conedges,
i*sizeof(struct vis_conedge));
vis_conedge_max = vis_conedge_count = i;
PROF_FINISH(visibility_end3)
PROF_START(visibility_end4)
/* Initialize line coefficients */
for ( i = 0, vc = vis_conedges; i < vis_conedge_count; i++, vc++ )
{ REAL du = vc->v[1]->x[0] - vc->v[0]->x[0];
REAL dv = vc->v[1]->x[1] - vc->v[0]->x[1];
vc->m = dv/du;
}
/* change facet events over to consolidated edges */
for ( i = 0 ; i < f_event_count ; i++ )
{ facet_events[i].e1 = ((struct vis_rawedge*)(facet_events[i].e1))->conedge;
facet_events[i].e2 = ((struct vis_rawedge*)(facet_events[i].e2))->conedge;
}
PROF_FINISH(visibility_end4)
/* and for later use */
brute_cuts=(struct brute_cut *)temp_calloc(vecount,sizeof(struct brute_cut));
#ifdef BRUTE
/* do brute-force list of all event times */
brute_force_times();
for ( i = 0 ; i < brutecount-1 ; i++ )
{ if ( brute_times[i+1].time-brute_times[i].time > 1e-8 )
brute_visible((brute_times[i].time+brute_times[i+1].time)/2);
}
#endif
#define FINESSE
#ifdef FINESSE
/* sort facet event list */
qsort((char*)facet_events,f_event_count,sizeof(struct vis_event),
FCAST vis_event_comp);
/* Initialize crossing event heap with sentinel */
vis_heap_max = vecount > 100 ? vecount : 100;
vis_heap = (struct vis_event *)temp_calloc(vis_heap_max,
sizeof(struct vis_event));
vis_heap[0].time = 1e30;
vis_heap_count = 1;
vis_crossing_count = 0;
/* Initialize active list */
sentinel.v[0] = sentinelv;
sentinel.v[1] = sentinelv+1;
sentinelv[0].x[0] = -1e20;
sentinelv[0].x[1] = 1e20;
sentinelv[1].x[0] = 1e20;
sentinelv[1].x[1] = 1e20;
sentinel.m = 0;
sentinel.prev_active = NULL;
sentinel.next_active = NULL;
active_edge_first = &sentinel;
PROF_START(visibility_end5)
/* Sweep */
facet_event_spot = 0;
while ( facet_event_spot < f_event_count )
{ struct vis_event *fe = facet_events + facet_event_spot;
int retval; /* return code from event handlers; < 0 for error */
/* print current active list and event heap */
if ( visdebuglevel >= VIS_EVENTDUMP )
{ struct vis_conedge *es;
if ( active_edge_first->prev_active != NULL )
printf("(%d<-) ",active_edge_first->prev_active-vis_conedges);
for ( es = active_edge_first ; es != &sentinel ; es = es->next_active )
{ if ( es->next_active->prev_active != es )
printf("(%d<-) ",es->next_active->prev_active-vis_conedges);
printf("%d ",es-vis_conedges);
}
for ( i = 0 ; i < vis_heap_count ; i++ )
if ( vis_heap[i].time > 1e20 ) printf("(sentinel) ");
else
printf("(%d %d %f)",vis_heap[i].e1-vis_conedges,vis_heap[i].e2-vis_conedges,
vis_heap[i].time);
printf("\n");
} /* end debug */
/* find which is next event and process */
if ( (vis_heap_count <= 0) || (fe->time < vis_heap[0].time) )
{ /* do facet event */
next_u = fe->time;
PROF_FINISH(visibility_end)
if ( (next_u - sweep_u) > 1e-10 )
check_visible((next_u+sweep_u)/2);
sweep_u = next_u;
switch ( fe->type )
{ case V_FACET_START:
retval = facet_start_event(fe);
if ( retval < 0 )
goto bail_out;
break;
case V_FACET_TOPMIDDLE:
retval = facet_middle_event(fe);
if ( retval < 0 )
goto bail_out;
break;
case V_FACET_BOTTOMMIDDLE:
retval = facet_middle_event(fe);
if ( retval < 0 )
goto bail_out;
break;
case V_FACET_END:
retval = facet_end_event(fe);
if ( retval < 0 )
goto bail_out;
break;
}
PROF_START(visibility_end)
facet_event_spot++;
continue;
}
else /* do crossing event */
{ struct vis_conedge *e1,*e2;
next_u = vis_heap[0].time;
PROF_FINISH(visibility_end)
if ( (next_u - sweep_u) > 1e-10 )
check_visible((next_u+sweep_u)/2);
e1 = vis_heap[0].e1; e2 = vis_heap[0].e2;
vis_delete_heap(0);
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("crossing %d %d at %20.15f\n",e1-vis_conedges,e2-vis_conedges,(double)next_u);
sweep_u = next_u;
vis_crossing(e1,e2);
PROF_START(visibility_end)
continue;
}
}
#endif
goto draw_visible;
bail_out: /* error handling: mark all as visible */
erroutstring("Abandoning visibility test and drawing all facets.\n");
for ( k = 0, t = vis_list, vis_display_count = 0 ; k < vis_count ; k++,t++ )
t->flag |= VISIBLE;
draw_visible:
PROF_FINISH(visibility_end5)
PROF_FINISH(visibility_end)
PROF_FINISH(all_visibility)
/* Display elements marked visible */
for ( k = 0, t = vis_list, vis_display_count = 0 ; k < vis_count ; k++,t++ )
if ( t->flag & VISIBLE )
{ if ( (t->flag & 0xF) == FACET )
(*display_facet)(t);
else (*display_edge)(t);
vis_display_count++;
}
temp_free((char*)vis_heap);
temp_free((char*)vis_conedges);
temp_free((char*)vis_rawedges);
temp_free((char*)vis_vertices);
temp_free((char*)check_list);
temp_free((char*)rawplist);
temp_free((char*)vis_list);
temp_free((char*)facet_events);
temp_free((char*)brute_cuts);
if (visdebuglevel >= VIS_TIMING)
{
fprintf(stderr,"Visible: %d facets out of %d\n",vis_display_count,vis_count);
fprintf(stderr,"Crossing count: %d\n",vis_crossing_count);
fprintf(stderr,"Wrong middles: %d\n",wrong_middles); wrong_middles = 0;
#ifdef MSC
/* print out profile times, only for Visual Studio */
printf("CPU clock cycles in various visibility routines:\n");
PROF_PRINT(all_visibility)
PROF_PRINT(visibility_stage)
PROF_PRINT(visibility_end)
PROF_PRINT(visibility_end1)
PROF_PRINT(visibility_end2)
PROF_PRINT(visibility_end3)
PROF_PRINT(visibility_end4)
PROF_PRINT(visibility_end5)
PROF_PRINT(check_visible)
PROF_PRINT(vis_crossing)
PROF_PRINT(facet_start_event)
PROF_PRINT(facet_middle_event)
PROF_PRINT(facet_end_event)
PROF_PRINT(vis_insert_heap)
PROF_PRINT(vis_delete_heap)
PROF_PRINT(find_next_event)
PROF_PRINT(add_layer)
PROF_PRINT(delete_layer)
PROF_PRINT(activate_edge)
PROF_PRINT(check_deactivate)
#endif
}
}
/************************************************************************
*
* function: vis_event_comp()
*
* purpose: compare times of two events. Sorts on time, then type,
* then average slope, then edges.
*/
int vis_event_comp(a,b)
struct vis_event *a, *b;
{ REAL ma,mb;
if ( a->time < b->time ) return -1;
if ( a->time > b->time ) return 1;
if ( a->type < b->type ) return -1;
if ( a->type > b->type ) return 1;
ma = (a->e1->m+a->e2->m);
mb = (b->e1->m+b->e2->m);
if ( ma < mb ) return -1;
if ( ma > mb ) return 1;
if ( a->e1 < b->e1 ) return -1;
if ( a->e1 > b->e1 ) return 1;
if ( a->e2 < b->e2 ) return -1;
if ( a->e2 > b->e2 ) return 1;
return 0;
}
/************************************************************************
*
* function: vis_insert_heap()
*
* purpose: Add edge event to heap list. Not detecting duplicates;
* leaving that to validity test when crossing is handled.
*
*/
void vis_insert_heap(e)
struct vis_event *e;
{ int k,kk;
int result;
PROF_START(vis_insert_heap)
if ( vis_heap_count >= vis_heap_max-1 )
{ vis_heap = (struct vis_event *)kb_realloc((char*)vis_heap,
2*vis_heap_max*sizeof(struct vis_event));
vis_heap_max *= 2;
}
for ( k = vis_heap_count ; k > 0 ; k = kk )
{
kk = (k-1)/2;
result = vis_event_comp(e,&vis_heap[kk]);
if ( result < 0 )
{
vis_heap[k] = vis_heap[kk];
}
else break;
}
vis_heap[k] = *e;
vis_heap_count++;
PROF_FINISH(vis_insert_heap)
}
/***************************************************************************
*
* function: vis_delete_heap()
*
* purpose: Delete element n of heap and adjust heap.
*/
void vis_delete_heap(n)
int n;
{ int k,kk;
int result;
struct vis_event e;
PROF_START(vis_delete_heap)
if ( n == vis_heap_count-1 )
{ vis_heap_count--;
goto vis_delete_heap_exit;
}
if ( vis_heap_count == 1 )
kb_error(2421,"vis_delete_heap trying to delete sentinel.\n",RECOVERABLE);
/* replace with top event */
e = vis_heap[--vis_heap_count];
/* check direction to percolate */
result = (n==0) ? 1 : vis_event_comp(&e,vis_heap+(n-1)/2);
if ( result < 0 )
{ /* downward */
k = n;
kk = (n-1)/2;
vis_heap[k] = vis_heap[kk];
for ( k = kk ; k > 0 ; k = kk )
{ kk = (k-1)/2;
result = vis_event_comp(&e,vis_heap+kk);
if ( result < 0 )
{ vis_heap[k] = vis_heap[kk];
continue;
}
else
{ break;
}
}
vis_heap[k] = e;
goto vis_delete_heap_exit;
}
else
{ /* upward */
for ( k = n; 2*k+1 < vis_heap_count ; k = kk )
{
if ( 2*k+2 >= vis_heap_count )
{ /* only one parent */
kk = 2*k+1;
result = vis_event_comp(&e,vis_heap+kk);
if ( result > 0 )
{ vis_heap[k] = vis_heap[kk];
vis_heap[kk] = e;
goto vis_delete_heap_exit;
}
else
{ vis_heap[k] = e;
goto vis_delete_heap_exit;
}
}
else
{ /* two parents */
result = vis_event_comp(&vis_heap[2*k+1],&vis_heap[2*k+2]);
kk = (result < 0) ? 2*k+1 : 2*k+2;
result = vis_event_comp(&e,vis_heap+kk);
if ( result < 0 )
{ /* done */
vis_heap[k] = e;
goto vis_delete_heap_exit;
}
else if ( result > 0 )
{ /* keep going up */
vis_heap[k] = vis_heap[kk];
continue;
}
}
}
vis_heap[k] = e; /* in case at top of heap */
}
vis_delete_heap_exit: ;
PROF_FINISH(vis_delete_heap)
}
/****************************************************************************
*
* function: add_layer()
*
* purpose: Add a facet to the layers above an active edge.
*
* return value: 1 if added, 0 if already there.
*/
int add_layer(ee,f)
struct vis_conedge *ee;
struct tsort *f;
{ int i;
int retval;
PROF_START(add_layer)
for ( i = 0 ; i < ee->layers ; i++ )
if ( ee->layer[i] == f ) break;
if ( i == ee->maxlayers )
{ int newcount = (ee->maxlayers > 10) ? 2*ee->maxlayers : ee->maxlayers + 10;
ee->layer = (struct tsort **)temp_realloc((char*)(ee->layer),
newcount*sizeof(struct tsort*));
ee->maxlayers = newcount;
}
if ( i == ee->layers )
{ /* not already found in layer list */
ee->layer[ee->layers++] = f;
if ( visdebuglevel >= VIS_EVENTDUMP )
fprintf(stderr,"Adding facet %d to edge %d layers.\n",
f-vis_list,ee-vis_conedges);
if ( !(ee->flags & V_LAYER_CHECK) )
{
if ( check_list_count >= check_list_max )
{ check_list = (struct vis_conedge **)temp_realloc((char*)check_list,
2*check_list_max*sizeof(struct vis_conedge *));
check_list_max *= 2;
}
check_list[check_list_count++] = ee;
ee->flags |= V_LAYER_CHECK;
}
retval = 1;
}
else retval = 0;
PROF_FINISH(add_layer)
return retval;
}
/****************************************************************************
*
* function: delete_layer()
*
* purpose: Delete a facet from the layers above an active edge.
* Not keeping remaining facets in depth order.
*
* return value: 1 if found, 0 if not.
*/
int delete_layer(ee,f)
struct vis_conedge *ee;
struct tsort *f;
{ int i;
int retval = 0;
PROF_START(delete_layer)
for ( i = 0 ; i < ee->layers ; i++ )
if ( ee->layer[i] == f )
{ ee->layer[i] = ee->layer[--ee->layers];
if ( visdebuglevel >= VIS_EVENTDUMP )
fprintf(stderr,"Deleting facet %d from edge %d layers.\n",
f-vis_list,ee-vis_conedges);
if ( !(ee->flags & V_LAYER_CHECK) )
{ if ( check_list_count >= check_list_max )
{ check_list = (struct vis_conedge **)temp_realloc((char*)check_list,
2*check_list_max*sizeof(struct vis_conedge *));
check_list_max *= 2;
}
check_list[check_list_count++] = ee;
ee->flags |= V_LAYER_CHECK;
}
retval = 1;
break;
}
PROF_FINISH(delete_layer)
return retval;
}
/*************************************************************************
*
* function: find_next_event()
*
* purpose: Check for upcoming crossing event. Doesn't count crossing
* near end of edge. Need to do very robust crossing
* calculation, so not to be fooled by numerical glitches.
*
*/
void find_next_event(e)
struct vis_conedge *e;
{ struct vis_event ev;
PROF_START(find_next_event)
ev.time = 1e30;
/* Forward */
if ( (e->m > e->next_active->m ) )
{ REAL u;
u = e->v[0]->x[0] + (e->v[0]->x[1]-e->next_active->v[0]->x[1] +
e->next_active->m*(e->next_active->v[0]->x[0]-e->v[0]->x[0]))/
(e->next_active->m - e->m);
if ( (u > e->v[0]->x[0]-1e-8) && (u < ev.time) && (u < e->v[1]->x[0] - 1e-10)
&& (u < e->next_active->v[1]->x[0] - 1e-10) )
{ ev.e1 = e;
ev.e2 = e->next_active;
ev.time = u;
}
}
/* Backward */
if ( e->prev_active && (e->m < e->prev_active->m))
{ REAL u;
u = e->v[0]->x[0] + (e->v[0]->x[1]-e->prev_active->v[0]->x[1] +
e->prev_active->m*(e->prev_active->v[0]->x[0]-e->v[0]->x[0]))/
(e->prev_active->m - e->m);
if ( (u > e->v[0]->x[0]-1e-8) && (u < ev.time) && (u < e->v[1]->x[0] - 1e-10)
&& (u < e->prev_active->v[1]->x[0] - 1e-10) )
{ ev.e1 = e->prev_active;
ev.e2 = e;
ev.time = u;
}
}
PROF_FINISH(find_next_event)
if ( ev.time < 1e20 )
{
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("next crossing %d %d at %20.15f\n",
ev.e1-vis_conedges,ev.e2-vis_conedges, (double)ev.time);
vis_insert_heap(&ev);
}
}
/*************************************************************************
*
* function: find_next_event2()
*
* purpose: Check for upcoming crossing event between two given edges.
* Doesn't count crossing
* near end of edge. Need to do very robust crossing
* calculation, so not to be fooled by numerical glitches.
*
*/
void find_next_event2(e,ee)
struct vis_conedge *e;
struct vis_conedge *ee;
{ struct vis_event ev;
if ( !e || !ee ) return;
ev.time = 1e30;
/* Forward */
if ( (e->m > ee->m ) )
{ REAL u;
u = e->v[0]->x[0] + (e->v[0]->x[1]-e->next_active->v[0]->x[1] +
e->next_active->m*(e->next_active->v[0]->x[0]-e->v[0]->x[0]))/
(e->next_active->m - e->m);
if ( (u > e->v[0]->x[0]-1e-8) && (u < ev.time) && (u < e->v[1]->x[0] - 1e-10)
&& (u < e->next_active->v[1]->x[0] - 1e-10) )
{ ev.e1 = e;
ev.e2 = e->next_active;
ev.time = u;
}
}
if ( ev.time < 1e20 )
{
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("next crossing %d %d at %20.15f\n",
ev.e1-vis_conedges,ev.e2-vis_conedges, (double)ev.time);
vis_insert_heap(&ev);
}
}
#ifdef XXXXXX
/* for debugging */
/**************************************************************************
*
* function: dump_vislist()
*
* purpose: dump edge list in case of error.
*/
void dump_vislist()
{ struct vis_conedge *e;
REAL v;
int i;
fprintf(stderr,"Visibility edge list debug dump at u = %18.15f; debug_seq %d\n",
sweep_u,debug_seq);
for ( e = active_edge_first ; e != &sentinel ; e = e->next_active )
{ if ( e == NULL ) { fprintf(stderr,"NULL next_active.\n"); break; }
v = e->m*(sweep_u-e->v[0]->x[0]) + e->v[0]->x[1];
fprintf(stderr,"%3d %5d v: %18.15f layers:",e->seqno,e-vis_conedges,v);
for ( i = 0 ; i < e->layers ; i++ )
fprintf(stderr," %3d",ordinal(e->layer[i]->f_id)+1);
fprintf(stderr,"\n");
}
fprintf(stderr,"\n");
}
void check_vislist() /* for v in ascending sequence */
{ struct vis_conedge *e;
REAL v,prev = -1e30;
for ( e = active_edge_first ; e != &sentinel ; e = e->next_active )
{ if ( e == NULL ) { fprintf(stderr,"NULL next_active.\n"); break; }
v = e->m*(sweep_u-e->v[0]->x[0]) + e->v[0]->x[1];
if ( prev > v+1e-5 )
{ dump_vislist();
printf("Bad vislist at debug_seq %d\n",debug_seq);
}
prev = v;
}
}
#endif
/***************************************************************************
*
* function: activate_edge()
*
* purpose: add edge to active edge list, if it is not there.
* Returns insertion coordinate for debugging.
* Does linear search, so could be made more efficient.
*
*/
REAL vis_eps = 1e-13; /* for equality detection */
REAL activate_edge(e)
struct vis_conedge *e;
{ struct vis_conedge *spot;
REAL v,vprev;
int seq = 0;
v = e->m*(sweep_u-e->v[0]->x[0]) + e->v[0]->x[1];
if ( e->next_active ) return v; /* already active */
PROF_START(activate_edge)
vprev = -1e30;
for ( spot = active_edge_first ; spot != NULL ; spot = spot->next_active )
{ REAL spotv = spot->m*(sweep_u-spot->v[0]->x[0]) + spot->v[0]->x[1];
if ( spotv < vprev-1e-5 )
{ sprintf(errmsg,"Internal error: visibility list out of order by %f.\n",
vprev-spotv);
kb_error(3509,errmsg,WARNING);
}
vprev = spotv; /* debugging */
spot->seqno = seq++;
if ( spotv > v+vis_eps ) break;
if ( (spotv > v-vis_eps) && (spot->m > e->m) )
break;
}
vprev = v;
/* Have now located insertion spot; "spot" comes after e */
if ( active_edge_first == spot ) active_edge_first = e;
if ( spot->prev_active ) spot->prev_active->next_active = e;
e->prev_active = spot->prev_active;
spot->prev_active = e;
e->next_active = spot;
if ( e->prev_active )
{ int i;
e->layer = (struct tsort**)temp_calloc(
e->prev_active->layers+4, sizeof(struct tsort*));
e->maxlayers = e->prev_active->layers+4;
for ( i = 0 ; i < e->prev_active->layers ; i++ )
{
add_layer(e,e->prev_active->layer[i]);
}
}
else
{ e->layer = (struct tsort**)temp_calloc(10, sizeof(struct tsort*));
e->maxlayers = 10;
}
/* update sequence numbers; time waster, but we're doing linear search
anyway. */
for ( spot = e ; spot != NULL ; spot = spot->next_active )
{ REAL spotv = spot->m*(sweep_u-spot->v[0]->x[0]) + spot->v[0]->x[1];
if ( spotv < vprev-1e-5 )
{ sprintf(errmsg,"Internal error: visibility list out of order by %f.\n",
vprev-spotv);
kb_error(2509,errmsg,WARNING);
}
vprev = spotv; /* debugging */
spot->seqno = seq++;
}
PROF_FINISH(activate_edge)
return v;
}
/*****************************************************************************
*
* function: check_deactivate()
*
* purpose: see if edge can be deleted from active list, since no longer
* separating facets.
*/
void check_deactivate(e)
struct vis_conedge *e;
{
if ( e->use_count != 0 ) return;
PROF_START(check_deactivate)
if ( e->prev_active )
e->prev_active->next_active = e->next_active;
else active_edge_first = e->next_active;
e->next_active->prev_active = e->prev_active;
find_next_event2(e->prev_active,e->next_active);
e->next_active = e->prev_active = NULL;
temp_free((char*)e->layer);
e->layer = NULL;
PROF_FINISH(check_deactivate)
}
/***************************************************************************
*
* function: facet_start_event()
*
* purpose: handle starts of two edges of facet.
*
* return: -1 if error, 1 if ok.
*/
int facet_start_event(fe)
struct vis_event *fe;
{ REAL v1,v2; /* for some debugging */
struct vis_conedge *spot;
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("start edges %d %d facet %d at %20.15f\n",
fe->e1-vis_conedges,fe->e2-vis_conedges,
fe->t-vis_list, (double)sweep_u);
PROF_START(facet_start_event)
sweep_u = fe->time;
v1 = activate_edge(fe->e1); fe->e1->use_count++;
v2 = activate_edge(fe->e2); fe->e2->use_count++;
if ( v2 < v1 )
{ kb_error(2505,"Internal: Visibility list insertion out of order.\n",
WARNING);
return -1;
}
if ( fe->e1->seqno > fe->e2->seqno )
{ kb_error(2508,"Internal: Visibility list insertion out of order.\n",
WARNING);
return -1;
}
/* add this facet to layers */
for ( spot = fe->e1 ; spot != fe->e2 ; spot = spot->next_active )
{ if ( spot == NULL )
{ kb_error(2506,"Internal: Visibility list bad in facet_start_event().\n",
WARNING);
return -1;
}
add_layer(spot,fe->t);
}
PROF_FINISH(facet_start_event)
find_next_event(fe->e1);
find_next_event(fe->e2);
return 1;
} /* end facet_start_event() */
/***************************************************************************
*
* function: facet_middle_event()
*
* purpose: handle edge transition in middle of facet
*
* return: -1 for error, 1 for ok.
*/
int facet_middle_event(fe)
struct vis_event *fe;
{ struct vis_conedge *e;
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("middle edges %d %d facet %d at %20.15f\n",
fe->e1-vis_conedges,fe->e2-vis_conedges,
fe->t-vis_list,(double)sweep_u);
PROF_START(facet_middle_event)
sweep_u = fe->time;
activate_edge(fe->e2); fe->e2->use_count++;
if ( fe->type == V_FACET_TOPMIDDLE )
{ if ( delete_layer(fe->e2,fe->t) )
{ /* second edge got put in the right way */
for ( e = fe->e2->next_active ; e != fe->e1 ; e = e->next_active )
{ if ( e == NULL )
{ kb_error(2575,
"Internal: Visibility list bad in facet_middle_event().\n",
WARNING);
return -1;
}
delete_layer(e,fe->t);
}
}
else /* got inserted above old edge */
{
for ( e = fe->e1; e != fe->e2 ; e = e->next_active )
{ if ( e == NULL )
{ kb_error(2507,
"Internal: Visibility list bad in facet_middle_event(). \n",
WARNING);
return -1;
}
add_layer(e,fe->t);
}
wrong_middles++;
}
}
else /* bottom middle */
{ if ( add_layer(fe->e2,fe->t) )
{ /* new edge snuck in below old */
for ( e = fe->e2->next_active ; e != fe->e1 ; e = e->next_active )
add_layer(e,fe->t);
wrong_middles++;
}
else /* new edge got in above old */
{ for ( e = fe->e1 ; e != fe->e2 ; e = e->next_active )
delete_layer(e,fe->t);
}
}
fe->e1->use_count--;
check_deactivate(fe->e1);
PROF_FINISH(facet_middle_event)
/* let event crossings take care of place in active list */
find_next_event(fe->e2);
return 1;
} /* end facet_middle_event() */
/***************************************************************************
*
* function: facet_end_event()
*
* purpose: handle deletion of active edges at end of facet
*
* return: -1 for error, 1 for ok.
*/
int facet_end_event(fe)
struct vis_event *fe;
{ struct vis_conedge *spot;
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("end edges %d %d facet %d at %20.15f\n",
fe->e1-vis_conedges,fe->e2-vis_conedges,
fe->t-vis_list,(double)sweep_u);
for ( spot = fe->e1 ; spot != fe->e2 ; spot = spot->next_active )
{ if ( spot == NULL )
{ struct vis_conedge *e;
/* Oops. Something went wrong, so delete facet from entire list */
active_list_check();
for ( e = active_edge_first ; e != &sentinel ; e = e->next_active )
delete_layer(e,fe->t);
break;
}
else
delete_layer(spot,fe->t);
}
PROF_START(facet_end_event)
sweep_u = fe->time;
fe->e1->use_count--; check_deactivate(fe->e1);
fe->e2->use_count--; check_deactivate(fe->e2);
PROF_FINISH(facet_end_event)
return 1;
} /* end facet_end_event() */
/***************************************************************************
*
* function: vis_crossing()
*
* purpose: Handle crossing of two edges. Have to check to be sure
* switching order is needed, since crossing events can be
* listed twice.
*
*/
void vis_crossing(ea,eb)
struct vis_conedge *ea,*eb; /* ea below eb */
{ struct vis_conedge *te;
struct vis_rawedge *ra,*rb;
int i;
if ( ea->next_active != eb ) goto vis_crossing_exit; /* not adjacent */
if ( ea != eb->prev_active )
kb_error(2547,"Inconsistent active list.\n",RECOVERABLE);
vis_crossing_count++;
/* fix up layer lists, using info back in raw edge list */
for ( i = ea->rawstart; i <= ea->rawend ; i++ )
{ ra = rawplist[i];
if ( ra->flags & V_FACET_BOTTOM )
delete_layer(eb,ra->t);
if ( ra->flags & V_FACET_TOP )
add_layer(eb,ra->t);
}
for ( i = eb->rawstart; i <= eb->rawend ; i++ )
{ rb = rawplist[i];
if ( rb->flags & V_FACET_BOTTOM )
add_layer(ea,rb->t);
if ( rb->flags & V_FACET_TOP )
delete_layer(ea,rb->t);
}
PROF_START(vis_crossing)
/* switch order in active list */
eb->next_active->prev_active = ea;
if ( ea->prev_active ) ea->prev_active->next_active = eb;
else active_edge_first = eb;
te = ea->prev_active;
ea->prev_active = eb;
eb->prev_active = te;
te = eb->next_active;
eb->next_active = ea;
ea->next_active = te;
PROF_FINISH(vis_crossing)
/* Test for next events */
find_next_event(ea);
find_next_event(eb);
vis_crossing_exit: ;
}
/* check_layers() - Brute force check of facet layers at point. */
void check_layers(e,u,v)
struct vis_conedge *e;
REAL u,v;
{ int i,j,jj,k;
int found=0;
REAL *x[3];
REAL orientation,d;
for ( i = 0 ; i < f_event_count ; i++ )
{ struct vis_event *fe = facet_events + i;
if ( (fe->type != V_FACET_TOPMIDDLE)
&& (fe->type != V_FACET_BOTTOMMIDDLE)) continue;
x[0] = fe->e1->v[0]->x;
x[1] = fe->e1->v[1]->x;
x[2] = fe->e2->v[1]->x;
orientation = (x[1][0]-x[0][0])*(x[2][1]-x[0][1])
- (x[1][1]-x[0][1])*(x[2][0]-x[0][0]);
for ( j = 0 ; j < 3 ; j++ )
{ jj = (j==2) ? 0 : j+1;
d = (x[jj][0]-x[j][0])*(v-x[j][1])
- (x[jj][1]-x[j][1])*(u-x[j][0]);
if ( d*orientation < 0.0 )
break;
}
if ( j < 3 ) continue; /* not all on proper side */
/* now check layers */
for ( k = 0 ; k < e->layers ; k++ )
if ( fe->t == e->layer[k] )
{ found++; break; }
if ( k == e->layers )
{ fprintf(stderr,"Edge %d missing facet %d at (%f,%f).\n",e-vis_conedges,
fe->t - vis_list,u,v);
}
}
/* report */
if ( found < e->layers )
fprintf(stderr,"Edge %d extra %d layers(facet %d) at (%f,%f).\n",
e-vis_conedges,e->layers-found,e->layer[0]-vis_list,u,v);
}
/*************************************************************************
*
* function: check_visible()
*
* purpose: Inspect layers of changed edge stacks and mark topmost facets.
* Uses facet order from painter algorithm rather than
* calculating local z, since that is subject to problems with
* abutting facets.
*
*/
void check_visible(u)
REAL u; /* sweep time to check */
{ REAL v,vv; /* height on sweep line of edge and next */
int i,j;
PROF_START(check_visible)
for ( i = 0 ; i < check_list_count ; i++ )
{ struct vis_conedge *e = check_list[i];
struct tsort *topf;
e->flags &= ~V_LAYER_CHECK;
if ( e->next_active == NULL ) continue;
v = e->m*(u-e->v[0]->x[0]) + e->v[0]->x[1];
vv = e->next_active->m*(u-e->next_active->v[0]->x[0])
+ e->next_active->v[0]->x[1];
if ( fabs(v-vv) < 1e-10 ) continue; /* ignore cracks */
v = (v+vv)/2;
if ( visdebuglevel >= VIS_LAYERCHECK )
check_layers(e,u,v); /* debugging */
topf = NULL;
for ( j = 0 ; j < e->layers ; j++ )
{
struct tsort *f = e->layer[j];
if ( f > topf ) /* using painter facet order */
{ topf = f; }
}
if ( topf )
{ topf->flag |= VISIBLE;
if ( visdebuglevel >= VIS_EVENTDUMP )
printf("Marking facet %d visible.\n",topf-vis_list);
}
}
check_list_count = 0;
PROF_FINISH(check_visible)
}
#ifdef BRUTE
/*************************************************************************
Brute force visibility.
**************************************************************************/
/*************************************************************************
*
* function: brutecomp
*
* purpose: comparison function for sorting brute force event times.
*/
int brutecomp (const void *a, const void *b)
{
struct brute *aa = (struct brute *)a;
struct brute *bb = (struct brute *)b;
if ( aa->time < bb->time ) return -1;
if ( aa->time > bb->time ) return 1;
if ( aa->e1 < bb->e1 ) return -1;
if ( aa->e1 > bb->e1 ) return 1;
if ( aa->e2 < bb->e2 ) return -1;
if ( aa->e2 > bb->e2 ) return 1;
return 0;
}
/*************************************************************************
*
* function: brutecut_comp
*
* purpose: comparison function for sorting brute force cut heights.
*/
int brute_cut_comp (const void *a, const void *b)
{
struct brute_cut *aa = (struct brute_cut *)a;
struct brute_cut *bb = (struct brute_cut *)b;
if ( aa->v < bb->v ) return -1;
if ( aa->v > bb->v ) return 1;
if ( aa->e < bb->e ) return -1;
if ( aa->e > bb->e ) return 1;
return 0;
}
/***************************************************************************
*
* function: brute_section
*
* purpose: Find all edge intersections at a particular sweep position
* by brute force, and order by height.
*/
void brute_section(u)
REAL u; /* sweep position */
{ struct brute_cut *b;
int i;
struct vis_edge *e;
brute_cut_count = 0;
for ( i = 0 ; i < vecount ; i++ )
{ e = vis_edges + i;
if ( e->x[0][0] > u ) continue;
if ( e->x[1][0] < u ) continue;
b = brute_cuts + brute_cut_count++;
b->v = e->m*(u-e->x[0][0]) + e->x[0][1];
b->e = e;
}
qsort(brute_cuts,brute_cut_count,sizeof(struct brute_cut),FCAST brute_cut_comp);
}
/*************************************************************************
*
* function: brute_visible()
*
* purpose: Mark as visible those facets along sweep line, using edge
* order found by brute_section().
*
*/
struct vis_facet *brute_column[100]; /* list of facets at spot */
void brute_visible(u)
REAL u; /* sweep line position */
{ int i,j;
int depth = 0; /* number of facets stacked up */
REAL v,vv,z;
brute_section(u);
for ( i = 0 ; i < brute_cut_count-1 ; i++ )
{ struct vis_edge *e = brute_cuts[i].e;
struct vis_edge *ee = brute_cuts[i+1].e;
if ( e->flags & V_FACET_BOTTOM )
{ /* add to column */
brute_column[depth++] = e->f;
}
else if ( e->flags & V_FACET_TOP )
{ /* delete from column */
for ( j = 0 ; j < depth ; j++ )
if ( brute_column[j] == e->f )
brute_column[j] = brute_column[--depth];
}
/* check halfway in between for top facet */
v = e->m*(u-e->x[0][0]) + e->x[0][1];
vv = ee->m*(u-ee->x[0][0]) + ee->x[0][1];
if ( (depth > 0) && (fabs(v-vv) > 1e-8) )
{ REAL topz = -1e30;
int topj = -1;
v = (v+vv)/2;
for ( j = 0 ; j < depth ; j++ )
{ struct vis_facet *f = brute_column[j];
z = f->a*u + f->b*v + f->c;
if ( z > topz )
{ topj = j; topz = z; }
}
brute_column[topj]->t->flag |= VISIBLE;
}
}
}
#endif
evolver-2.30c.dfsg/src/proto.h 0000644 0001753 0001753 00000137735 11410765113 016551 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* File: proto.h
*
* Purpose: ANSI function prototypes.
* Note: Some compilers still don't like ANSI prototypes, so
* ARGS() is a macro defined in include.h to take care
* of that.
*/
#ifdef __cplusplus
void loadstub(void);
extern "C" {
#endif
#ifndef drand48
extern double drand48 ARGS((void)); /* may not be in header file */
#endif
#ifdef MSC
extern void srand48 ARGS((int));
#endif
#ifdef MPI_EVOLVER
#include "mpi_proto.h"
#endif
void read_array_initializer ARGS((struct array *));
int simple_unstar ARGS((facetedge_id));
int check_recalc_attr ARGS((int));
void check_readonly_attr ARGS((int));
void check_special_attr ARGS((int));
int get_name_dim ARGS((int,struct locallist_t *));
int get_name_datatype ARGS((int,struct locallist_t *));
char * get_name_name ARGS((int,struct locallist_t *));
struct array *get_name_arrayptr ARGS((int,REAL*,struct locallist_t *));
int check_array_dims_same ARGS((int ,int));
void one_sided_volume_adjust ARGS((vertex_id));
int one_sided_lagrange_adjust ARGS((vertex_id));
int mat_approx_solve ARGS((REAL**,int,REAL*));
REAL vertex_total_vol_grad ARGS((vertex_id,REAL*));
void calc_one_sided_grads ARGS((void));
void mpi_hessian_cleanup ARGS((void));
void do_multigrid ARGS((struct linsys*));
void mark_recalc_params ARGS((void));
int mark_recalc_expr ARGS((struct expnode*));
int vertex_facet_check ARGS((void));
WRAPTYPE identity_inverse ARGS((WRAPTYPE));
WRAPTYPE identity_compose ARGS((WRAPTYPE,WRAPTYPE));
void identity_wrap ARGS((REAL *,REAL *,WRAPTYPE));
void identity_form_pullback ARGS((REAL *,REAL *,REAL *,WRAPTYPE));
void graph_string_facet ARGS((facet_id,struct graphdata *,int));
void plain_string_facets ARGS((void));
void print_profiling ARGS((void));
void reset_profiling ARGS((void));
void convert_constraint_to_quantities ARGS((int));
int create_body_boundary_content_method ARGS((body_id,int));
int create_body_constraint_content_method ARGS((body_id,int));
void simplex_to_fe ARGS((void));
void check_forwards ARGS((void));
int star_finagle ARGS((edge_id));
void cg_restart ARGS((void));
REAL cg_sum_calc ARGS((void));
void cg_direction_local ARGS((void));
REAL ribiere_calc ARGS((void));
REAL v_estimate ARGS((void));
void add_vgrads_to_update ARGS(( struct linsys *));
void slice_facet ARGS((struct graphdata *));
void slice_edge ARGS((struct graphdata *));
void clip_facet ARGS((struct graphdata *,facet_id,int));
void clip_edge ARGS((struct graphdata *,edge_id,int));
void graph_edge_clip ARGS((struct graphdata *,edge_id));
void mark_element_loops ARGS((struct treenode *, int));
void mem_list_dump ARGS((void));
struct element * elhash_lookup ARGS((element_id));
void elhash_delete ARGS((element_id));
void elhash_bigger ARGS((void));
void elhash_extend ARGS((int,int));
struct element *elhash_new_element ARGS((int,element_id));
void elhash_insert ARGS((element_id,struct element *));
void elhash_replace ARGS((element_id,struct element *));
void matrix_multiply_command ARGS((struct array*,struct array*,struct array*,REAL*,REAL*,REAL*));
int matrix_inverse_command ARGS((struct array*,struct array*,REAL*,REAL*));
REAL matrix_determinant_command ARGS((struct array*,REAL*));
void tree_analyze ARGS((struct linsys *));
void fixup_edge_content_meths ARGS((edge_id));
void fixup_vertex_content_meths ARGS((vertex_id));
REAL tetra_vol ARGS((REAL*,REAL*,REAL*,REAL*));
int read_single_value ARGS((int,char*));
void set_ctypes ARGS((void));
void kb_unput ARGS((char));
void list_quantity ARGS((int));
void list_method_instance ARGS((int));
void list_boundary ARGS((int));
void list_constraint ARGS((int));
void torus_unwrap_edge ARGS(( edge_id ));
int pop_vertex_to_tri ARGS(( vertex_id, edge_id *));
int pop_vertex_to_quad ARGS(( vertex_id, edge_id *));
int cubecone_pop ARGS(( vertex_id, int ));
void wrap_vertex ARGS((vertex_id,int));
void find_cpu_speed ARGS((void));
void reset_counts ARGS((void));
int pop_constrained_vertex ARGS((vertex_id));
int one_con_pop_2 ARGS((vertex_id,edge_id *,edge_id *,int));
int one_con_pop_3 ARGS((vertex_id,int ,edge_id *,edge_id *,int));
int one_con_pop_4 ARGS((vertex_id,edge_id *,int));
int double_con_pop ARGS((vertex_id,edge_id,edge_id *));
int triple_con_pop ARGS((vertex_id));
void flush_counts ARGS((void));
void merge_vertex ARGS((vertex_id,vertex_id));
void merge_edge ARGS((edge_id,edge_id));
void merge_facet ARGS((facet_id,facet_id));
void binary_tree_add ARGS((REAL*,REAL));
void torus_display_period_init ARGS((void));
REAL bezier_eval ARGS((int, int, int*, REAL *));
void bezier_convert_1D_init ARGS(( int ));
void bezier_convert_2D_init ARGS(( int ));
int t1_edgeswap ARGS((edge_id));
void get_edge_tail_tangent ARGS((edge_id,REAL*));
int valid_element ARGS((element_id));
void bezier_trans_1d ARGS((int,int,REAL**));
void bezier_eval_1d ARGS((int,int,REAL,REAL**,REAL*));
void lagrange_eval_1d ARGS((int,int,REAL,REAL**,REAL*));
void bezier_refine_1d_init ARGS((int));
void lagrange_to_bezier ARGS((void));
void bezier_to_lagrange ARGS((void));
void bezier_trans_2d ARGS((int,int,REAL**));
void lagrange_eval_2d ARGS((int,int,REAL*,REAL**,REAL*));
void bezier_eval_2d ARGS((int,int,REAL*,REAL**,REAL*));
void bezier_refine_2d_init ARGS((int));
void OFF_start ARGS((void));
void OFF_edge ARGS((struct graphdata *, edge_id));
void OFF_facet ARGS((struct graphdata *, facet_id));
void OFF_end ARGS((void));
void binary_OFF_start ARGS((void));
void binary_OFF_edge ARGS((struct graphdata *, edge_id));
void binary_OFF_facet ARGS((struct graphdata *, facet_id));
void binary_OFF_end ARGS((void));
unsigned int int32hash ARGS((unsigned int));
#ifndef NOLONGLONG
unsigned long long int64hash ARGS((unsigned long long));
#endif
void partner_move ARGS((void));
void partner_shift_grads ARGS((int));
void partner_hit_velocity_fix ARGS((void));
void partner_hit_volgrad_fix ARGS((void));
void detect_bdry_hits ARGS((void));
void thread_move_vertices ARGS((void));
void torus_period_init ARGS((void));
void set_eigenvalue_list_global ARGS((REAL*,int));
void set_view_transforms_global ARGS((void));
void set_torus_periods_global ARGS((void));
void set_inverse_periods_global ARGS((void));
void set_view_matrix_global ARGS((void));
void initialize_perm_globals ARGS((void));
void allocate_transform_colors ARGS((int));
int pop_tri_to_edge ARGS((facet_id));
int pop_edge_to_tri ARGS((edge_id));
int pop_edge_to_tri_con ARGS((edge_id));
int pop_quad_to_quad ARGS((facet_id));
void stack_usage ARGS((struct expnode *));
void list_top_procedures ARGS((int));
void list_procedure ARGS((struct global *));
void list_procedure_proto ARGS((struct global *));
void list_function_proto ARGS((struct global *));
void list_function ARGS((struct global *));
void init_local_scope ARGS((ident_t));
void exit_local_scope ARGS((void));
void begin_local_scope ARGS((void));
void end_local_scope ARGS((void));
void locals_copy ARGS((struct locallist_t **,struct locallist_t *));
void locals_copy_perm ARGS((struct locallist_t **,struct locallist_t *));
ident_t lookup_local_var ARGS((char*));
ident_t add_local_var ARGS((char*,int));
void read_attribute_value ARGS((struct extra *, void*));
int equiangulate_edge ARGS((edge_id));
int calc_view_transform_gens ARGS((void));
void force_project ARGS(( REAL*, vertex_id, REAL *));
int global_meth_needs ARGS((int));
int pop_given_vertex ARGS((vertex_id));
int pop_string_vertex ARGS((vertex_id));
void print_array ARGS((struct array *,void*));
void print_array_attribute ARGS(( struct extra*, void*));
void recalc_facet_area ARGS((facet_id));
void rewind_globals ARGS((int));
void perm_rewind_globals ARGS((int));
void add_warning_message ARGS((char*));
void graph_new_surface ARGS((void));
void LD_solve ARGS((REAL**,REAL*,REAL*,int));
int LD_factor ARGS(( REAL**, int ));
int lookup_global_hash ARGS((char*,int,int,int));
void dy_check ARGS((void));
void report_quantities ARGS((void));
void list_free ARGS((char *,int));
void list_free_all ARGS((int));
#ifdef MEMSTRINGS
char * list_calloc ARGS((size_t,size_t,int,char*,size_t));
char * list_realloc ARGS((char *,size_t,int,char*,size_t));
#else
char * list_calloc ARGS((size_t,size_t,int));
char * list_realloc ARGS((char *,size_t,int));
#endif
void mem_list_summary ARGS((void));
void mem_check_sanity ARGS((void));
void change_hessian_functions ARGS((int,int));
int LD_block_factor ARGS((REAL **, int));
void LD_block_solve ARGS((REAL **, REAL *, REAL *, int));
int find_fixed ARGS((void));
void sp_hash_init ARGS((struct linsys *,int));
void sp_hash_expand ARGS((struct linsys *));
void sp_hash_search ARGS((struct linsys *,int,int,REAL));
int sp_hash_end ARGS((struct linsys *,int,int,int));
void my_pvm_exit ARGS((void));
void pvm_calc_quants ARGS((int));
void pvm_calc_quant_grads ARGS((int));
void pvm_facet_knot_init ARGS((REAL*));
int two_split ARGS((facetedge_id,int));
int vertex_degfree ARGS((vertex_id));
int edge_degfree ARGS((edge_id));
int facet_degfree ARGS((facet_id));
void divide_quad ARGS((facetedge_id));
int pop_one_edge ARGS((edge_id));
void set_scroll_size ARGS((int));
REAL ellipticK ARGS((REAL));
REAL ellipticE ARGS((REAL));
REAL ellipticKdm ARGS((REAL));
REAL ellipticEdm ARGS((REAL));
REAL ellipticKdmdm ARGS((REAL));
REAL ellipticEdmdm ARGS((REAL));
REAL incompleteEllipticF ARGS((REAL,REAL));
REAL incompleteEllipticFdphi ARGS((REAL,REAL));
REAL incompleteEllipticFdm ARGS((REAL,REAL));
REAL incompleteEllipticFseconds ARGS((REAL,REAL,REAL*,REAL*,REAL*,REAL*,REAL*));
REAL incompleteEllipticE ARGS((REAL,REAL));
REAL incompleteEllipticEdphi ARGS((REAL,REAL));
REAL incompleteEllipticEdm ARGS((REAL,REAL));
REAL incompleteEllipticEseconds ARGS((REAL,REAL,REAL*,REAL*,REAL*,REAL*,REAL*));
int INDEX_TO_RGBA ARGS((int));
void multi_calc_quants ARGS((int));
void m_fix_grads ARGS((void));
void m_calc_quant_grads ARGS((int));
int mylock_web ARGS((void));
int myunlock_web ARGS((void));
int mylock_element ARGS((element_id));
int myunlock_element ARGS((element_id));
element_id thread_next_element ARGS((void));
void thread_launch ARGS((int,int));
void thread_project_all ARGS((int));
void thread_calc_facet_energy ARGS((void));
void thread_calc_facet_forces ARGS((void));
REAL interp_edge_attribute ARGS(( edge_id ,struct extra *, int ,int));
REAL interp_facet_attribute ARGS(( edge_id ,struct extra *, int ,int));
REAL get_extra_attrib_value ARGS(( element_id, struct extra *, int));
void define_array ARGS((void));
void userfunc_init ARGS((void));
void break_check ARGS((void));
int lagrange_facet_normal ARGS((vertex_id,facet_id,REAL**));
void test_axial_points ARGS(( facet_id ));
int compare_edge_attr ARGS((edge_id, edge_id));
int compare_edge_facet_attr ARGS((edge_id,facet_id));
int compare_vertex_edge_attr ARGS((vertex_id, edge_id));
int compare_vertex_attr ARGS((vertex_id, vertex_id));
void set_body_volume ARGS((body_id,REAL,int));
void add_body_volume ARGS((body_id,REAL));
void add_body_volume_plain ARGS((body_id,REAL));
void add_body_abstotal ARGS((body_id,REAL));
void set_body ARGS((facet_id,body_id));
int kb_yylex ARGS((YYSTYPE*));
void reset_inputbuffer ARGS((void));
char *my_fgets ARGS((char *,int,FILE *stream));
int method_check ARGS((void));
void renumber_all ARGS((void));
void reorder_storage ARGS((void));
int identtype ARGS((char*));
REAL kb_drand ARGS((void));
void kb_initr ARGS((int));
void dump_macros ARGS((void));
void move_to_free_front ARGS((int,int));
void calc_all_grads ARGS((int));
void check_pinning ARGS((void));
void convert_forms_to_vectors ARGS((int));
void local_convert_forms_to_vectors ARGS((int));
void clear_v_conmap ARGS((vertex_id ));
void list_attributes ARGS((void));
void reset_rot_order ARGS((void));
void start_logfile ARGS((char*));
void stop_logfile ARGS((void));
void start_keylogfile ARGS((char*));
void stop_keylogfile ARGS((void));
void one_sided_adjust ARGS((int));
void calc_leftside ARGS((void));
void local_calc_leftside ARGS((void));
void local_calc_rightside ARGS((void));
void load_library ARGS((char *));
void unload_libraries ARGS((void));
dll_func_type search_libraries ARGS((char*));
REAL get_internal_variable ARGS((int ));
void check_element_type ARGS(( int, int ));
int read_pick ARGS((void));
int count_fixed_vol ARGS((void));
int oid ARGS((element_id));
void flip_toggle ARGS((int*,int,char*));
int gram_schmidt ARGS((REAL**,int,int));
int new_vertex_average ARGS((vertex_id,int));
int lagrange_vertex_average ARGS((vertex_id,REAL*));
void keyword_help ARGS((char *));
void error_help ARGS((char *));
void write_to_console ARGS((char *));
void read_line_from_console ARGS((char *));
int do_edgeswap ARGS((edge_id));
void apply_h_inverse_metric ARGS((void));
void list_proc ARGS((struct global *,int));
void list_procedures ARGS((int));
void linear_to_lagrange ARGS((int));
void quad_to_lagrange ARGS((int));
void lagrange_to_linear ARGS((void));
void lagrange_to_quad ARGS((void));
void sparse_permute ARGS((struct linsys *));
void do_tree_factor ARGS((struct linsys *));
void do_tree_solve ARGS((struct linsys *,REAL *,REAL*));
int find_method_instance ARGS((char*));
int find_quantity ARGS((char*));
void reconvert_bodies_to_quantities ARGS((void));
void convert_bodies_to_quantities ARGS((void));
int string_rebody ARGS((void));
void lagrange_to_lagrange ARGS((int));
void simplex_lagrange_to_lagrange ARGS((int));
void metis_partition ARGS((int,int));
void metis_partition_plain ARGS((int,int));
void metis_partition_body ARGS((int,int));
void metis_partition_dual ARGS((int,int));
void metis_order ARGS((struct linsys *));
void metis_vertex_order ARGS((int));
int lagrange_index ARGS((int,int,int*));
int increment_lagrange_index ARGS((int,int*));
void gauss_lagrange_setup ARGS((int,int,int));
void det_hess ARGS((REAL **,REAL ****,int ));
int simplex_delete_facet ARGS((facet_id));
int simplex_delete_edge ARGS((vertex_id,vertex_id));
void write_hessian ARGS((struct linsys *));
REAL gravity_all ARGS((struct qinfo *,int));
void LQ_decomp ARGS((REAL**,int,int,REAL**,REAL**,struct linsys *));
void q_info_free ARGS((struct qinfo *));
void q_info_init ARGS((struct qinfo *,int));
void make_el_list ARGS((int));
int Ord ARGS((element_id));
void toggle_save ARGS((char*));
void toggle_save_off ARGS((char*));
int get_v_constraint_status ARGS((vertex_id,int));
int v_hit_constraint_count ARGS((vertex_id));
REAL square_grad ARGS((void));
void square_grad_forces ARGS((void));
void cg_ritz ARGS((struct linsys *,int,REAL**,REAL*));
int check_pick ARGS((void));
void read_extra ARGS((element_id,int));
int simplex_quadrature ARGS((int,int,int,REAL**,REAL*));
int eartest ARGS((vertex_id,vertex_id));
void convert_string ARGS((char*,char*));
void hessian_legal ARGS((void));
int check_one_sided_constraints ARGS((void));
void set_v_global ARGS((vertex_id));
void set_v_conmap ARGS((vertex_id,conmap_t*));
void set_e_conmap ARGS((edge_id,conmap_t*));
void set_f_conmap ARGS((facet_id,conmap_t*));
void set_v_constraint_map ARGS((vertex_id,int));
void unset_v_constraint_map ARGS((vertex_id,int));
void set_v_constraint_status ARGS((vertex_id,int));
void unset_v_constraint_status ARGS((vertex_id,int));
void clear_v_constraint_status ARGS((vertex_id));
void set_e_constraint_map ARGS((edge_id,int));
void unset_e_constraint_map ARGS((edge_id,int));
void set_f_constraint_map ARGS((facet_id,int));
void unset_f_constraint_map ARGS((facet_id,int));
int v_on_constraint ARGS((vertex_id,int));
int e_on_constraint ARGS((edge_id,int));
int f_on_constraint ARGS((facet_id,int));
void get_v_common_conmap ARGS((vertex_id,vertex_id,conmap_t *));
int simplex_tiny_edges ARGS((REAL));
int get_tag ARGS((facet_id));
void set_tag ARGS((facet_id,int));
void ritz_command ARGS((REAL,int));
void do_ritz ARGS((struct linsys *,REAL,int,REAL **));
void print_hessian_menu ARGS((void));
void expand_attribute ARGS((int,int,int*));
void expand_global_hash ARGS((void));
int edgeswap ARGS(( edge_id));
REAL sparse_metric_dot ARGS((REAL*,REAL*,struct linsys *));
void gauss_jacobi ARGS((int, REAL , REAL *, REAL *));
void jacobi_eigenpairs ARGS(( REAL **, int, REAL *, REAL **, REAL *));
void star_metric_setup ARGS(( struct linsys *S, struct linsys *));
void linear_metric_setup ARGS((struct linsys *, struct linsys *));
void linear_metric_setup_quadratic ARGS(( struct linsys *, struct linsys *));
void linear_metric_setup_lagrange ARGS(( struct linsys *, struct linsys *));
REAL get_vertex_length_star ARGS((vertex_id));
REAL get_vertex_area_star ARGS((vertex_id));
void convert_to_quantities ARGS((void));
void convert_body_to_quantity ARGS((body_id));
void convert_new_body_to_quantity ARGS((body_id));
void long_jiggle ARGS((void));
void free_system ARGS((struct linsys *));
int simplex_long_edges ARGS((REAL));
void lanczos_command ARGS((REAL,int));
void eigenprobe_command ARGS((REAL,int));
void myfree ARGS((char *));
void option_facet ARGS((struct graphdata*,facet_id));
void geomview_command ARGS((char*));
void ysmp_numeric_factor ARGS((void));
void sp_hessian_mult ARGS((struct linsys *S, REAL *B, REAL *C));
void sp_solution ARGS((struct linsys *S, REAL *B, REAL *C));
void hessian_exit ARGS((REAL *));
void hessian_cleanup ARGS((void));
void hessian_solve ARGS((void));
void hessian_downhill ARGS((void));
void hessian_move ARGS((REAL,int,REAL *));
int lanczos ARGS((struct linsys*,int,REAL*,int));
int selective_lanczos ARGS((struct linsys*,int,REAL*,int));
void tridiag_QL ARGS((REAL*,REAL*,int));
void intersect_detect ARGS((void));
void bk_mul ARGS((struct linsys *, REAL*,REAL*));
void bk_AIJ_setup ARGS((int,struct linsys*));
void bk_eigenprobe ARGS((struct linsys *));
void bk_inverse_it ARGS((struct linsys *, REAL *));
void sp_hessian_solve ARGS((struct linsys *,REAL *, REAL *,int));
void sp_hessian_solve_multi ARGS((struct linsys *,REAL **, REAL **,int));
void sp_Hessian_solver ARGS((struct linsys *, REAL *, REAL **));
void bk_constraint_setup ARGS((int, struct linsys *));
void BK_hess_project_setup ARGS((struct linsys *));
void xmd_factor ARGS((struct linsys *));
void xmd_solve ARGS((struct linsys *,REAL *,REAL *));
void xmd_solve_multi ARGS((struct linsys *,REAL **,REAL **,int));
void sp_CHinvC ARGS((struct linsys *));
void tree_factor ARGS((struct linsys *));
void tree_solve ARGS((struct linsys *,REAL *,REAL *));
void tree_solve_multi ARGS((struct linsys *,REAL **,REAL **,int));
void ysmp_factor ARGS((struct linsys *));
void ysmp_solve ARGS((struct linsys *,REAL *,REAL *));
void ysmp_solve_multi ARGS((struct linsys *,REAL **,REAL **,int));
void find_ordering ARGS((struct hess_verlist *,int,int *));
void hessian_saddle ARGS((REAL));
REAL lowest_eigenpair ARGS((struct linsys *,REAL *));
REAL cg_lowest_eigenpair ARGS((struct linsys *,REAL *));
REAL old_cg_lowest_eigenpair ARGS((struct linsys *,REAL *));
REAL new_cg_lowest_eigenpair ARGS((struct linsys *,REAL *));
element_id get_ordinal_id ARGS((int,int));
element_id get_full_id ARGS((int,element_id));
void project_all ARGS((int,int));
void chebychev_hess ARGS((struct linsys *));
void chebychev_ev ARGS((struct linsys *));
void fill_self_entry ARGS((struct linsys *,vertex_id,REAL**));
void fill_grad ARGS((struct linsys *,struct hess_verlist *,REAL*,REAL *));
int add_attribute ARGS((int,char*,int,int,int*,int,struct expnode *));
int find_attribute ARGS((int,char*));
int find_extra ARGS((char *, int *));
int matrix_index ARGS((REAL**,int));
int exec_commands ARGS((FILE *,char *));
void *mac_exec_commands ARGS((FILE *));
void push_fd ARGS((FILE *,char *));
void pop_fd ARGS((void));
facet_id get_vertex_facet ARGS((vertex_id));
facet_id get_vertex_first_facet ARGS((vertex_id));
facet_id get_next_vertex_facet ARGS((vertex_id,facet_id));
facet_id get_simplex_next_vertex_facet ARGS((vertex_id,facet_id));
void macro_init ARGS((void));
REAL ** mat2d_setup ARGS((REAL**,REAL*,int,int));
REAL *** mat3d_setup ARGS((REAL***,REAL*,int,int,int));
REAL **** mat4d_setup ARGS((REAL****,REAL*,int,int,int,int));
void zerohess ARGS((struct qinfo *));
void get_facet_normal ARGS((facet_id,REAL*));
int get_toggle_value ARGS((int));
REAL user_attribute ARGS((element_id));
void force_normalization ARGS((void));
void insert_vertex_edge ARGS((vertex_id,edge_id));
void remove_vertex_edge ARGS((vertex_id,edge_id));
void insert_vertex_facet ARGS((vertex_id,facet_id));
void remove_vertex_facet ARGS((vertex_id,facet_id));
void catfulltext ARGS((char*));
int identcase ARGS((char*));
int eliminate_facet ARGS((facet_id));
int string_eliminate_facet ARGS((facet_id));
REAL quantity_attribute ARGS(( element_id, int ));
REAL instance_attribute ARGS(( element_id, int ));
int kb_checksum ARGS((char *,int));
void apply_quantity ARGS((element_id,int));
void unapply_quantity ARGS((element_id,int));
void read_instance_attr ARGS(( int ));
int read_named_quantity ARGS((void));
DY_OFFSET dy_calloc ARGS((int,int));
DY_OFFSET dy_realloc ARGS((DY_OFFSET,int,int));
void dy_free ARGS((DY_OFFSET));
void dump_method_specs ARGS(( int ));
void read_method_attr ARGS(( int ));
void calc_periods ARGS((int));
int read_method_instance ARGS((void));
int add_standard_quantity ARGS((char *,REAL));
int new_method_instance ARGS((char*,char*));
int attach_method ARGS(( int, char *));
int attach_method_num ARGS(( int, int));
void apply_method ARGS(( element_id , char *));
void apply_method_num ARGS(( element_id , int));
void unapply_method ARGS(( element_id , int));
int rebody ARGS((void));
int merge_bodies ARGS((void));
int get_body_valence ARGS((body_id ));
int get_vertex_evalence ARGS((vertex_id ));
int get_vertex_fvalence ARGS((vertex_id ));
void make_vfacet_lists ARGS((void));
void make_bfacet_lists ARGS((void));
void make_vedge_lists ARGS((void));
REAL dirichlet ARGS((int));
REAL sobolev ARGS((int));
int unstar ARGS((facetedge_id));
void reduce_string ARGS((char *));
REAL vertex_angle ARGS((vertex_id));
void fix_ctm ARGS((REAL**,REAL,REAL));
void my_exit ARGS((int));
void reverse_orientation_edge ARGS((edge_id));
void reverse_orientation_facet ARGS((facet_id));
int dissolve_vertex ARGS((vertex_id));
int dissolve_edge ARGS((edge_id));
int dissolve_facet ARGS((facet_id));
int dissolve_body ARGS((body_id));
REAL vertex_sq_mean_curvature ARGS((vertex_id));
REAL vertex_mean_curvature ARGS((vertex_id));
void burchard ARGS((int));
void do_gfile ARGS((int,char*));
int mat_simplify ARGS((REAL***,int));
void transform_gen_expr ARGS((char *));
void generate_transforms ARGS((int));
void read_transform_generators ARGS((int));
int const_expr ARGS((char *,REAL *));
REAL wedge_angle ARGS((vertex_id));
void begin_normal_motion ARGS((void));
void end_normal_motion ARGS((void));
REAL gray_level ARGS((float *));
void metric_form_to_vector ARGS((REAL*,REAL*));
void end_geomview_object ARGS((void));
void calc_quant_grads ARGS((int));
int simplex_element_id_edges ARGS((REAL));
void quantity_init ARGS((void));
int new_quantity ARGS((char *,int));
void add_quantity ARGS((element_id,char*,char*));
REAL calc_quants ARGS((int));
void graph_edge_transforms ARGS(( struct graphdata *, edge_id ));
void graph_facet_transforms ARGS(( struct graphdata *, facet_id ));
void other_stuff ARGS((struct treenode *,int*,int*,element_id,REAL*,struct locallist_t*));
void more_other_stuff ARGS((struct treenode *,int*,int*,element_id,REAL*,struct locallist_t*));
void ask_wrap_display ARGS((void));
void print_attr ARGS(( struct treenode *, char *));
void print_set_attr ARGS(( struct treenode *, char *));
void set_print ARGS((struct treenode *, char *, char *,int));
void binary_print ARGS(( struct treenode *, int, int, char *, int));
int lookup_global ARGS((char*));
int lookup_perm_global ARGS((char*));
void klein_area_grad ARGS((REAL **,REAL**));
REAL klein_area ARGS((REAL**));
void klein_length_grad ARGS((REAL*,REAL*,REAL*,REAL*));
REAL klein_length ARGS((REAL*,REAL*));
void geomview_start ARGS((void));
void geomview_facet ARGS((struct graphdata *, facet_id));
void geomview_edge ARGS((struct graphdata *, edge_id));
void geomview_end ARGS((void));
void tree_copy ARGS(( struct expnode *, struct treenode *));
void perm_tree_copy ARGS(( struct expnode *, struct treenode *));
void conf_edge_curv_energy ARGS((void));
void conf_edge_curv_force ARGS((void));
REAL dihedral ARGS((edge_id));
void clear_symtable ARGS((void));
void clear_globals ARGS((void));
int add_global ARGS((char *));
int add_perm_global ARGS((char *));
char *keywordname ARGS((int));
void subtree_swap ARGS((int*,int*));
int begin_scope ARGS((void));
void end_scope ARGS((void));
void set_scope ARGS((int));
struct sym * symbol_add ARGS((char*,int));
struct sym *symbol_lookup ARGS((char*));
vertex_id void_test ARGS((vertex_id *,int));
char *tokname ARGS((int));
void update_aggr ARGS((int ,REAL *,REAL ));
void hessian_init ARGS((struct linsys *,REAL **));
void hessian_fill ARGS((struct linsys *,REAL **));
void find_hess_entry ARGS((struct linsys *, struct hess_verlist*,
struct hess_entry *[MAXCOORD][MAXCOORD]));
void fill_hess_entry ARGS((struct linsys *, vertex_id,REAL**));
int find_mixed_entry ARGS((struct linsys *, struct hess_verlist*,
struct hess_verlist* ,struct hess_entry *[MAXCOORD][MAXCOORD]));
void fill_mixed_entry ARGS((struct linsys *, vertex_id,vertex_id, REAL **));
int find_hess_entries ARGS((struct linsys *, struct hess_verlist*,
struct hess_verlist*,
struct hess_entry *[MAXCOORD][MAXCOORD],
struct hess_entry *[MAXCOORD][MAXCOORD],
struct hess_entry *[MAXCOORD][MAXCOORD]));
void area_hessian ARGS((struct linsys *,REAL *));
void calc_quant_hess ARGS((struct linsys *,int,int,REAL *));
void m_calc_quant_hess ARGS((int,int,REAL *));
void m_fix_hess ARGS((struct linsys *S));
void difference_hessian ARGS((struct linsys *,struct hess_verlist*,REAL *));
void edge_energy_hessian ARGS((struct linsys *,REAL *));
void simplex_hessian ARGS((struct linsys *,REAL *));
void simplex_facet_hessian ARGS((struct linsys *,REAL *));
void simplex_edge_hessian ARGS((struct linsys *,edge_id,REAL**,REAL****));
void edge_constr_hessian ARGS((struct linsys *,edge_id,REAL**,REAL****));
int body_hessian ARGS((struct linsys *,REAL*));
void tree_exec ARGS(( struct treenode *));
void letter_command ARGS((int));
void pop_commandfd ARGS((void));
void push_commandfd ARGS((FILE*,char*));
void pop_datafd ARGS((void));
void push_datafd ARGS((FILE*,char*));
void exec_file ARGS((FILE*,char*));
void unput_tok ARGS((void));
void unput_string ARGS((char*));
void set_f_phase_density ARGS((facet_id));
void set_e_phase_density ARGS((edge_id));
int bdry_basis ARGS((vertex_id,REAL**));
int constr_basis ARGS((vertex_id,REAL**));
void sp_factor ARGS((struct linsys *));
void stability_test ARGS((void));
void mobility_cleanup ARGS((void));
void mobility_mult ARGS((REAL*));
void mobility_setup ARGS((void));
void approx_curv_calc ARGS((int));
void approx_curvature ARGS((void));
int new_popverst ARGS((vertex_id,int));
void phase_initialize ARGS((char *));
void check_vertex_fe ARGS((vertex_id));
void information ARGS((void));
void show_volumes ARGS((void));
int set_parameters ARGS((void));
int minus_type ARGS((int));
void string_fixup ARGS((void));
void runge_kutta ARGS((void));
void autopop_init ARGS((void));
void autopop_cleanup ARGS((void));
void autopop_pop ARGS((void));
void autochop_chop ARGS((void));
void autopop_detect ARGS((REAL));
vertex_id find_other_vertex ARGS((vertex_id *,int,vertex_id));
void simplex_delaunay_test ARGS((void));
void push_face ARGS((vertex_id *));
int pop_face ARGS((vertex_id *));
void end_face_stack ARGS((void));
void init_face_stack ARGS((int));
int simplex_equiangulate ARGS((void));
void calc_simplex_edge_force ARGS((edge_id));
int kernel_basis ARGS((REAL**,REAL**,int,int));
int kernel_basis_rows ARGS((REAL**,REAL**,int,int));
void tr_mat_mul ARGS((REAL**,REAL**,REAL**,int,int,int));
void mat_mul_tr ARGS((REAL**,REAL**,REAL**,int,int,int));
void mat_tsquare ARGS((REAL**,REAL**,int,int));
void calc_simplex_edge_energy ARGS((edge_id));
void exterior_product ARGS((REAL **,REAL *,int,int));
int binom_coeff ARGS((int,int));
void hi_dim_graph ARGS((void));
void recalc ARGS((void));
void reset_conj_grad ARGS((void));
void kusner_energy ARGS((void));
void kusner_force ARGS((void));
void sqgauss_energy ARGS((void));
void sqgauss_force ARGS((void));
int prompt ARGS((char*,char*,int));
#ifdef USE_READLINE /* CSL */
void save_readline_history ARGS((void));
#endif
void update_display ARGS((void));
void local_update_display ARGS((void));
void set_spinr ARGS((REAL));
void set_spinl ARGS((REAL));
void set_tipup ARGS((REAL));
void set_tipdown ARGS((REAL));
void set_clockwise ARGS((REAL));
void set_counterclockwise ARGS((REAL));
void set_zoom ARGS((REAL));
void skinny_histogram ARGS((void));
int skinny ARGS((REAL));
int get_edge_valence ARGS((edge_id));
int get_facet_valence ARGS((edge_id));
void alice ARGS((void));
void sqcurve_force_string ARGS((vertex_id));
void sqcurve_force_string_end ARGS((void));
void sqcurve_energy_string ARGS((vertex_id));
void sqcurve_energy_string_init ARGS((void));
void bad_function ARGS((void));
void sqcurve_force_init ARGS((void));
void sqcurve_energy_init ARGS((void));
void sqcurve_energy ARGS((vertex_id*, REAL (*)[MAXCOORD]));
void sqcurve_force ARGS((vertex_id*,edge_id*,REAL(*)[MAXCOORD]));
void sqcurve_energy_end ARGS((void));
void sqcurve_force_end ARGS((void));
void top_dump ARGS((FILE *));
void bottom_dump ARGS((FILE *));
void vertex_dump ARGS((vertex_id,FILE *));
void edge_dump ARGS((edge_id,FILE *));
void facet_dump ARGS((facet_id,FILE *));
void facetedge_dump ARGS((facetedge_id,FILE *));
void body_dump ARGS((body_id,FILE *));
WRAPTYPE torus_inverse ARGS((WRAPTYPE));
WRAPTYPE torus_compose ARGS((WRAPTYPE,WRAPTYPE));
void torus_wrap ARGS((REAL *,REAL *,WRAPTYPE));
void torus_form_pullback ARGS((REAL *,REAL *,REAL *,WRAPTYPE));
WRAPTYPE group_inverse ARGS((WRAPTYPE));
WRAPTYPE group_compose ARGS((WRAPTYPE,WRAPTYPE));
void group_wrap ARGS((REAL *,REAL *,WRAPTYPE));
void group_form_pullback ARGS((REAL *,REAL *,REAL *,WRAPTYPE));
void print_matrix ARGS(( REAL **, int , int ));
REAL simplex_energy_metric ARGS((vertex_id*,REAL * *));
void simplex_force_metric ARGS((vertex_id *,REAL**, REAL,REAL **));
void gauss_setup ARGS((void));
void simplex_grad_l ARGS((void));
void end_hash_table ARGS((void));
void rehash ARGS((void));
void init_hash_table ARGS((void));
void check_orientation ARGS((struct simplex *,int));
void refine_simplex_init ARGS((void));
void refine_simplex ARGS((int,int *,struct divedge *,struct simplex *));
void refine_all_simplices ARGS((void));
vertex_id simplex_edge_divide ARGS((vertex_id,vertex_id));
int poponest ARGS((vertex_id,int));
void free_discards ARGS((int));
int find_vertex_to_pop ARGS((void));
void puff ARGS((void));
REAL splinepoly ARGS((int,REAL));
REAL splinederiv ARGS((int,REAL));
void spline_partial ARGS((int *,REAL,int,REAL *));
void spline_partial_t ARGS((int *,REAL,REAL *));
void dump_buff ARGS((char*,size_t));
int command ARGS((char *,int));
void newcommand ARGS((char *));
void new_history ARGS((char *));
int old_history ARGS((char *));
int qqparse ARGS((void));
#ifdef MEMSTRINGS
char *kb_calloc ARGS((size_t,size_t,char*,size_t));
char *KB_realloc ARGS((char*,size_t,char*,size_t));
char *kb_temp_calloc ARGS((size_t,size_t,char*,size_t));
char *kb_temp_realloc ARGS((char*,size_t,char*,size_t));
#else
char *kb_calloc ARGS((size_t,size_t));
char *KB_realloc ARGS((char*,size_t));
char *kb_temp_calloc ARGS((size_t,size_t));
char *kb_temp_realloc ARGS((char*,size_t));
#endif
void temp_free ARGS((char *));
void temp_free_all ARGS((void));
void cg_direction ARGS((void));
void cg_calc_gamma ARGS((void));
void simplex_facet_average ARGS((facet_id,int));
void facet_average ARGS((facet_id,int));
void edge_average ARGS((edge_id,int));
void recalc_verts ARGS((void));
void grule ARGS((int , REAL *, REAL *));
void read_facet_edges ARGS((void));
void read_faces ARGS((void));
void read_edges ARGS((void));
void read_vertices ARGS((void));
void read_bodies ARGS((void));
int read_quantity ARGS((void));
int read_const ARGS((REAL *));
void lowbound ARGS((void));
void ridge_histogram ARGS((void));
int collapse_check ARGS((void));
#ifndef TCPP
int vvvvcomp ARGS((struct vvvv *,struct vvvv *));
#endif
void End_OOGL ARGS((void ));
void End_geomview ARGS((void ));
void UpdateOOGL ARGS((void ));
void Begin_OOGL ARGS((void ));
void Begin_geomview ARGS((char*));
void softimage ARGS((void ));
void constraint_init ARGS((struct constraint *));
void constraint_free ARGS((struct constraint *));
REAL find_flux ARGS((facet_id));
int is_constant ARGS((int));
void free_expr ARGS((struct expnode *));
void perm_free_expr ARGS((struct expnode *));
void startup ARGS((char *));
void reset_view ARGS((void));
void read_parameter ARGS((void));
void read_transforms ARGS((int));
void zoom_vertex ARGS((vertex_id,REAL));
REAL distance ARGS((vertex_id,vertex_id));
void merge_collapsed_facets ARGS((void));
void constr_vol_grad_q ARGS((edge_id));
void homothety ARGS((void));
void ex_fold ARGS((struct treenode *));
void fold_recur ARGS((struct treenode *, int *));
int yybegin ARGS((void));
void yylex_init ARGS((void));
int yyerror ARGS((char *));
int yyparse ARGS((void));
int yylook ARGS((void));
int yywrap ARGS((void));
int yylex ARGS((void));
int yyreject ARGS((void));
int gettok ARGS((int));
int kb_input ARGS((void));
void rawunput ARGS((int));
int macro ARGS((void));
void record_macro ARGS((void));
void fe_reorder ARGS((edge_id));
void pix_start ARGS((void));
void pix_facet ARGS((struct graphdata *,facet_id));
void pix_end ARGS((void));
void constr_edge_force_q ARGS((edge_id));
void restore_vertex ARGS((vertex_id,struct oldcoord *,int));
REAL normal_change_check ARGS((void));
FILE *path_open ARGS((char *,int));
void fil_finish ARGS((void));
void fil_facet ARGS((struct tsort *));
void fil_edge ARGS((struct tsort *));
void fil_init ARGS((void));
void ps_finish ARGS((void));
void ps_facet ARGS((struct tsort *));
void ps_edge ARGS((struct tsort *));
void ps_init ARGS((void));
void display_file ARGS((int));
void graph_help ARGS((void));
void main_help ARGS((void));
REAL edge_grav_density ARGS((edge_id));
int facet_body_check ARGS((void));
int facetedge_check ARGS((int));
int list_check ARGS((void));
int run_checks ARGS((void));
int pop_vertex ARGS((vertex_id,int));
int kraynik_pop ARGS((vertex_id,int));
int popfilm ARGS((void));
void face_triangulate ARGS((facet_id,int));
void file_wulff ARGS((REAL *,REAL *));
void lens_wulff ARGS((REAL *,REAL *));
void hemi_wulff ARGS((REAL *,REAL *));
int curtest_facet ARGS((facet_id));
int curtest_edge ARGS((edge_id,facetedge_id,facetedge_id));
void curtest ARGS((void));
void fix_volconst ARGS((void));
element_id upgrade ARGS((element_id));
facet_id dup_facet ARGS((facet_id));
body_id dup_body ARGS((body_id));
REAL estimate_decrease ARGS((void));
void constr_edge_content_q ARGS((edge_id));
void constr_edge_energy_q ARGS((edge_id));
void tordup ARGS((int));
void add_outside ARGS((void));
REAL calc_content ARGS((int));
void local_calc_content ARGS((int));
int equal_constr ARGS((element_id ,element_id));
void bdry_spring_energy ARGS((edge_id));
void constr_spring_energy ARGS((edge_id));
void torus_cells ARGS((void));
void torus_edge_clip ARGS((struct graphdata *,int ));
void torus_arc_clip ARGS((struct graphdata *,int ));
void null_function ARGS((void));
void diffuse ARGS((void));
int cone_analyze ARGS((struct verfacet *,int));
vertex_id dup_vertex ARGS((vertex_id));
edge_id dup_edge ARGS((edge_id));
void versplit ARGS((facetedge_id ,facetedge_id,int));
int try_prop ARGS((facetedge_id *, facetedge_id,int));
int edgepop_film ARGS((void));
char * print_express ARGS((struct expnode *,int));
void exprint_recur ARGS((struct treenode *,int));
char *kb_strstr ARGS((char *,char *));
int kb_stricmp ARGS((char *,char *));
int kb_strnicmp ARGS((char *,char *, int));
void kb_memmove ARGS((char *,char *,size_t));
int pixdump ARGS((void));
void constr_springs ARGS((edge_id));
void save_coords ARGS((struct oldcoord *,int));
void local_save_coords ARGS((struct oldcoord *,int));
void restore_coords ARGS((struct oldcoord *,int));
void local_restore_coords ARGS((struct oldcoord *,int));
void unsave_coords ARGS((struct oldcoord *,int));
void local_unsave_coords ARGS((struct oldcoord *,int));
void enforce_constraints ARGS((void));
void kb_strupr ARGS((char *));
void b_proj ARGS((struct boundary *,REAL *,REAL * *,int, vertex_id ));
void b_extrapolate ARGS((struct boundary *,REAL *,REAL *,REAL *,REAL *,
REAL *,vertex_id));
void bdry_force ARGS((edge_id ));
void calc_bdry_force_v ARGS((vertex_id ));
void calc_bdry_force_e ARGS((edge_id ));
void calc_bdry_energy_v ARGS((vertex_id ));
void calc_bdry_energy_e ARGS((edge_id ));
void calc_bdry_content_v ARGS((vertex_id ));
void calc_bdry_content_e ARGS((edge_id ));
void calc_force ARGS((void ));
void local_calc_force ARGS((void ));
void calc_energy ARGS((void));
void local_calc_energy ARGS((void));
void calc_pressure ARGS((void ));
void display ARGS((void ));
int constr_proj ARGS((int ,int ,struct constraint * *,REAL *,REAL *,
REAL *,int *,int,vertex_id));
int constr_proj_matrix ARGS(( vertex_id, REAL ** ));
int constr_proj_matrix_wall ARGS(( vertex_id, REAL ** ));
int project_v_constr ARGS((vertex_id,int,int ));
void calc_constr_force_v ARGS((vertex_id ));
void calc_constr_force_e ARGS((edge_id ));
void calc_constr_energy_v ARGS((vertex_id ));
void calc_constr_energy_e ARGS((edge_id ));
void calc_constr_content_v ARGS((vertex_id ));
void calc_constr_content_e ARGS((edge_id ));
void dump ARGS((void ));
void do_dump ARGS((char *));
REAL eval ARGS((struct expnode *,REAL *,element_id,struct eval_frame*));
void eval_all ARGS((struct expnode *,REAL *,int,REAL *,REAL *,element_id));
void eval_second ARGS((struct expnode *,REAL *,int,REAL *,REAL *,
REAL**,element_id));
REAL tree_eval ARGS((struct treenode *,REAL *));
REAL eval_deriv ARGS((struct expnode *,REAL *,int ));
REAL tree_eval_deriv ARGS((struct treenode *,REAL *,int ));
int exparse ARGS((int ,struct expnode *,int));
void calc_simplex_forces ARGS((facet_id));
void calc_simplex_energy ARGS((facet_id));
void calc_simplex_volume ARGS((facet_id));
void facet_force_l ARGS((facet_id ));
void facet_energy_l ARGS((facet_id,int));
void facet_force_l_hi_d ARGS((facet_id ));
void facet_energy_l_hi_d ARGS((facet_id));
void facet_volume_l ARGS((facet_id ));
void film_grad_l ARGS((void ));
void film_bdry_grad ARGS((void ));
void film_constr_grad ARGS((void ));
void facet_force_q ARGS((facet_id ));
void facet_energy_q ARGS((facet_id,int ));
void facet_volume_q ARGS((facet_id ));
void film_grad_q ARGS((void ));
REAL tq7_integral ARGS((REAL (*)(REAL,REAL)));
REAL intpoly6 ARGS((int ,REAL ,REAL ));
REAL intpoly6part ARGS((int ,int ,REAL ,REAL ));
REAL vintzf ARGS((REAL ,REAL ));
void vcoeff_init ARGS((void ));
void calc_volgrads ARGS((int));
void local_calc_volgrads ARGS((int));
void pressure_forces ARGS((void));
void calc_lagrange ARGS((void));
void lagrange_adjust ARGS((void));
int local_lagrange_adjust ARGS((void));
void volume_restore ARGS((REAL,int));
void local_volume_restore ARGS((REAL,int));
int graphgen ARGS((void ));
void plain_facets ARGS((void ));
void plain_edges ARGS((void ));
void bare_edges ARGS((void ));
void triple_edges ARGS((void ));
void torus_clip ARGS((struct graphdata *,int, facet_id ));
int bfcomp ARGS((struct bodyface *,struct bodyface *));
void torus_bodies ARGS((void ));
void reset_web ARGS((void ));
void initialize ARGS((void));
void read_periods ARGS((void ));
void read_display_periods ARGS((void ));
void wulff_initialize ARGS((char *));
int read_boundary ARGS((void));
int read_constraint ARGS((void));
void read_surface_energy ARGS((void));
void iterate ARGS((void ));
void fix_vertices ARGS((void ));
void move_vertices ARGS((int,REAL ));
void local_move_vertices ARGS((int,REAL ));
void jiggle ARGS((void ));
void element_id_jiggle ARGS((void ));
REAL gaussian ARGS((void ));
void nrerror ARGS((char *));
void matcopy ARGS((REAL * *,REAL * *,int ,int ));
REAL **perm_matrix2 ARGS((int,int));
#ifdef MEMSTRINGS
REAL * *kb_dmatrix ARGS((int ,int ,int ,int,char*,int ));
REAL * * * kb_dmatrix3 ARGS((int ,int ,int,char*,int ));
REAL * * * * kb_dmatrix4 ARGS((int ,int ,int, int,char*,int ));
REAL * *kb_temp_dmatrix ARGS((int ,int ,int ,int,char*,int ));
REAL * * * kb_temp_dmatrix3 ARGS((int ,int ,int,char*,int ));
REAL * * * * kb_temp_dmatrix4 ARGS((int ,int ,int, int,char*,int ));
#else
REAL * *kb_dmatrix ARGS((int ,int ,int ,int ));
REAL * * * kb_dmatrix3 ARGS((int ,int ,int ));
REAL * * * * kb_dmatrix4 ARGS((int ,int ,int, int ));
REAL * *kb_temp_dmatrix ARGS((int ,int ,int ,int ));
REAL * * * kb_temp_dmatrix3 ARGS((int ,int ,int ));
REAL * * * * kb_temp_dmatrix4 ARGS((int ,int ,int, int ));
#endif
REAL *** matrix3_reorder ARGS((REAL***,int,int,int));
int *ivector ARGS((int ,int ));
REAL *vector ARGS((int ,int ));
void free_ivector ARGS((int *,int ,int ));
void free_vector ARGS((REAL *,int ,int ));
void free_matrix ARGS((REAL * *));
void free_matrix3 ARGS((REAL * * *));
void free_matrix4 ARGS((REAL * * * *));
void free_temp_matrix ARGS((REAL * *));
void free_temp_matrix3 ARGS((REAL * * *));
void free_temp_matrix4 ARGS((REAL * * * *));
void vector_add ARGS((REAL*,REAL*,int));
void vector_add_smul ARGS((REAL*,REAL*,REAL,int));
void vector_sub ARGS((REAL*,REAL*,int));
void vnormal ARGS((REAL *,REAL *,REAL *,REAL *));
void cross_prod ARGS((REAL *,REAL *,REAL *));
REAL triple_prod ARGS((REAL *,REAL *,REAL *));
REAL dot ARGS((REAL *,REAL *,int ));
REAL dotf ARGS((float *,float *,int ));
REAL dotdf ARGS((REAL *,float *,int ));
void matvec_mul ARGS((REAL * *,REAL *,REAL *,int ,int ));
void vec_mat_mul ARGS((REAL *,REAL ** ,REAL *,int ,int ));
void mat_mult ARGS((REAL * *,REAL * *,REAL * *,int ,int ,int ));
REAL quadratic_form ARGS((REAL *,REAL **,REAL *,int));
int mat_inv ARGS((REAL * *,int ));
int mat_inv_sym ARGS((REAL * *,int ));
int mat_inv_sparse ARGS((REAL * *,int ));
REAL determinant ARGS((REAL * *,int ));
REAL det_adjoint ARGS((REAL * *,int ));
void change_model ARGS((void ));
void linear_to_quad ARGS((void ));
void quad_to_linear ARGS((void ));
edge_id edge_divide ARGS((edge_id ));
void cross_cut ARGS((facetedge_id ,facetedge_id ));
void painter_start ARGS((void ));
void painter_facet ARGS((struct graphdata *,facet_id ));
void painter_end ARGS((void ));
int in_back ARGS((struct tsort *,struct tsort *));
int separating_plane ARGS((struct tsort *,struct tsort *,int));
int separating_line ARGS((struct tsort *,struct tsort *));
void painter_edge ARGS((struct graphdata *,edge_id));
int verpop_film ARGS((void ));
void do_save ARGS((void ));
void do_restore ARGS((void ));
int odd4cone_pop ARGS((vertex_id,int));
void set_facet_fe ARGS((facet_id ,facetedge_id ));
vertex_id new_vertex ARGS((REAL *,element_id));
edge_id new_edge ARGS((vertex_id ,vertex_id,element_id ));
facet_id new_facet ARGS((void ));
body_id new_body ARGS((void ));
facetedge_id new_facetedge ARGS((facet_id ,edge_id ));
REAL get_edge_length ARGS((edge_id ));
REAL get_facet_pressure ARGS((facet_id ));
#ifndef elptr
struct element *elptr ARGS((element_id ));
#endif
void extend ARGS((int,int));
void expand ARGS((int,int ));
void unfree_element ARGS((element_id));
int generate_all ARGS((int ,element_id *,element_id *));
void memory_report ARGS((void ));
void reset_skeleton ARGS((void ));
void vgrad_init ARGS((int ));
void vgrad_end ARGS((void ));
struct volgrad *get_vertex_vgrad ARGS((vertex_id));
void set_vertex_vgrad ARGS((vertex_id,struct volgrad*));
struct volgrad *get_next_vgrad ARGS((struct volgrad *));
struct volgrad *new_vgrad ARGS((void ));
struct volgrad *get_bv_vgrad ARGS((int ,vertex_id ));
struct volgrad *get_bv_new_vgrad ARGS((int ,vertex_id ));
element_id new_element ARGS((int,element_id,element_id));
void free_element ARGS((element_id ));
void edge_force_l ARGS((edge_id ));
void edge_energy_l ARGS((edge_id ));
void edge_area_l ARGS((edge_id ));
void edge_force_l_metric ARGS((edge_id ));
void edge_energy_l_metric ARGS((edge_id ));
void edge_force_q_metric ARGS((edge_id ));
void edge_energy_q_metric ARGS((edge_id ));
void string_grad_l ARGS((void ));
void string_bdry_grad ARGS((void ));
void string_constr_grad ARGS((void ));
REAL interpoly ARGS((int ,REAL ));
REAL interpolyderiv ARGS((int ,REAL ));
void scoeff_init ARGS((void ));
void edge_force_q ARGS((edge_id ));
void edge_energy_q ARGS((edge_id ));
void edge_area_q ARGS((edge_id ));
void string_grad_q ARGS((void ));
void do_show ARGS((void ));
int view_transform ARGS((char *));
void init_view ARGS((void ));
void resize ARGS((void ));
int old_menu ARGS((char * ));
void extrapolate ARGS((void ));
void save ARGS((void ));
void restore ARGS((char *));
void torvol ARGS((void));
void torvol_project ARGS((int ));
void refine ARGS((void ));
void local_refine ARGS((void ));
int areaweed ARGS((REAL ));
void area_histogram ARGS((void ));
int edgeweed ARGS((REAL ));
void edge_histogram ARGS((void ));
int eliminate_edge ARGS((edge_id ));
void change_vertex ARGS((facetedge_id ,vertex_id ,vertex_id ,WRAPTYPE));
int articulate ARGS((REAL ));
edge_id edge_refine ARGS((edge_id ));
int equiangulate ARGS((void ));
int ridge_notcher ARGS((REAL ));
void outstring ARGS(( CONST char *));
void erroutstring ARGS((char *));
void getstring ARGS((char *,int));
void kb_error ARGS((int, char *,int ));
void catcher ARGS((int ));
void calc_edge ARGS((edge_id ));
void get_edge_side ARGS((edge_id ,REAL *));
void get_edge_adjust ARGS((edge_id ,REAL *));
REAL calc_vertex_normal ARGS((vertex_id,facetedge_id ,REAL *));
void calc_vertex_smooth_normal ARGS((vertex_id,facetedge_id ,REAL *));
int new_calc_vertex_normal ARGS((vertex_id,REAL **));
int project_vertex_normals ARGS(( vertex_id, REAL **, int ));
int simplex_vertex_normal ARGS((vertex_id,REAL **));
void get_edge_verts ARGS((edge_id ,REAL * *,WRAPTYPE*));
void get_facet_verts ARGS((facet_id ,REAL * *,WRAPTYPE*));
void get_facet_verts_special ARGS((facet_id ,REAL * *,WRAPTYPE*));
void get_facet_verts_q ARGS((facet_id ,REAL * *,WRAPTYPE*));
int verpop_str ARGS((void ));
void dump_force ARGS((void));
void vertex_average ARGS((int));
void hessian_menu ARGS((void));
void hessian_auto ARGS((void));
REAL hessian_seek ARGS((REAL));
REAL hessian_line_seek ARGS((struct linsys *,REAL,REAL*));
void set_facet_body ARGS((facet_id ,body_id ));
int makenode ARGS((NTYPE,NTYPE,NTYPE));
void set_body_fixvol ARGS((body_id,REAL));
facet_id get_next_body_facet ARGS((facet_id));
facet_id get_prev_body_facet ARGS((facet_id));
void set_next_vertex_facet ARGS((vertex_id,facet_id,facet_id));
void set_next_body_facet ARGS((facet_id,facet_id));
void set_prev_body_facet ARGS((facet_id,facet_id));
void set_fe_facet ARGS((facetedge_id ,facet_id ));
#if !defined (INLINE)
/* some functions replaced by macros in serial version */
int get_meth_offset ARGS((int));
char *get_extra ARGS((element_id,int));
char *get_extra_ptr ARGS((element_id,struct extra *));
void set_body_volconst ARGS((body_id,REAL));
void set_fe_edge ARGS((facetedge_id ,edge_id ));
facet_id get_fe_facet ARGS((facetedge_id ));
facetedge_id get_prev_facet ARGS((facetedge_id ));
facetedge_id get_next_facet ARGS((facetedge_id ));
void set_prev_edge ARGS((facetedge_id ,facetedge_id ));
void set_next_edge ARGS((facetedge_id ,facetedge_id ));
void set_prev_facet ARGS((facetedge_id ,facetedge_id ));
void set_next_facet ARGS((facetedge_id ,facetedge_id ));
void set_edge_wrap ARGS((edge_id ,WRAPTYPE ));
WRAPTYPE get_edge_wrap ARGS((edge_id ));
void set_edge_fe ARGS((edge_id ,facetedge_id ));
facetedge_id get_edge_fe ARGS((edge_id ));
void set_edge_tailv ARGS((edge_id ,vertex_id ));
void set_edge_headv ARGS((edge_id ,vertex_id ));
void set_edge_midv ARGS((edge_id ,vertex_id ));
body_id get_facet_body ARGS((facet_id ));
facetedge_id get_facet_fe ARGS((facet_id ));
void set_attr ARGS((element_id ,ATTR ));
void unset_attr ARGS((element_id ,ATTR ));
edge_id get_fe_edge ARGS((facetedge_id));
facetedge_id get_prev_edge ARGS((facetedge_id ));
facetedge_id get_next_edge ARGS((facetedge_id ));
vertex_id get_edge_tailv ARGS((edge_id ));
vertex_id get_edge_headv ARGS((edge_id ));
edge_id get_next_tail_edge ARGS((edge_id));
edge_id get_next_head_edge ARGS((edge_id));
void set_next_tail_edge ARGS((edge_id,edge_id));
facetedge_id get_body_fe ARGS((body_id));
facetedge_id get_body_facet ARGS((body_id));
void set_body_facet ARGS((body_id,facetedge_id));
REAL get_body_density ARGS((body_id));
REAL get_body_abstotal ARGS((body_id));
REAL get_body_volume ARGS((body_id));
REAL get_body_fixvol ARGS((body_id));
REAL get_body_pressure ARGS((body_id));
REAL get_body_volconst ARGS((body_id));
void set_body_density ARGS((body_id,REAL));
void set_body_pressure ARGS((body_id,REAL));
facetedge_id get_vertex_fe ARGS((vertex_id));
#endif
#ifdef __cplusplus
}
#endif
evolver-2.30c.dfsg/src/express.h 0000644 0001753 0001753 00000065262 11410765113 017072 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/********************************************************************
*
* File: express.h
*
* Contents: defines for expression parsing and evaluation.
*/
#ifdef __cplusplus
extern "C" {
#endif
/* node types, numbered above 1512 to avoid yacc token numbers */
#define GEN_ERROR_TOKEN 10000
#define IMMEDIATE_AUTOPOP_ 2337
#define PROCEDURE_CALL_RETURN_ 2336
#define FUNCTION_CALL_RETURN_ 2335
#define SETUP_FRAME_ 2334
#define CONTENT_RANK_ 2333
#define SLICE_COEFF 2332
#define CLIP_COEFF 2331
#define AUTOPOP_QUARTIC_ 2330
#define STAR_FINAGLING_ 2329
#define FORCE_DELETION_ 2328
#define DEFINE_FIXED_LOCAL_ARRAY_ 2327
#define ARRAY_VERTEX_NORMAL_ 2326
#define ARRAY_EDGE_VECTOR_ 2325
#define ARRAY_FACET_NORMAL_ 2324
#define PRINT_ARRAY_LVALUE_ 2323
#define ARRAY_EVAL_ 2322
#define PRINT_PROFILING_ 2321
#define ARRAY_ASSIGNOP_FACET_NORMAL_ 2320
#define ARRAY_ASSIGNOP_EDGE_VECTOR_ 2319
#define ARRAY_ASSIGNOP_VERTEX_NORMAL_ 2318
#define ARRAY_ASSIGNOP_SINGLE_ 2317
#define ARRAY_LVALUE_INDEXED_ 2316
#define ATTRIB_LVALUE_ 2315
#define ARRAY_RVALUE_ 2314
#define ARRAY_ASSIGNOP_ARRAY_ 2312
#define ARRAY_ASSIGNOP_SCALAR_ 2311
#define ARRAY_ASSIGNOP_S_X_A_ 2310
#define ARRAY_ASSIGNOP_A_P_A_ 2309
#define ARRAY_ASSIGNOP_A_S_A_ 2308
#define V_HIGH_BOUNDARY 2307
#define V_HIGH_CONSTRAINT 2306
#define LOCAL_LIST_START_ 2305
#define CLIP_VIEW_ 2304
#define V_STRING_CURVE_TOLERANCE 2303
#define TEXT_SPOT_ 2302
#define WHEREAMI_COMMAND_ 2301
#define UNSET_BREAKPOINT_ 2300
#define SET_BREAKPOINT_ 2299
#define PUSH_PARAM_FIXED 2298
#define V_CORONA_STATE 2297
#define PUSH_ELEMENT_ID_ 2296
#define ELINDEX_ 2295
#define SET_CONSTRAINT_GLOBAL 2294
#define UNSET_CONSTRAINT_GLOBAL 2293
#define SET_CONSTRAINT_NAME_GLOBAL 2292
#define UNSET_CONSTRAINT_NAME_GLOBAL 2291
#define FUNCTION_QUANTITY_SPARSE_ 2290
#define SLICE_VIEW_ 2289
#define V_MPI_MAXTASK 2288
#define DISPLAY_ORIGIN_ 2287
#define V_AUTOCHOP_LENGTH 2286
#define QUIETLOAD_ 2285
#define LITTLE_ENDIAN_ 2284
#define BIG_ENDIAN_ 2283
#define BINARY_PRINTFHEAD_ 2282
#define V_FACET_REVERSE_COUNT 2281
#define V_EDGE_REVERSE_COUNT 2280
#define V_THIS_TASK 2279
#define POP_ENJOIN_ 2278
#define V_WINDOW_ASPECT_RATIO 2277
#define PRINT_SINGLE_LETTER_ 2276
#define PDELTA_LVALUE_ 2275
#define PSCALE_LVALUE_ 2274
#define INIT_VERTEX_EDGE_ 1513
#define INIT_VERTEX_FACET_ 1514
#define INIT_VERTEX_BODY_ 1515
#define INIT_EDGE_VERTEX_ 1516
#define INIT_EDGE_FACET_ 1517
#define INIT_EDGE_BODY_ 1518
#define INIT_FACET_VERTEX_ 1519
#define INIT_FACET_EDGE_ 1520
#define INIT_FACET_BODY_ 1521
#define INIT_BODY_VERTEX_ 1522
#define INIT_BODY_EDGE_ 1523
#define INIT_BODY_FACET_ 1524
#define NEXT_VERTEX_EDGE_ 1525
#define NEXT_VERTEX_FACET_ 1526
#define NEXT_VERTEX_BODY_ 1527
#define NEXT_EDGE_VERTEX_ 1528
#define NEXT_EDGE_FACET_ 1529
#define NEXT_EDGE_BODY_ 1530
#define NEXT_FACET_VERTEX_ 1531
#define NEXT_FACET_EDGE_ 1532
#define NEXT_FACET_BODY_ 1533
#define NEXT_BODY_VERTEX_ 1534
#define NEXT_BODY_EDGE_ 1535
#define NEXT_BODY_FACET_ 1536
#define NEXT_VERTEX_ 1537
#define NEXT_EDGE_ 1538
#define NEXT_FACET_ 1539
#define NEXT_BODY_ 1540
#define NEXT_ELEMENT_ 1541
#define INIT_VERTEX_ 1542
#define INIT_EDGE_ 1543
#define INIT_FACET_ 1544
#define INIT_BODY_ 1545
#define INIT_ELEMENT_ 1546
#define SET_GRAVITY_ 1547
#define SET_DIFFUSION_ 1548
#define SET_GLOBAL_ 1549
#define SET_COLOR_ 1550
#define SET_DENSITY_ 1551
#define SET_PRESSURE_ 1552
#define SET_VOLUME_ 1553
#define SET_CONSTRAINT_ 1554
#define SET_TAG_ 1555
#define SET_OPACITY_ 1556
#define SET_SCALE_ 1557
#define SET_COORD_ 1558
#define SET_COORD_1 1559
#define SET_COORD_2 1560
#define SET_COORD_3 1561
#define SET_COORD_4 1562
#define SET_COORD_5 1563
#define SET_COORD_6 1564
#define SET_COORD_7 1565
#define SET_COORD_8 1566
#define SET_PROCEDURE_ 1567
#define SET_PROC_END_ 1568
#define SET_AUTOCHOP_ 1570
#define SET_GAP_CONSTANT_ 1571
#define SET_AMBIENT_PRESSURE_ 1572
#define SET_FIXED_AREA_ 1573
#define SET_COLORMAP_ 1574
#define SET_THICKEN_ 1575
#define SET_BACKGROUND_ 1576
#define SET_OPTIMIZE_ 1577
#define SET_FIXED_ 1578
#define GET_FIXED_ 1579
#define GET_LENGTH_ 1580
#define GET_VALENCE_ 1581
#define GET_AREA_ 1582
#define GET_VOLUME_ 1583
#define GET_DENSITY_ 1584
#define GET_ID_ 1585
#define GET_TAG_ 1586
#define GET_ORIGINAL_ 1587
#define INIT_AVG_ 1588
#define INIT_SUM_ 1589
#define INIT_MAX_ 1590
#define INIT_MIN_ 1591
#define INIT_COUNT_ 1592
#define AGGREGATE_INIT_ 1593
#define AGGREGATE_END_ 1594
#define AGGREGATE_ 1595
#define SET_INIT_ 1596
#define UNSET_CONSTRAINT_ 1597
#define UNSET_BOUNDARY_ 1598
#define GET_COLOR_ 1599
#define GET_SQ_MEAN_CURV_ 1600
#define GET_INTERNAL_ 1601
#define V_VERTEXCOUNT 1602
#define V_EDGECOUNT 1603
#define V_FACETCOUNT 1604
#define V_BODYCOUNT 1605
#define V_FACETEDGECOUNT 1606
#define V_ENERGY 1607
#define V_AREA 1608
#define V_LENGTH 1609
#define V_SCALE 1610
#define LIST_PROCS_ 1611
#define PRINTFHEAD_ 1612
#define PREPRINTF_ 1613
#define EXPRLIST_ 1614
#define SPRINTFHEAD_ 1615
#define SET_SGLOBAL_ 1616
#define GET_OID_ 1617
#define GET_FRONTCOLOR_ 1618
#define GET_BACKCOLOR_ 1619
#define SET_FRONTCOLOR_ 1620
#define SET_BACKCOLOR_ 1621
#define SET_PARAM_ 1622
#define SET_PARAM_1 1623
#define SET_PARAM_2 1624
#define SET_PARAM_3 1625
#define SET_PARAM_4 1626
#define SET_PARAM_5 1627
#define SET_PARAM_6 1628
#define SET_PARAM_7 1629
#define SET_ATTRIBUTE_ 1630
#define SET_PHASE_ 1631
#define GET_PHASE_ 1632
#define LEXERROR 1633
#define PRESPRINTF_ 1634
#define V_SURFACE_DIMENSION 1635
#define V_SPACE_DIMENSION 1636
#define TOGGLEVALUE 1637
#define V_TORUS 1638
#define V_TORUS_FILLED 1639
#define V_SYMMETRY_GROUP 1640
#define V_SIMPLEX 1641
#define V_INTEGRAL_ORDER 1642
#define GET_STAR_ 1643
#define GET_PRESSURE_ 1644
#define SET_INTERNAL_ 1645
#define V_TOLERANCE 1646
#define AUTODISPLAY_ 1647
#define V_EQUI_COUNT 1648
#define V_DELETE_COUNT 1650
#define V_REFINE_COUNT 1651
#define V_NOTCH_COUNT 1652
#define V_DISSOLVE_COUNT 1653
#define V_POP_COUNT 1654
#define V_WHERE_COUNT 1655
#define PUSH_NAMED_QUANTITY 1656
#define SET_NAMED_QUANTITY_ 1657
#define GET_USERATTR_ 1658
#define GET_QUANTITY_ 1659
#define UNSET_NAMED_QUANTITY_ 1660
#define GET_WRAP_ 1661
#define FINISHED 1701
#define PUSHCONST 1702
#define PUSHPARAM 1703
#define PUSHPI 1704
#define PUSHE 1705
#define PLUS 1706
#define MINUS 1707
#define TIMES 1708
#define DIVIDE 1709
#define INTPOW 1710
#define POW 1711
#define SIN 1712
#define COS 1713
#define TAN 1714
#define SQRT 1715
#define LOG 1716
#define EXP 1717
#define COPY 1718
#define ACOS 1719
#define ASIN 1720
#define ATAN 1721
#define CHS 1722
#define INV 1723
#define SQR 1724
#define PUSHG 1725
#define EQUATE 1726
#define PUSHADJUSTABLE 1727
#define ABS 1728
#define USERFUNC 1729
#define REPEAT_ 1730
#define FULLEXPR 1731
#define SINH 1732
#define COSH 1733
#define REPLACECONST 1734
#define REALMOD 1735
#define CEIL_ 1736
#define FLOOR_ 1737
#define ATAN2_ 1738
#define NOP_ 1739
#define V_HESS_EPSILON 1740
#define HESSIAN_DIFF_ 1741
#define SHOW_INNER_ 1742
#define SHOW_OUTER_ 1743
#define CLIPPED_CELLS_ 1744
#define RAW_CELLS_ 1745
#define CONNECTED_CELLS_ 1746
#define NORMAL_MOTION_ 1747
#define RUNGE_KUTTA_ 1748
#define DETURCK_ 1749
#define KUSNER_ 1750
#define VIEW_4D_ 1751
#define CONF_EDGE_SQCURV_ 1752
#define SQGAUSS_ 1753
#define AUTOPOP_ 1754
#define OLD_AREA_ 1755
#define APPROX_CURV_ 1756
#define CHECK_INCREASE_ 1757
#define DEBUG_ 1758
#define MEMDEBUG_ 1759
#define EFFECTIVE_AREA_ 1760
#define ESTIMATE_ 1761
#define POST_PROJECT_ 1762
#define TRANSFORMS_ 1763
#define QUIET_ 1764
#define CONJ_GRAD_ 1765
#define HOMOTHETY_ 1766
#define FACET_COLORS_ 1767
#define SHADING_ 1768
#define DIV_NORMAL_CURVATURE_ 1769
#define NORMAL_CURVATURE_ 1770
#define BOUNDARY_CURVATURE_ 1771
#define SELF_SIMILAR_ 1772
#define GV_BINARY_ 1773
#define METRIC_CONVERSION_ 1774
#define AUTORECALC_ 1775
#define PINNING_ 1776
#define FORCE_POS_DEF_ 1777
#define V_SCALE_SCALE 1778
#define GET_EXTRA_ATTR_ 1779
#define SET_EXTRA_ATTR_ 1780
#define SET_ATTRIBUTE_LOOP_ 1781
#define SET_ATTRIBUTE_L 1782
#define TANH 1783
#define ATANH 1784
#define ASINH 1785
#define ACOSH 1786
#define V_ITER_COUNTER 1787
#define QUIETGO_ 1788
#define GET_MIDV_ 1789
#define RIBIERE_CG_ 1790
#define ASSUME_ORIENTED_ 1791
#define HESSIAN_QUIET_ 1792
#define CONJUNCTION_END 1793
#define JIGGLE_TOGGLE_ 1794
#define V_TIME 1795
#define V_JIG_TEMP 1796
#define SYMBOL_ELEMENT_ 1797
#define SINGLE_ELEMENT_ 1798
#define INDEXED_SUBTYPE_ 1799
#define INDEXED_ATTRIBUTE 1800
#define QUALIFIED_ATTRIBUTE 1801
#define STRPRINT_ 1802
#define GET_TRIPLE_PT_ 1804
#define SET_TRIPLE_PT_ 1805
#define GET_TETRA_PT_ 1806
#define SET_TETRA_PT_ 1807
#define UNSET_TETRA_PT_ 1808
#define UNSET_TRIPLE_PT_ 1809
#define PUSHQPRESSURE_ 1810
#define PUSHQTARGET_ 1811
#define PUSHQVALUE_ 1812
#define PUSHQMODULUS_ 1813
#define SET_QMODULUS_ 1814
#define SET_QTARGET_ 1815
#define YSMP_ 1816
#define BUNCH_KAUFMAN_ 1817
#define V_EIGENPOS 1818
#define V_EIGENNEG 1819
#define V_EIGENZERO 1820
#define QUANTITIES_ONLY_ 1821
#define EVERYTHING_QUANTITIES_ 1822
#define METRIC_CONVERT_ 1823
#define GET_TARGET_ 1824
#define MAXIMUM_ 1825
#define UNSET_FACET_BODY_ 1826
#define SET_ORIENTATION_ 1827
#define V_PICKVNUM 1828
#define V_PICKENUM 1829
#define V_PICKFNUM 1830
#define LINEAR_METRIC_ 1831
#define V_LINEAR_METRIC_MIX 1832
#define INVOKE_P_MENU_ 1833
#define GEOMVIEW_TOGGLE_ 1834
#define DO_TOP_ 1835
#define DO_END_ 1836
#define DO_ENTRY_ 1837
#define SET_MODEL_ 1838
#define V_RANDOM_SEED 1839
#define MINIMUM_ 1840
#define V_INTEGRAL_ORDER_1D 1841
#define V_INTEGRAL_ORDER_2D 1842
#define GET_ORIENTATION_ 1843
#define SET_TARGET_ 1844
#define UNSET_FIXED_ 1845
#define UNSET_DENSITY_ 1846
#define UNSET_VOLUME_ 1847
#define UNSET_PRESSURE_ 1848
#define UNSET_TARGET_ 1849
#define GET_VOLCONST_ 1850
#define SET_VOLCONST_ 1851
#define GET_TORUS_PERIODS_ 1852
#define PUSHQVOLCONST_ 1853
#define GET_FIXEDVOL_ 1854
#define SET_QVOLCONST_ 1855
#define SET_QPARAMETER_1_ 1856
#define PUSHQPARAMETER_1_ 1857
#define SINGLE_ELEMENT_INIT_ 1858
#define REDEFINE_SINGLE_ 1859
#define UNREDEFINE_SINGLE_ 1860
#define V_QUADRATIC_METRIC_MIX 1861
#define GEOMPIPE_TOGGLE_ 1862
#define V_LAST_EIGENVALUE 1863
#define V_LAST_HESSIAN_SCALE 1864
#define SQUARED_GRADIENT_ 1865
#define PRINT_LETTER_ 1866
#define REDIRECT_END_ 1867
#define PIPE_END_ 1868
#define V_LAGRANGE_ORDER 1869
#define SET_AXIAL_POINT_ 1870
#define UNSET_AXIAL_POINT_ 1871
#define GET_AXIAL_POINT_ 1872
#define H_INVERSE_METRIC_ 1873
#define HELP_KEYWORD 1874
#define SKINNY_ 1875
#define TORDUP_ 1876
#define V_GAP_CONSTANT 1877
#define V_THICKNESS 1878
#define V_TARGET_TOLERANCE 1879
#define V_CLOCK 1880
#define FIX_QUANTITY_ 1881
#define UNFIX_QUANTITY_ 1882
#define SET_ORIGINAL_ 1883
#define V_SCALE_LIMIT 1884
#define SET_MMODULUS_ 1885
#define GET_INSTANCE_ 1886
#define PUSHMMODULUS_ 1887
#define PUSHMVALUE_ 1888
#define PSCOLORFLAG_ 1889
#define GRIDFLAG_ 1890
#define CROSSINGFLAG_ 1891
#define LABELFLAG_ 1892
#define SHOW_ALL_QUANTITIES_ 1893
#define GET_INVERSE_PERIODS_ 1894
#define CREATE_EDGE_ 1895
#define SET_NO_REFINE_ 1896
#define UNSET_NO_REFINE_ 1897
#define GET_NO_REFINE_ 1898
#define CREATE_VERTEX_ 1899
#define CREATE_FACET_ 1900
#define CREATE_BODY_ 1901
#define SET_FRONTBODY_ 1902
#define SET_BACKBODY_ 1903
#define V_TRANSFORM_COUNT 1904
#define GT_ 1905
#define LT_ 1906
#define GET_BACKBODY_ 1907
#define GET_FRONTBODY_ 1908
#define GET_TRANSFORM_EXPR_ 1909
#define LOGFILE_TOGGLE_ 1910
#define SET_WRAP_ 1911
#define PLUSASSIGN_ 1912
#define SUBASSIGN_ 1913
#define MULTASSIGN_ 1914
#define DIVASSIGN_ 1915
#define NULLBLOCK_ 1916
#define SINGLE_ASSIGN_ 1917
#define SET_ATTRIBUTE_A 1918
#define SET_METHOD_INSTANCE_ 1919
#define UNSET_METHOD_INSTANCE_ 1920
#define PUSH_METHOD_INSTANCE_ 1921
#define LIST_ATTRIBUTES_ 1922
#define NULLCMD_ 1923
#define FIX_PARAMETER_ 1924
#define UNFIX_PARAMETER_ 1925
#define ITDEBUG_ 1926
#define ZENER_DRAG_ 1927
#define VOLGRADS_EVERY_ 1928
#define V_RANDOM 1929
#define PUSHQTOLERANCE_ 1930
#define SET_QTOLERANCE_ 1931
#define PUSHDELTA_ 1932
#define SET_DELTA_ 1933
#define BACKCULL_ 1934
#define V_BRIGHTNESS 1935
#define V_DIFFUSION 1936
#define DEFINE_IDENT_ 1937
#define V_BACKGROUND 1938
#define SET_NO_DISPLAY_ 1939
#define UNSET_NO_DISPLAY_ 1940
#define GET_NO_DISPLAY_ 1941
#define V_MEMARENA 1942
#define V_MEMUSED 1943
#define INDEXED_COORD_ 1944
#define V_LAST_ERROR 1945
#define VERBOSE_ 1946
#define ACOMMANDEXPR_ 1947
#define CMDLIST_ 1948
#define ULONG_TYPE_ 1949
#define INDEXED_ELEMENT_ 1950
#define MEAN_CURV_ 1951
#define REPEAT_INIT_ 1952
#define SYMATTR_ 1953
#define INIT_SUBELEMENT_ 1954
#define GET_DIHEDRAL_ 1955
#define INIT_FACETEDGE_ 1956
#define GET_EDGE_ 1957
#define GET_FACET_ 1958
#define NEXT_FACETEDGE_ 1959
#define PUSHGLOBAL_ 1960
#define COMMAND_BLOCK_ 1961
#define IFTEST_ 1962
#define WHILE_TOP_ 1963
#define WHILE_END_ 1964
#define PRINT_PROCEDURE_ 1965
#define SHOW_END_ 1966
#define AMBIENT_PRESSURE_ 1967
#define INTERP_NORMALS_ 1969
#define MEAN_CURV_INT_ 1970
#define COND_TEST_ 1971
#define COND_EXPR_ 1972
#define COND_ELSE_ 1973
#define BACKGROUND_ 1974
#define V_AMBIENT_PRESSURE 1975
#define V_HESSIAN_SLANT_CUTOFF 1976
#define WRAP_COMPOSE_ 1977
#define WRAP_INVERSE_ 1978
#define GET_VERTEXNORMAL_ 1979
#define SET_VIEW_MATRIX_ 1980
#define VIEW_MATRIX_LVALUE_ 1981
#define ACTUAL_VOLUME_ 1982
#define SELF_ELEMENT_ 1983
#define UNSET_FRONTBODY_ 1984
#define UNSET_BACKBODY_ 1985
#define V_CHECK_COUNT_ 1986
#define V_BREAKFLAG_ 1987
#define SET_CONSTRAINT_NAME 1988
#define UNSET_CONSTRAINT_NAME 1989
#define SET_BOUNDARY_NAME 1990
#define UNSET_BOUNDARY_NAME 1991
#define ON_CONSTRAINT_NAME 1992
#define HIT_CONSTRAINT_NAME 1993
#define ON_BOUNDARY_NAME 1994
#define SET_PARAM_SCALE 1995
#define PUSH_PARAM_SCALE 1996
#define EXPRINT_PROCEDURE_ 1997
#define ERRPRINTFHEAD_ 1998
#define INDEXSET_ 1999
#define DEFINE_ARRAY_ 2000
#define ARRAYEVAL 2001
#define ARRAYASSIGN 2002
#define ARRAY_HEAD_ 2003
#define VIEW_TRANSFORMS_NOP_ 2004
#define VIEW_TRANSFORMS_ELEMENT_ 2005
#define GET_SHOW_ 2006
#define ATTR_FUNCTION_ 2007
#define ATTR_FUNCTION_END_ 2008
#define SET_Q_FIXED_ 2009
#define SET_Q_ENERGY_ 2010
#define SET_Q_INFO_ 2011
#define SET_Q_CONSERVED_ 2012
#define KEYLOGFILE_TOGGLE_ 2013
#define ELLIPTICE 2014
#define ELLIPTICK 2015
#define INCOMPLETE_ELLIPTICF 2016
#define INCOMPLETE_ELLIPTICE 2017
#define V_VISIBILITY_DEBUG_ 2018
#define V_SCROLLBUFFERSIZE_ 2019
#define PUSH_PARAM_EXTRA_ 2020
#define PRINT_ARRAY_ 2021
#define SET_BARE_ 2022
#define GET_BARE_ 2023
#define UNSET_BARE_ 2024
#define V_PS_STRINGWIDTH_ 2025
#define V_PS_FIXEDEDGEWIDTH_ 2026
#define V_PS_TRIPLEEDGEWIDTH_ 2027
#define V_PS_CONEDGEWIDTH_ 2028
#define V_PS_BAREEDGEWIDTH_ 2029
#define V_PS_GRIDEDGEWIDTH_ 2030
#define SET_NONCONTENT_ 2031
#define UNSET_NONCONTENT_ 2032
#define GET_NONCONTENT_ 2033
#define BACKQUOTE_START_ 2034
#define BACKQUOTE_END_ 2035
#define DEFINE_EXTRA_INDEX_ 2036
#define FOR_END_ 2037
#define FOR_HEAD_ 2038
#define FOR_TOP_ 2039
#define FOR_ENTRY_ 2040
#define SET_PERM_GLOBAL_ 2041
#define SET_PERM_SGLOBAL_ 2042
#define PUSH_PERM_GLOBAL_ 2043
#define SET_PERM_PROCEDURE_ 2044
#define PUSH_PERM_GLOBAL 2045
#define PRINT_PERM_PROCEDURE_ 2046
#define SET_PERM_PROC_END_ 2047
#define DIMENSIONSET_ 2048
#define PRINT_ARRAYPART_ 2049
#define DECLARE_LOCAL_ 2050
#define FUNCTION_HEAD_ 2051
#define ARGLIST_ 2052
#define SET_FUNCTION_ 2053
#define SET_FUNC_END_ 2054
#define FUNCTION_START_ 2055
#define FUNCTION_DEF_START_ 2056
#define FUNCTION_EXIT_ 2057
#define FUNCTION_CALL_ 2058
#define FUNCTION_PROTO_START_ 2059
#define FUNCTION_PROTO_ 2060
#define SET_ARGSPROC_ 2061
#define SET_ARGSPROC_END_ 2062
#define PROCEDURE_START_ 2063
#define PROCEDURE_DEF_START_ 2064
#define PROCEDURE_EXIT_ 2065
#define PROCEDURE_CALL_ 2066
#define PROCEDURE_PROTO_START_ 2067
#define PROCEDURE_PROTO_ 2068
#define PROCEDURE_HEAD_ 2069
#define PRINT_ATTR_ARRAY_ 2070
#define PRINT_VERTEXNORMAL_ 2071
#define SIZEOF_ATTR_ 2072
#define SIZEOF_ARRAY_ 2073
#define SIZEOF_STRING_ 2074
#define BEZIER_BASIS_ 2075
#define GET_MEANCURV_ 2076
#define DEFINE_EXTRA_ 2077
#define SET_BOUNDARY_ 2078
#define GET_HIT_PARTNER_ 2079
#define SET_HIT_PARTNER_ 2080
#define UNSET_HIT_PARTNER_ 2081
#define DEFINE_QUANTITY_ 2082
#define DEFINE_METHOD_INSTANCE_ 2083
#define PUSHQFIXED_ 2084
#define PUSHQENERGY_ 2085
#define PUSHQINFO_ONLY_ 2086
#define PUSHQCONSERVED_ 2087
#define SMOOTH_GRAPH_ 2088
#define MPI_DEBUG_ 2089
#define GET_MPI_TASK_ 2090
#define POP_DISJOIN_ 2091
#define DEFINE_CONSTRAINT_ 2092
#define DEFINE_BOUNDARY_ 2093
#define V_DIFFUSION_ 2094
#define V_VERTEX_DISSOLVE_COUNT 2095
#define V_EDGE_DISSOLVE_COUNT 2096
#define V_FACET_DISSOLVE_COUNT 2097
#define V_BODY_DISSOLVE_COUNT 2098
#define V_EDGE_REFINE_COUNT 2099
#define V_FACET_REFINE_COUNT 2100
#define V_VERTEX_POP_COUNT 2101
#define V_EDGE_POP_COUNT 2102
#define V_POP_TRI_TO_EDGE_COUNT 2104
#define V_POP_EDGE_TO_TRI_COUNT 2105
#define V_POP_QUAD_TO_QUAD_COUNT 2106
#define V_EDGESWAP_COUNT 2107
#define V_T1_EDGESWAP_COUNT 2108
#define V_SKINNY_REFINE_COUNT 2109
#define V_VERTEX_DELETE_COUNT 2110
#define V_EDGE_DELETE_COUNT 2111
#define V_FACET_DELETE_COUNT 2112
#define V_BODY_DELETE_COUNT 2113
#define V_FIX_COUNT 2114
#define V_UNFIX_COUNT 2115
#define V_PS_LABELSIZE_ 2116
#define V_CPU_COUNTER 2117
#define GET_MID_EDGE_ 2118
#define GET_MID_FACET_ 2119
#define INIT_FACETEDGE_EDGE_ 2120
#define INIT_FACETEDGE_FACET_ 2121
#define NEXT_FACETEDGE_EDGE_ 2122
#define NEXT_FACETEDGE_FACET_ 2123
/* stuff transferred over from lex.h */
#define NO_TOKEN 0
#define WULFF_ 2257
#define PERIODS_ 2256
#define TORUS_ 2252
#define TORUS_FILLED_ 2251
#define SOAPFILM_ 2249
#define MOBILITY_ 2248
#define MOBILITY_TENSOR_ 2247
#define ENVECT_ 2245
#define CONVECT_ 2244
#define MERITFACTOR_ 2243
#define GRAV_CONST_ 2242
#define SPRING_CONSTANT_ 2241
#define TEMPERATURE_ 2239
#define FACES_ 2237
#define CONVEX_ 2230
#define NONNEGATIVE_ 2229
#define NONPOSITIVE_ 2228
#define PARAMETERS_ 2227
#define CONTENT_ 2222
#define BCOORD_ 2219
#define SURFACE_ENERGY_ 2216
#define SYMMETRIC_CONTENT_ 2215
#define SCALE_LIMIT_ 2214
#define CONSTRAINT_TOLERANCE_ 2211
#define ZOOM_VERTEX_ 2210
#define ZOOM_RADIUS_ 2209
#define QVECT_ 2206
#define SPACE_DIMENSION_ 2205
#define SURFACE_DIMENSION_ 2204
#define SIMPLEX_REP_ 2203
#define METRIC_ 2202
#define SYMMETRY_GROUP_ 2201
#define UNKNOWN 2199
#define CONFORMAL_ 2198
#define SQUARE_CURVATURE_ 2197
#define PARAMETER_FILE_ 2196
#define TOTAL_TIME_ 2191
#define PHASEFILE_ 2190
#define KLEIN_METRIC_ 2187
#define GLOBAL_METHOD_ 2185
#define EFIXED_ 2184
#define VIEW_TRANSFORM_GENS_ 2182
#define GAUSS_CURVATURE_ 2181
#define INSULATING_KNOT_ENERGY_ 2179
#define CONDUCTING_KNOT_ENERGY_ 2178
#define METHOD_ 2177
#define NONWALL_ 2176
#define SCALAR_INTEGRAND_ 2175
#define VECTOR_INTEGRAND_ 2174
#define FORM_INTEGRAND_ 2173
#define PARAMETER_1_ 2172
#define OPTIMIZING_PARAMETER_ 2171
#define K_VEC_ORDER_ 2170
#define LAGRANGE_ORDER_ 2169
#define HESSIAN_DOUBLE_NORMAL_ 2168
#define INTERP_BDRY_PARAM_ 2167
#define HESSIAN_NORMAL_ 2166
#define HESSIAN_NORMAL_ONE_ 2165
#define HESSIAN_NORMAL_PERP_ 2164
#define HESSIAN_SPECIAL_NORMAL_ 2163
#define LOAD_LIBRARY_ 2162
#define IGNORE_CONSTRAINTS_ 2161
#define VERSION_ 2160
#define KEEP_MACROS_ 2159
#define LAGRANGE_MULTIPLIER_ 2158
#define SWAP_COLORS_ 2157
#define STRING_TYPE_ 2156
#define IGNORE_FIXED_ 2155
#define KEEP_ORIGINALS_ 2154
#define ELEMENT_MODULUS_ 2153
#define VOLUME_METHOD_NAME_ 2152
#define DIRICHLET_MODE_ 2151
#define SOBOLEV_MODE_ 2150
#define KRAYNIKPOPVERTEX_FLAG_ 2148
#define KRAYNIKPOPEDGE_FLAG_ 2147
#define VERSIONTOKEN_ 2146
#define HESSIAN_SPECIAL_NORMAL_VECTOR_ 2145
#define RGB_COLORS_FLAG_ 2144
#define CIRCULAR_ARC_DRAW_ 2143
#define VISIBILITY_TEST_ 2142
#define SPARSE_CONSTRAINTS_ 2141
#define BLAS_FLAG_ 2140
#define AUGMENTED_HESSIAN_ 2139
#define AREA_METHOD_NAME_ 2138
#define LENGTH_METHOD_NAME_ 2137
#define BREAK_AFTER_WARNING_ 2136
#define PARTNER_HITTING_ 2135
#define DISPLAY_PERIODS_ 2132
/* end stuff transferred over from lex.h */
#define FULL_BOUNDING_BOX_ 2258
#define LIST_CONSTRAINT_ 2259
#define LIST_BOUNDARY_ 2260
#define LIST_QUANTITY_ 2261
#define LIST_METHOD_INSTANCE_ 2262
#define INIT_EDGE_FACETEDGE_ 2263
#define NEXT_EDGE_FACETEDGE_ 2264
#define POP_TO_FACE_ 2265
#define POP_TO_EDGE_ 2266
#define LINE_CONTINUATION 2267
#define V_MINDEG_DEBUG_LEVEL 2268
#define V_MINDEG_MARGIN 2269
#define V_MINDEG_MIN_REGION_SIZE 2270
#define SET_ELEMENT_GLOBAL_ 2271
#define SINGLE_ELEMENT_EXPR_ 2272
#define UNPUTTED_ 2273
/* for BREAK and CONTINUE */
extern int loopdepth;
/* tree node for expression trees */
struct treenode
{
int type; /* type of node */
int left; /* left subexpression index offset */
int right; /* right subexpression index offset */
int line_no; /* line number of source file */
int file_no; /* number of source file */
int datatype; /* type of expression value */
int flags;
union { int intval; /* misc. integer data */
int skipsize; /* nodes to skip over */
int indexcount; /* number of indices */
int argcount; /* number of function arguments */
int assigntype; /* for assignments */
int aggrtype; /* aggregate type */
int eltype; /* element type */
int maxsteps; /* for burchard() */
int coordnum;
REAL real; /* constant value */
struct sym *symptr; /* symbol table ptrs */
int localnum; /* where element id stored*/
int extranum; /* number of extra attr */
element_id id; /* element id */
int name_id; /* name identifier */
int letter; /* for redefine */
int quant_id; /* named quantity id */
int meth_id; /* named method id */
int con_id; /* number of constraint */
int bdry_id; /* number of boundary */
int toggle_id;
int toggle_state; /* ON_ or OFF_ */
int bool_val; /* 0 or 1 */
int intpow; /* integer power */
int wherecount;
int userfunc;
char *string; /* string value */
struct expnode enode; /* for expression */
dll_func_type funcptr; /* DLL function */
} op1; /* operand 1*/
union { int intval; /* misc. integer data */
int eltype; /* element type */
int valtype; /* data type */
int breakdepth; /* number of loop to break out of */
struct sym *symptr; /* symbol table ptrs */
char *string;
int localnum; /* where loop element id stored*/
int coordnum;
int attr_kind;
int extranum; /* number of extra attr */
int jumpsize;
int assigntype;
int argcount;
int indexcount;
int name_id;
int quant_id;
int meth_id;
} op2; /* operand 2 */
union { int intval[2]; /* misc. integer data */
int breakjump;
int argcount;
int argtype;
int extra_info; /* extra attr eltype and number */
int extranum;
int connum; /* constraint number */
int bdrynum;
int name_id;
int localnum; /* where element id stored*/
} op3;
union { int contjump;
int argtype;
int extranum;
int ret_type;
int eltype; /* element type */
int name_id;
} op4;
union { struct sym *symptr; /* symbol table ptrs */
char *string;
struct locallist_t *locals; /* for procedures */
} op5;
int stack_delta; /* what node does to runtime stack */
#ifdef _DEBUG
int stack_spot; /* where stack should be after evaluation
of this node. */
#endif
int stackpos; /* local variable on stack for storing stack
position for chopping stack after break or continue */
};
/* flags, also used for expnode */
#define LOCAL_VAR_REF 4
#define LOCAL_VAR_REF_2 8
#define LOCAL_VAR_REF_3 0x10
#define HAS_STRING 0x20
#define EPHEMERAL 0x40 /* refers to a nonpermanent name */
#define PERMNODE 0x80 /* part of permanent command */
#define HAS_LOCALLIST 0x100
#define HAS_STRING_5 0x200
#define DEALLOCATE_POINTER 0x400
#define IN_ELEMENT_LOOP 0x800
#define BREAKPOINT_NODE 0x1000
#define IS_RVALUE 0x2000
#define SET_ASSIGNOP 0x4000
#define RECALC_NODE 0x8000
#define IS_VIRTUAL_ATTR 0x10000
/* for some bit packing */
#define ESHIFT 12
/* for some type and number packing */
#define YYTYPESHIFT 25
#define YYSHIFTMASK (((1<id,e2;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL power;
REAL energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL r[MAXCOORD];
REAL LL1,L1,LL2,L2,rr,re1,re2;
REAL p;
REAL b1,b2,c1,c2;
int j;
power = globals(exponent_param)->value.real;
x1 = get_coord(get_edge_tailv(e1));
x2 = get_coord(get_edge_headv(e1));
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
LL1 = SDIM_dot(dx1,dx1);
L1 = sqrt(LL1);
FOR_ALL_EDGES(e2)
{ if ( e2 <= e1 ) continue; /* each pair once */
yy1 = get_coord(get_edge_tailv(e2));
y2 = get_coord(get_edge_headv(e2));
for ( j = 0 ; j < SDIM ; j++ ) dx2[j] = y2[j] - yy1[j];
LL2 = SDIM_dot(dx2,dx2);
L2 = sqrt(LL2);
for ( j = 0 ; j < SDIM ; j++ )
r[j] = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
rr = SDIM_dot(r,r);
re1 = SDIM_dot(r,dx1);
re2 = SDIM_dot(r,dx2);
p = pow(rr ,-power/2);
b1 = 1 - re1*re1/rr/LL1;
b2 = 1 - re2*re2/rr/LL2;
c1 = pow(b1,power/2);
c2 = pow(b2,power/2);
energy += L1*L2*p*(c1 + c2);
}
return 2*energy; /* since doing each pair once */
}
/**************************************************************
*
* function: proj_knot_energy_gradient()
*
* purpose: calculates energy of one edge due to potential
* with all others.
*
* input: info about edge is in qinfo structure.
*
*/
REAL proj_knot_energy_gradient(e_info)
struct qinfo *e_info;
{ edge_id e1 = e_info->id,e2;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL power,poww;
REAL energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL r[MAXCOORD];
REAL LL1,L1,LL2,L2,rr,re1,re2;
REAL p,en;
REAL c1,c2;
REAL b1,b2;
int i,j;
power = globals(exponent_param)->value.real;
poww = power/2;
for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < SDIM ; j++ ) e_info->grad[i][j] = 0.0;
x1 = get_coord(get_edge_tailv(e1));
x2 = get_coord(get_edge_headv(e1));
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
LL1 = SDIM_dot(dx1,dx1);
L1 = sqrt(LL1);
FOR_ALL_EDGES(e2)
{ if ( e2 == e1 ) continue;
yy1 = get_coord(get_edge_tailv(e2));
y2 = get_coord(get_edge_headv(e2));
for ( j = 0 ; j < SDIM ; j++ ) dx2[j] = y2[j] - yy1[j];
LL2 = SDIM_dot(dx2,dx2);
L2 = sqrt(LL2);
for ( j = 0 ; j < SDIM ; j++ )
r[j] = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
rr = SDIM_dot(r,r);
re1 = SDIM_dot(r,dx1);
re2 = SDIM_dot(r,dx2);
p = pow(rr ,-power/2);
b1 = 1 - re1*re1/rr/LL1;
if ( b1 <= 0.0 ) continue;
b2 = 1 - re2*re2/rr/LL2;
if ( b2 <= 0.0 ) continue;
if ( poww == 0.0 )
c1 = c2 = 1.0;
else
{ c1 = pow(b1,poww);
c2 = pow(b2,poww);
}
en = L1*L2*p*(c1*b1 + c2*b2);
energy += en;
for ( j = 0 ; j < SDIM ; j++ )
{ e_info->grad[0][j] += 2*en/LL1*(-dx1[j])
+ (-power)*en/rr*(-r[j])
+ L1*L2*p*(power)*c1*(-1)*
(-re1*re1/LL1/rr/rr*(-r[j])
-2*re1*re1/rr/LL1/LL1*(-dx1[j])
+ re1/rr/LL1*(-dx1[j] - 2*r[j]))
+ L1*L2*p*(power)*c2*(-1)*
(-re2*re2/LL2/rr/rr*(-r[j])
+ re2/rr/LL2*(-dx2[j]));
e_info->grad[1][j] += 2*en/LL1*(dx1[j])
+ (-power)*en/rr*(-r[j])
+ L1*L2*p*(power)*c1*(-1)*
(-re1*re1/LL1/rr/rr*(-r[j])
-2*re1*re1/rr/LL1/LL1*(dx1[j])
+ re1/rr/LL1*(-dx1[j] + 2*r[j]))
+ L1*L2*p*(power)*c2*(-1)*
(-re2*re2/LL2/rr/rr*(-r[j])
+ re2/rr/LL2*(-dx2[j]));
}
}
return energy; /* since doing all pairs */
}
/******************************************************************
Local hooke energy
Suggested and programmed by John Sullivan
Energy tries to equalize lengths of edges coming in to any one vertex
*/
/***************************************************************
*
* function: local_hooke_init()
*
* purpose: initialization for local_hooke()
*
* Get global variable local_hooke_flag
*/
static int local_hooke_flag;
#define HOOKE_FLAG_NAME "local_hooke_flag"
void local_hooke_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
int flag_var;
flag_var = lookup_global(HOOKE_FLAG_NAME);
if ( flag_var < 0 ) /* missing, so add */
{ flag_var = add_global(HOOKE_FLAG_NAME);
globals(flag_var)->value.real = 0.0; /* default */
globals(flag_var)->flags |= ORDINARY_PARAM | RECALC_PARAMETER | ALWAYS_RECALC;
}
local_hooke_flag = (int)globals(flag_var)->value.real;
}
/**************************************************************
*
* function: local_hooke()
*
* purpose: calculates local_hooke number of one pair of edges.
*
* input: info about edge is in qinfo structure.
*
*/
REAL local_hooke(v_info)
struct qinfo *v_info;
{ vertex_id v0 = v_info->id;
edge_id e1,e2;
REAL l1,l2,energy;
if ((!local_hooke_flag) && (get_vertex_evalence(v0) != 2))
return 0.; /* for now calculation is wrong if flag is set */
/* e1 = get_vertex_edge(v0); */
e1 = get_fe_edge(get_vertex_fe(v0));
e2 = get_next_tail_edge(e1);
l1 = get_edge_length(e1); l2 = get_edge_length(e2);
energy = (l1-l2)/(l1+l2);
energy = energy*energy;
return energy;
}
/**************************************************************
*
* function: local_hooke_gradient()
*
* purpose: calculates energy gradient of one edge due to potential
* with all others. Not yet implemented.
*
* input: info about edge is in qinfo structure.
*
*/
REAL local_hooke_gradient(v_info)
struct qinfo *v_info;
{ vertex_id v0 = v_info->id;
edge_id e1,e2, e0,e3;
REAL l1,l2,grad,sum,energy, l0,l3;
REAL ev1[MAXCOORD], ev2[MAXCOORD];
int i;
for (i=0; igrad[0][i] = 0.;
if (!local_hooke_flag && (get_vertex_evalence(v0) != 2))
return 0.; /* for now calculation is wrong if flag is set */
e1 = get_fe_edge(get_vertex_fe(v0));
e2 = get_next_tail_edge(e1);
l1 = get_edge_length(e1); l2 = get_edge_length(e2);
sum = l1+l2;
energy = (l1-l2)/sum;
grad = 4*energy/sum/sum; /* dbydl1 = grad*l2; dbydl2 = -grad*l1 */
get_edge_side(e1,ev1); get_edge_side(e2,ev2);
for (i=0; igrad[0][i] = -ev1[i]*grad*l2/l1 + ev2[i]*grad*l1/l2;
e0 = get_next_head_edge(e1); e3 = get_next_head_edge(e2);
/* ---><---.---><--- **
** e3 e2 v e1 e0 */
l0 = get_edge_length(e0); l3 = get_edge_length(e3);
sum = l0+l1; grad = 4*(l0-l1)/sum/sum/sum;
for (i=0; igrad[0][i] += ev1[i]*grad*l0/l1;
sum = l2+l3; grad = 4*(l2-l3)/sum/sum/sum;
for (i=0; igrad[0][i] -= ev2[i]*grad*l3/l2;
return energy*energy;
}
/******************************************************************
average crossing number for knots
Suggested by Doug Zare
Programmed by John Sullivan
Between pairs of edges, energy is inverse cube power of distance
between midpoints of edges, times triple product of edge vectors
and distance vector.
E = 1/d^3 * (e1,e2,d)
*/
/**************************************************************
*
* function: average_crossing()
*
* purpose: calculates average crossing number of one pair of edges.
*
* input: info about edge is in qinfo structure.
*
*/
REAL average_crossing(e_info)
struct qinfo *e_info;
{ edge_id e1 = e_info->id,e2;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL ee,energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL LL1,LL2,dd,de1,de2;
REAL e1e2;
int j;
x1 = get_coord(get_edge_tailv(e1));
x2 = get_coord(get_edge_headv(e1));
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
LL1 = SDIM_dot(dx1,dx1);
FOR_ALL_EDGES(e2)
{ if ( e2 <= e1 ) continue; /* each pair once */
yy1 = get_coord(get_edge_tailv(e2));
y2 = get_coord(get_edge_headv(e2));
LL2 = dd = de1 = de2 = e1e2 = 0.0;
for ( j = 0 ; j < SDIM ; j++ )
{
REAL rj;
dx2[j] = y2[j] - yy1[j];
LL2 += dx2[j]*dx2[j];
rj = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
dd += rj*rj;
de1 += rj*dx1[j];
de2 += rj*dx2[j];
e1e2 += dx1[j]*dx2[j];
}
ee = (LL1*LL2*dd + 2*e1e2*de1*de2
- LL1*de2*de2 - LL2*de1*de1 - dd*e1e2*e1e2)/dd;
if (ee>0.)
energy += sqrt(ee)/dd;
}
return energy/2/M_PI;
}
/*****************************************************
twisting number for curves
Suggested and programmed by John Sullivan
Integral of torsion is approximated by looking at triples of adjacent
edges; if A,B,C are the edge vectors, then the sin of the angle the
osculating plane twists by (from AxB to BxC) is
[A,B,C] |B|
-----------
|AxB| |BxC|
(This is analogous to t = [T,T',T'']/k^2.)
This function assumes the edges in each component are consistently oriented.
Gradient not implemented.
*/
/**************************************************************
*
* function: twist()
*
* purpose: calculates average crossing number of one pair of edges.
*
* input: info about edge is in qinfo structure.
*
*/
REAL twist(e_info)
struct qinfo *e_info;
{ edge_id e1 = e_info->id, e0,e2;
REAL a0[MAXCOORD],a1[MAXCOORD],a2[MAXCOORD]; /* edge vectors */
REAL a01[MAXCOORD], a12[MAXCOORD];
REAL l0 = 0.0, l1 = 0.0, l2 = 0.0;
int j;
e0 = get_next_tail_edge(e1);
e2 = get_next_head_edge(e1);
get_edge_side(e0,a0); get_edge_side(e1,a1); get_edge_side(e2,a2);
cross_prod(a0,a1,a01); cross_prod(a1,a2,a12);
for ( j = 0 ; j < SDIM ; j++ )
{
l0 += a01[j]*a01[j];
l1 += a1[j]*a1[j];
l2 += a12[j]*a12[j];
}
if ( l0*l2 == 0.0 ) return 0.0;
return asin(triple_prod(a0,a1,a2)*sqrt(l1/l0/l2))/2/M_PI;
}
/*****************************************************
writhing number for curves
Suggested by Hermann Gluck
Programmed by John Sullivan
Between pairs of edges, energy is inverse cube power of distance
between midpoints of edges, times triple product of edge vectors
and distance vector.
E = 1/d^3 * (e1,e2,d)
*/
/**************************************************************
*
* function: writhe()
*
* purpose: calculates average crossing number of one pair of edges.
*
* input: info about edge is in qinfo structure.
*
*/
REAL writhe(e_info)
struct qinfo *e_info;
{ edge_id e1 = e_info->id,e2;
vertex_id e1h,e2h,e1t,e2t;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL d[MAXCOORD];
REAL dd;
int j;
e1t = get_edge_tailv(e1);
e1h = get_edge_headv(e1);
x1 = get_coord(e1t);
x2 = get_coord(e1h);
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
FOR_ALL_EDGES(e2)
{ if ( e2 == e1 ) continue; /* equal edges */
e2t = get_edge_tailv(e2);
e2h = get_edge_headv(e2);
if (e2t==e1h || e2h==e1t) continue; /* adjacent edges */
yy1 = get_coord(e2t);
y2 = get_coord(e2h);
dd = 0.0;
for ( j = 0 ; j < SDIM ; j++ )
{
dx2[j] = y2[j] - yy1[j];
d[j] = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
dd += d[j]*d[j];
}
energy += triple_prod(dx1,d,dx2)/dd/sqrt(dd);
}
return energy/4/M_PI;
}
/**************************************************************
*
* function: writhe_gradient()
*
* purpose: calculates gradient of writhe for one edge
*
* input: info about edge is in qinfo structure.
*
*/
REAL writhe_gradient(e_info)
struct qinfo *e_info;
{
edge_id e1 = e_info->id,e2;
vertex_id e1h,e2h,e1t,e2t;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL triple,ee,energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL d[MAXCOORD];
REAL e1xe2[MAXCOORD];
REAL dxe2[MAXCOORD];
REAL dd;
int i,j;
e1t = get_edge_tailv(e1);
e1h = get_edge_headv(e1);
x1 = get_coord(e1t);
x2 = get_coord(e1h);
for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < SDIM ; j++ ) e_info->grad[i][j] = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
FOR_ALL_EDGES(e2)
{ if ( e2 == e1 ) continue; /* equal edges */
e2t = get_edge_tailv(e2);
e2h = get_edge_headv(e2);
if (e2t==e1h || e2h==e1t) continue; /* adjacent edges */
yy1 = get_coord(e2t);
y2 = get_coord(e2h);
dd = 0.0;
for ( j = 0 ; j < SDIM ; j++ )
{
dx2[j] = y2[j] - yy1[j];
d[j] = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
dd += d[j]*d[j];
}
triple = triple_prod(dx1,d,dx2);
ee = triple/dd/sqrt(dd);
energy += ee;
cross_prod(dx1,dx2,e1xe2); cross_prod(d,dx2,dxe2);
for ( j = 0 ; j < SDIM ; j++ )
{
register REAL common1 = 3*ee/dd * d[j]/2;
register REAL common2 = e1xe2[j]/dd/sqrt(dd)/2;
register REAL oppose = dxe2[j]/dd/sqrt(dd);
e_info->grad[0][j] += (common1 + common2 - oppose)/2/M_PI;
e_info->grad[1][j] += (common1 + common2 + oppose)/2/M_PI;
}
}
return energy/4/M_PI;
}
/******************************************************************
true average crossing number and writhe for knots
Suggested and Programmed by John Sullivan
Between pairs of edges, energy is area of spherical quadrilateral
of visibility from one to the other.
Thus if endpoints are a,b and c,d, let q1=d-a, q2=c-a, q3=c-b, q4=d-b.
Then let ci = (q(i-1) x qi) . (qi x q(i+1)) / |q(i-1) x qi| |qi x q(i+1)|
This is the cosine of one external angle of the spherical quadrilateral.
Thus the area is 2pi - sum(arccos(ci))
Actually, since arccos always gives a positive angle, this assumes
the quadrilateral is convex; luckily it will be.
Actually, for writhe we want to recover the sign of these angles,
to see if we're tracing the quadrilateral clockwise or counterclockwise.
This sign just comes from the sign of the volume of the tetrahedron abcd.
*/
/**************************************************************
*
* function: true_average_crossing()
*
* purpose: calculates average crossing number of one pair of edges.
*
* input: info about edge is in qinfo structure.
*
*/
REAL true_ax_wr ARGS((struct qinfo *, int));
REAL true_ax_wr(e_info, absval)
struct qinfo *e_info;
int absval;
{ edge_id e1 = e_info->id,e2;
vertex_id e1t,e1h,e2t,e2h;
REAL *a,*b,*c,*d; /* end coordinates */
REAL energy = 0.0;
REAL q[4][MAXCOORD];
REAL qq[4];
REAL qr[4];
REAL pr[4];
REAL sum;
int i,j;
for ( i = 0 ; i < 4 ; i++ ) qq[i] = qr[i] = pr[i] = 0.0;
e1t = get_edge_tailv(e1); e1h = get_edge_headv(e1);
a = get_coord(e1t);
b = get_coord(e1h);
FOR_ALL_EDGES(e2)
{ if ( e2 <= e1 ) continue; /* each pair once */
e2t = get_edge_tailv(e2);
e2h = get_edge_headv(e2);
if (e2t==e1h || e2h==e1t) continue; /* adjacent edges */
c = get_coord(e2t);
d = get_coord(e2h);
for ( j = 0 ; j < SDIM ; j++ )
{
q[0][j] = d[j]-a[j]; q[1][j] = c[j]-a[j];
q[2][j] = c[j]-b[j]; q[3][j] = d[j]-b[j];
}
for (i=0; i<4; i++)
{
int im1 = (i-1)&3, ip1 = (i+1)&3;
qq[i] = SDIM_dot(q[i],q[i]);
qr[i] = SDIM_dot(q[i],q[ip1]);
pr[i] = SDIM_dot(q[im1],q[ip1]);
}
sum=0.;
for (i=0; i<4; i++)
{
int im1 = (i-1)&3, ip1 = (i+1)&3;
REAL denom=(qq[im1]*qq[i]-qr[im1]*qr[im1])*(qq[i]*qq[ip1]-qr[i]*qr[i]);
REAL cosine;
if (denom>0.) cosine = (qr[im1]*qr[i] - pr[i]*qq[i]) / sqrt(denom);
else cosine = 0.;
if (cosine>1.) cosine=1.;
else if (cosine<-1.) cosine=-1.;
sum += acos(cosine);
}
sum = 1-sum/2/M_PI;
if (!absval && triple_prod(q[0],q[1],q[2]) < 0.) sum = -sum;
energy += sum;
}
return energy;
}
REAL true_average_crossing(e_info)
struct qinfo *e_info;
{ return true_ax_wr(e_info, 1); }
REAL true_writhe(e_info)
struct qinfo *e_info;
{ return true_ax_wr(e_info, 0); }
#ifdef XXXX
/**************************************************************
*
* function: true_writhe_gradient()
*
* purpose: calculates gradient of writhe for one edge
*
* input: info about edge is in qinfo structure.
*/
NOT IMPLEMENTED YET
REAL true_writhe_gradient(e_info)
struct qinfo *e_info;
{
edge_id e1 = e_info->id,e2;
vertex_id e1h,e2h,e1t,e2t;
REAL *x1,*x2,*yy1,*y2; /* end coordinates */
REAL triple,ee,energy = 0.0;
REAL dx1[MAXCOORD];
REAL dx2[MAXCOORD];
REAL d[MAXCOORD];
REAL e1xe2[MAXCOORD];
REAL dxe2[MAXCOORD];
REAL dd;
int i,j;
e1t = get_edge_tailv(e1);
e1h = get_edge_headv(e1);
x1 = get_coord(e1t);
x2 = get_coord(e1h);
for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < SDIM ; j++ ) e_info->grad[i][j] = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) dx1[j] = x2[j] - x1[j];
FOR_ALL_EDGES(e2)
{ if ( e2 == e1 ) continue; /* equal edges */
e2t = get_edge_tailv(e2);
e2h = get_edge_headv(e2);
if (e2t==e1h || e2h==e1t) continue; /* adjacent edges */
yy1 = get_coord(e2t);
y2 = get_coord(e2h);
dd = 0.0;
for ( j = 0 ; j < SDIM ; j++ )
{
dx2[j] = y2[j] - yy1[j];
d[j] = (yy1[j] + y2[j] - x1[j] - x2[j])/2;
dd += d[j]*d[j];
}
triple = triple_prod(dx1,d,dx2);
ee = triple/dd/sqrt(dd);
energy += ee;
cross_prod(dx1,dx2,e1xe2); cross_prod(d,dx2,dxe2);
for ( j = 0 ; j < SDIM ; j++ )
{
register REAL common1 = 3*ee/dd * d[j]/2;
register REAL common2 = e1xe2[j]/dd/sqrt(dd)/2;
register REAL oppose = dxe2[j]/dd/sqrt(dd);
e_info->grad[0][j] += (common1 + common2 - oppose)/2/M_PI;
e_info->grad[1][j] += (common1 + common2 + oppose)/2/M_PI;
}
}
return energy/4/M_PI;
}
#endif
evolver-2.30c.dfsg/src/klein.c 0000644 0001753 0001753 00000025403 11410765113 016467 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/******************************************************************
* These functions calculate the length of an edge in the Klein
* model of the hyperbolic plane.
*/
#include "include.h"
#undef SQR
#define SQR(a) ((a)*(a))
REAL coshKleinLength ARGS((REAL*,REAL*));
/*****************************************************************
* This function takes the inverse hyperbolic cosine of a number
* who's value is greater than or equal to one and returns the
* positive answer. Included here since some libraries don't
* have it or long double version.
*/
REAL kb_acosh ARGS((REAL)); /* prototype */
REAL kb_acosh(value)
REAL value; /* the value who's acosh is being taken */
{
if(value>=1)
return(log(value + sqrt(SQR(value) - 1)));
else
return(0);
}
/****************************************************************
* This function finds the hyperbolic cosine of an edge in the Klein
* model of the hyperbolic plane. It is used to calculate edge
* lengths and angles in the model.
*/
REAL coshKleinLength(head, tail)
REAL *head; /* coordinates of edge */
REAL *tail;
{
REAL num; /* numerator and den0minator of returned value */
REAL den;
REAL temp;
REAL retval;
num = 1 - SDIM_dot(head,tail);
den = 1 - SDIM_dot(head,head);
temp = 1 - SDIM_dot(tail,tail);
if((den*=temp)>0)
{ den = sqrt(den);
retval = num/den;
}
else
retval = 0.0;
if ( retval < 1.0 )
kb_error(2087,"Points outside unit disk in Klein model.\n",RECOVERABLE);
return(retval);
}
/***********************************************************************
* This function finds the length of an edge in the klein model of
* hyperbolic space.
*/
REAL klein_length(head, tail)
REAL *head; /* coordinates of edge */
REAL *tail;
{
return(kb_acosh(coshKleinLength(head, tail)));
}
/**********************************************************************
* This function finds the contribution to the gradient of the edge with
* endpoints tail and head at those endpoints.
* Actually, this adds neg grad to output.
*/
void klein_length_grad(head, tail, head_grad, tail_grad)
REAL *head, *tail; /* coordinates of edge */
REAL *head_grad, *tail_grad; /* gradients of head and tail */
{
int i;
REAL aa,bb,ab,den,disc;
aa = 1 - SDIM_dot(head,head);
bb = 1 - SDIM_dot(tail,tail);
ab = 1 - SDIM_dot(head,tail);
disc = ab*ab - aa*bb;
if ( disc == 0.0 )
{ kb_error(3107,"Vertices outside Klein disk, or zero length edge.\n",
WARNING); return;
}
if ( disc < 0.0 )
{ kb_error(1664,"Vertices outside Klein disk.\n",WARNING); return; }
den = sqrt(disc);
for ( i = 0 ; i < SDIM ; i++ )
{ head_grad[i] -= (ab*head[i]/aa- tail[i])/den;
tail_grad[i] -= (ab*tail[i]/bb - head[i])/den;
}
}
/***********************************************************************
* This function finds the area of a triangle in the klein model of the
* hyperbolic plane by using the formula:
* AREA = PI - angle1 - angle2 - angle3
*
* Angles found via hyperbolic law of cosines
*
* cosh(C) = cosh(A)cosh(B) + sinh(A)sinh(B)cos(c)
*/
REAL klein_area(triangle)
REAL **triangle;
{
REAL area; /* returned area */
int i; /* loop iterator */
int v; /* loop iterator */
int s; /* side opposite vertex */
REAL coshs[MAXCOORD], /* the coshs of the sides */
sinhs[MAXCOORD], /* the sinhs of the sides */
coss[MAXCOORD]; /* cosines of vertices */
for ( s = 0 ; s < 3 ; s++ )
{ coshs[s] = coshKleinLength(triangle[(s+1)%3], triangle[(s+2)%3]);
sinhs[s] = sqrt(coshs[s]*coshs[s] - 1);
if ( sinhs[s] == 0.0 ) return 0.0;
}
for(v=0;v<3;v++)
coss[v] = (coshs[(v+1)%3]*coshs[(v+2)%3] - coshs[v]) /
sinhs[(v+1)%3]/sinhs[(v+2)%3];
area = M_PI;
for(i=0;i<3;i++)
area -= acos(coss[i]);
return(area);
}
/**************************************************************************
* This function calculates the area gradient at the vertices of a triangle.
*/
void klein_area_grad(triangle, force)
REAL **triangle; /* the face */
REAL **force; /* the gradients */
{
int v; /* loop iterator */
int s; /* side opposite vertex */
int k,j; /* indices */
REAL coshs[MAXCOORD], /* the coshs of the sides */
sinhs[MAXCOORD], /* the sinhs of the sides */
coss[MAXCOORD], /* cosines of vertices */
sins[MAXCOORD], /* sines of vertices */
ngrad[3][3][MAXCOORD]; /* neg grad of side wrt vertex */
for ( s = 0 ; s < 3 ; s++ )
{ coshs[s] = coshKleinLength(triangle[(s+1)%3], triangle[(s+2)%3]);
sinhs[s] = sqrt(coshs[s]*coshs[s] - 1);
if ( sinhs[s] == 0.0 ) return ;
}
for(v=0;v<3;v++)
{
coss[v] = (coshs[(v+1)%3]*coshs[(v+2)%3] - coshs[v]);
coss[v] /= sinhs[(v+1)%3]*sinhs[(v+2)%3];
sins[v] = sqrt(1 - coss[v]*coss[v]);
}
memset((char*)ngrad,0,sizeof(ngrad));
for ( s = 0 ; s < 3 ; s++ )
klein_length_grad(triangle[(s+1)%3],triangle[(s+2)%3],
ngrad[s][(s+1)%3],ngrad[s][(s+2)%3]);
for ( v = 0 ; v < 3 ; v++ ) /* vertex angle */
{ int vb = (v+1)%3;
int vc = (v+2)%3;
REAL denom = sinhs[vb]*sinhs[vc]*sins[v];
REAL coeffa=sinhs[v]/denom;
REAL coeffb=(coshs[vc]-coshs[v]*coshs[vb])/sinhs[vb]/denom;
REAL coeffc=(coshs[vb]-coshs[v]*coshs[vc])/sinhs[vc]/denom;
for ( k = 0 ; k < 3 ; k++ ) /* variable vertex */
for ( j = 0 ; j < SDIM ; j++ ) /* coordinate */
{
force[k][j] -= coeffb*ngrad[vb][k][j] + coeffc*ngrad[vc][k][j]
+ coeffa*ngrad[v][k][j];
}
}
}
/**************************************************************************
Named quantity methods for 2D and 3D
**************************************************************************/
/***********************************************************************
* This function finds the length of an edge in the klein model of
* hyperbolic space.
*/
REAL klein_length_method(e_info)
struct qinfo *e_info;
{ REAL area;
area = kb_acosh(coshKleinLength(e_info->x[1], e_info->x[0]));
if ( everything_quantities_flag &&
(METH_INSTANCE(e_info->method)->quant == default_area_quant_num) )
area *= get_edge_density(e_info->id);
return(area);
}
/**********************************************************************
* This function finds the contribution to the gradient of the edge with
* endpoints tail and head at those endpoints.
*/
REAL klein_length_method_grad(e_info)
struct qinfo *e_info;
{
int i;
REAL aa,bb,ab,den,disc;
REAL *head = e_info->x[1];
REAL *tail = e_info->x[0];
REAL fudge;
if ( everything_quantities_flag &&
(METH_INSTANCE(e_info->method)->quant == default_area_quant_num) )
fudge = get_edge_density(e_info->id);
else fudge = 1.0;
aa = 1 - SDIM_dot(head,head);
bb = 1 - SDIM_dot(tail,tail);
ab = 1 - SDIM_dot(head,tail);
disc = ab*ab - aa*bb;
if ( disc == 0.0 )
{ kb_error(3359,"Vertices outside Klein disk, or zero length edge.\n",
WARNING); return 0.0;
}
if ( disc < 0.0 )
{ kb_error(1665,"Vertices outside Klein disk.\n",WARNING); return 0.0; }
den = sqrt(disc);
for ( i = 0 ; i < SDIM ; i++ )
{ e_info->grad[1][i] += fudge*(ab*head[i]/aa - tail[i])/den;
e_info->grad[0][i] += fudge*(ab*tail[i]/bb - head[i])/den;
}
return(fudge*kb_acosh(coshKleinLength(head, tail)));
}
/***********************************************************************
* This function finds the area of a triangle in the klein model of the
* hyperbolic plane by using the formula:
* AREA = PI - angle1 - angle2 - angle3
*/
REAL klein_area_method(f_info)
struct qinfo *f_info;
{
REAL area; /* returned area */
int i; /* loop iterator */
int v; /* loop iterator */
int s; /* side opposite vertex */
REAL **triangle = f_info->x;
REAL coshs[MAXCOORD], /* the coshs of the sides */
sinhs[MAXCOORD], /* the sinhs of the sides */
coss[MAXCOORD]; /* cosines of vertices */
for ( s = 0 ; s < 3 ; s++ )
{ coshs[s] = coshKleinLength(triangle[(s+1)%3], triangle[(s+2)%3]);
sinhs[s] = sqrt(coshs[s]*coshs[s] - 1);
if ( sinhs[s] == 0.0 ) return 0.0;
}
for(v=0;v<3;v++)
coss[v] = (coshs[(v+1)%3]*coshs[(v+2)%3] - coshs[v]) /
sinhs[(v+1)%3]/sinhs[(v+2)%3];
area = M_PI;
for(i=0;i<3;i++)
area -= acos(coss[i]);
if ( everything_quantities_flag &&
(METH_INSTANCE(f_info->method)->quant == default_area_quant_num) )
area *= get_facet_density(f_info->id);
return(area);
}
/**************************************************************************
* This function calculates the area gradient at the vertices of a triangle.
*/
REAL klein_area_method_grad(f_info)
struct qinfo *f_info;
{ REAL area;
int v; /* loop iterator */
int s; /* side opposite vertex */
int i, k,j; /* indices */
REAL **triangle = f_info->x;
REAL coshs[MAXCOORD], /* the coshs of the sides */
sinhs[MAXCOORD], /* the sinhs of the sides */
coss[MAXCOORD], /* cosines of vertices */
sins[MAXCOORD], /* sines of vertices */
ngrad[3][3][MAXCOORD]; /* neg grad of side wrt vertex */
REAL fudge;
if ( everything_quantities_flag &&
(METH_INSTANCE(f_info->method)->quant == default_area_quant_num) )
fudge = get_facet_density(f_info->id);
else fudge = 1.0;
for ( s = 0 ; s < 3 ; s++ )
{ coshs[s] = coshKleinLength(triangle[(s+1)%3], triangle[(s+2)%3]);
sinhs[s] = sqrt(coshs[s]*coshs[s] - 1);
if ( sinhs[s] == 0.0 ) return 0.0 ;
}
for(v=0;v<3;v++)
{
coss[v] = (coshs[(v+1)%3]*coshs[(v+2)%3] - coshs[v]);
coss[v] /= sinhs[(v+1)%3]*sinhs[(v+2)%3];
sins[v] = sqrt(1 - coss[v]*coss[v]);
}
memset((char*)ngrad,0,sizeof(ngrad));
for ( s = 0 ; s < 3 ; s++ )
klein_length_grad(triangle[(s+1)%3],triangle[(s+2)%3],
ngrad[s][(s+1)%3],ngrad[s][(s+2)%3]);
for ( v = 0 ; v < 3 ; v++ ) /* vertex angle */
{ int vb = (v+1)%3;
int vc = (v+2)%3;
REAL denom = sinhs[vb]*sinhs[vc]*sins[v];
REAL coeffa=sinhs[v]/denom;
REAL coeffb=(coshs[vc]-coshs[v]*coshs[vb])/sinhs[vb]/denom;
REAL coeffc=(coshs[vb]-coshs[v]*coshs[vc])/sinhs[vc]/denom;
for ( k = 0 ; k < 3 ; k++ ) /* variable vertex */
for ( j = 0 ; j < SDIM ; j++ ) /* coordinate */
{
f_info->grad[k][j] += fudge*(coeffb*ngrad[vb][k][j]
+ coeffc*ngrad[vc][k][j]
+ coeffa*ngrad[v][k][j]);
}
}
area = M_PI;
for(i=0;i<3;i++)
area -= acos(coss[i]);
return(fudge*area);
}
evolver-2.30c.dfsg/src/xgraph.c 0000644 0001753 0001753 00000022062 11410765113 016654 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************
*
* File: xgraph.c
*
* Contents: Graphics routines for display on X-Windows.
*/
/*
From bink@athena.mit.edu Wed Apr 10 16:05:07 1991
Received: from ATHENA.MIT.EDU by poincare.susqu.edu ; Wed, 10 Apr 91 16:04:59 CDT
Received: from M4-167-10.MIT.EDU by ATHENA.MIT.EDU with SMTP
id AA09847; Wed, 10 Apr 91 17:04:52 EDT
From: bink@athena.mit.edu
Received: by m4-167-10.MIT.EDU (5.61/4.7) id AA24288; Wed, 10 Apr 91 17:04:36 -0400
Message-Id: <9104102104.AA24288@m4-167-10.MIT.EDU>
To: brakke@poincare
Subject: xgraph.c
Date: Wed, 10 Apr 91 17:04:31 EDT
Status: R
Here is the X windows interface I mentioned. Just a few comments about it;
the author, Tim Shepard, a graduate student in the MIT Laboratory for Computer
Science, says, "It is a two hour hack, and not the best possible job." My
own remarks are that xgraph_edge is untested to date, because I have yet to
use that feature. Also, despite the author's complaints about the ugliness
of the code, it has worked very nicely for everything I've needed thus far.
Besides the following, three lines need to be added to the Makefile. They
are: CFLAGS= -DGENERIC
GRAPH= xgraph.o
GRAPHLIB= -lX11
Livia Racz
(racz@zither.mit.edu)
*/
/*************************************************************
* This file is for the Surface Evolver source code. *
* by Tim Shepard for Livia Racz (March 1991) *
* Modified 9-9-92 for colors and shading - K. Brakke *
*************************************************************/
/* (based on tcgraph.c) */
/* X11 graphics module */
/* All coordinates in absolute pixels in window */
#include "include.h"
#ifndef NOPROTO
#define NeedFunctionPrototypes 1
#endif
#include
static Display *dpy;
static Screen *screen;
static Window rootwin;
static Window win;
static XGCValues gcv;
static GC gc;
static XEvent event;
Colormap cmap;
static int maxx,maxy; /* max viewport coordinates */
static REAL xscale,yscale; /* for scaling to screen size */
#define MAXGRAY 15
#define CINDEX(color,gray) ((gray)*(MAXGRAY+1) + (color))
unsigned long pixel_values[256];
/* colors not alloced till needed to save colormap */
#define NOT_ALLOC 0xFFA93871
static int White,Black; /* color indices in default colormap */
unsigned long get_a_color ARGS((int,int));
unsigned long get_a_color(c,g)
int c; /* color, 0-15 */
int g; /* gray level, 0-15 */
{
XColor xc;
unsigned long col;
col = pixel_values[CINDEX(c,g)];
if ( col != NOT_ALLOC ) return col;
xc.red = (unsigned short)(0xffff*(g+12.)/(MAXGRAY+12.)*rgb_colors[c][0]);
xc.green = (unsigned short)(0xffff*(g+12.)/(MAXGRAY+12.)*rgb_colors[c][1]);
xc.blue = (unsigned short)(0xffff*(g+12.)/(MAXGRAY+12.)*rgb_colors[c][2]);
/* if (xc.blue < 0x4444) xc.blue = 0x4444; */
xc.flags = DoRed|DoGreen|DoBlue;
if (XAllocColor(dpy, cmap, &xc) == 0)
{
xc.pixel = g>=8?WhitePixelOfScreen(screen): BlackPixelOfScreen(screen);
}
pixel_values[CINDEX(c,g)] = xc.pixel;
return xc.pixel;
}
void init_xgraph()
{
int g;
int waiting_for_window = 0;
if ( init_flag == 0 ) {
waiting_for_window = 1;
init_flag = 1;
event.type = 0;
for ( g = 0 ; g < 256 ; g++ ) pixel_values[g] = NOT_ALLOC;
dpy = XOpenDisplay("");
if (dpy == NULL)
kb_error(2213,"Unable to open X display.\n", RECOVERABLE);
screen = XDefaultScreenOfDisplay(dpy);
if (screen == NULL)
kb_error(2214,"Unable to get default screen of X display.\n", RECOVERABLE);
rootwin = XRootWindowOfScreen(screen);
if (rootwin == 0)
kb_error(2215,"X display: Unable to get root window of screen.\n", RECOVERABLE);
win = XCreateSimpleWindow(dpy, rootwin, 0, 0, 500, 500, 1,
WhitePixelOfScreen(screen),
BlackPixelOfScreen(screen));
if (win == 0)
kb_error(2216,"X display: Unable to create window\n", RECOVERABLE);
cmap = DefaultColormap(dpy,/*XScreenNumberOfScreen(screen)*/0);
XSelectInput(dpy, win, StructureNotifyMask);
XMapRaised(dpy, win);
White = WhitePixelOfScreen(screen);
Black = BlackPixelOfScreen(screen);
gcv.line_width = 0;
gc = XCreateGC(dpy, win, GCForeground|GCLineWidth, &gcv);
/* wait for window to appear */
XFlush(dpy);
while ( event.type != MapNotify ) {
XNextEvent(dpy, &event);
switch(event.type) {
case ConfigureNotify:
maxx = event.xconfigure.width;
maxy = event.xconfigure.height;
xscale = (maxx 0) {
XNextEvent(dpy, &event);
switch(event.type) {
case ConfigureNotify:
maxx = event.xconfigure.width;
maxy = event.xconfigure.height;
if ( maxx < maxy )
{ minclipx = -1.5; maxclipx = 1.5;
minclipy = -1.5*maxy/maxx; maxclipy = 1.5*maxy/maxx;
}
else
{ minclipx = -1.5*maxx/maxy; maxclipx = 1.5*maxx/maxy;
minclipy = -1.5; maxclipy = 1.5;
}
xscale = (maxxetype[0]&EBITS == INVISIBLE_EDGE ) return;
if ( t->etype[0]&EBITS == SPLITTING_EDGE ) return;
if ( t->ecolor[0] == CLEAR ) return;
for ( i = 0 ; i < 2 ; i++ )
{ REAL temp;
temp = (t->x[i][0]*xscale) + maxx/2;
if ( fabs(temp) > 32000. ) return; /* off scale */
p[i].x = (short)temp;
temp = maxy/2 - (t->x[i][1]*yscale);
if ( fabs(temp) > 32000. ) return;
p[i].y = (short)temp;
}
if ( !shading_flag && !color_flag ) color = Black;
else
color = get_a_color(t->color,MAXGRAY);
if( gcv.foreground != color)
{ gcv.foreground = color;
XChangeGC(dpy, gc, GCForeground, &gcv);
}
XDrawLine(dpy, win, gc, p[0].x, p[0].y, p[1].x, p[1].y);
}
void xgraph_facet(t)
struct tsort *t;
{
int n = FACET_VERTS; /* vertices in polygon */
XPoint p[6]; /* vertex coords */
int i;
int icolor;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ REAL temp;
temp = (t->x[i][0]*xscale) + maxx/2;
if ( fabs(temp) > 32000. ) return; /* off scale */
p[i].x = (short)temp;
temp = maxy/2 - (t->x[i][1]*yscale);
if ( fabs(temp) > 32000. ) return;
p[i].y = (short)temp;
}
p[FACET_VERTS] = p[0]; /* convenient */
if ( web.hide_flag && (t->color != CLEAR) && (t->color != UNSHOWN) )
{
if ( shading_flag && color_flag )
icolor = get_a_color(t->color,(int)(MAXGRAY*gray_level(t->normal)));
else if ( color_flag )
icolor = get_a_color(t->color,MAXGRAY);
else if ( shading_flag )
icolor = get_a_color(WHITE,(int)(MAXGRAY*gray_level(t->normal)));
else icolor = White;
if (gcv.foreground != icolor) {
gcv.foreground = icolor;
XChangeGC(dpy, gc, GCForeground, &gcv);
}
XFillPolygon(dpy, win, gc, p, n, Nonconvex, CoordModeOrigin);
}
/* show designated edges */
for ( i = 0 ; i < 3 ; i++ )
{
if ( t->ecolor[i] == CLEAR ) continue;
if ( t->etype[i]&EBITS & SPLITTING_EDGE ) continue;
if ( !edgeshow_flag || (t->color == UNSHOWN) )
{ if ( t->etype[i]&EBITS == INVISIBLE_EDGE ) continue;
}
icolor = get_a_color(t->ecolor[i],MAXGRAY);
if (gcv.foreground != icolor) {
gcv.foreground = icolor;
XChangeGC(dpy, gc, GCForeground, &gcv);
}
XDrawLine(dpy, win, gc, p[i].x, p[i].y, p[i+1].x, p[i+1].y);
}
}
void finish_xgraph()
{
XFlush(dpy);
}
void close_xgraph()
{
XCloseDisplay(dpy);
init_flag = 0;
}
void display()
{
ENTER_GRAPH_MUTEX
init_graphics = init_xgraph;
finish_graphics = finish_xgraph;
close_graphics = close_xgraph;
graph_start = painter_start;
graph_edge = painter_edge;
display_edge = xgraph_edge;
graph_facet = painter_facet;
display_facet = xgraph_facet;
graph_end = painter_end;
graphgen();
XFlush(dpy);
LEAVE_GRAPH_MUTEX
}
void graph_new_surface() {}
evolver-2.30c.dfsg/src/ytab.h 0000644 0001753 0001753 00000036564 11410765113 016343 0 ustar hazelsct hazelsct /* A Bison parser, made by GNU Bison 2.1. */
/* Skeleton parser for Yacc-like parsing with Bison,
Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
/* As a special exception, when this file is copied by Bison into a
Bison output file, you may use that output file without restriction.
This special exception was added by the Free Software Foundation
in version 1.24 of Bison. */
/* Tokens. */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
/* Put the tokens into the symbol table, so that GDB and other debuggers
know about them. */
enum yytokentype {
EXPRESSION_START_ = 258,
COMMAND_START_ = 259,
HISTORY_ = 260,
GEOMVIEW_ = 261,
VIEW_MATRIX_ = 262,
LEAD_INTEGER_ = 263,
INTEGER_ = 264,
REAL_ = 265,
SIGNED_NUMBER_ = 266,
NEWIDENT_ = 267,
REDEFINE_ = 268,
MATHFUNC_ = 269,
MATHFUNC2_ = 270,
POW_ = 271,
USERFUNC_ = 272,
MIDV_ = 273,
DATAFILENAME_ = 274,
LOGFILE_ = 275,
PI_ = 276,
E_ = 277,
G_ = 278,
PARAM_ = 279,
SYMBOL_ = 280,
TOTAL_ = 281,
EXTRA_ATTRIBUTE_ = 282,
FIXEDVOL_ = 283,
IDENT_ = 284,
UMINUS_ = 285,
SHELL_ = 286,
COLOR_ = 287,
HESSIAN_ = 288,
VOLCONST_ = 289,
TORUS_PERIODS_ = 290,
VERTICES_ = 291,
EDGES_ = 292,
FACETS_ = 293,
BODIES_ = 294,
HESSIAN_MENU_ = 295,
POSTSCRIPT_ = 296,
LENGTH_ = 297,
AREA_ = 298,
VOLUME_ = 299,
ID_ = 300,
OID_ = 301,
TAG_ = 302,
ORIGINAL_ = 303,
FACETEDGES_ = 304,
WRAP_ = 305,
QUOTATION_ = 306,
UNSET_ = 307,
TOPINFO_ = 308,
OPACITY_ = 309,
VALENCE_ = 310,
HESSIAN_SADDLE_ = 311,
SET_ = 312,
FIXED_ = 313,
DENSITY_ = 314,
PRESSURE_ = 315,
CONSTRAINT_ = 316,
COORD_ = 317,
DISSOLVE_ = 318,
WHERE_ = 319,
LIST_ = 320,
SHOW_ = 321,
DELETE_ = 322,
REFINE_ = 323,
RECALC_ = 324,
SHOWQ_ = 325,
EDGESWAP_ = 326,
FIX_ = 327,
UNFIX_ = 328,
TOGGLENAME_ = 329,
TOGGLEVALUE_ = 330,
STAR_ = 331,
QUANTITY_NAME_ = 332,
PAUSE_ = 333,
GO_ = 334,
SHOW_VOL_ = 335,
CHECK_ = 336,
READ_ = 337,
ZOOM_ = 338,
ON_ = 339,
OFF_ = 340,
GEOMPIPE_ = 341,
SELF_ = 342,
SINGLE_LETTER_ = 343,
LONG_JIGGLE_ = 344,
RAW_VERAVG_ = 345,
COUNTS_ = 346,
CHDIR_ = 347,
ALICE_ = 348,
STABILITY_TEST_ = 349,
DEFINE_ = 350,
UPLUS_ = 351,
DATATYPE_ = 352,
FLUSH_COUNTS_ = 353,
AUTOCHOP_ = 354,
UTEST_ = 355,
ATTRIBUTE_ = 356,
RITZ_ = 357,
MOVE_ = 358,
VERTEXNORMAL_ = 359,
POP_ = 360,
SYSTEM_ = 361,
TETRA_POINT_ = 362,
TRIPLE_POINT_ = 363,
LANCZOS_ = 364,
EIGENPROBE_ = 365,
EXEC_ = 366,
AREAWEED_ = 367,
EDGEWEED_ = 368,
GRAVITY_ = 369,
EDGEDIVIDE_ = 370,
LINEAR_ = 371,
QUADRATIC_ = 372,
DIFFUSION_ = 373,
EXTRAPOLATE_ = 374,
TRANSFORM_DEPTH_ = 375,
PRINTF_ = 376,
ERRPRINTF_ = 377,
PRINT_ = 378,
MAX_ = 379,
MIN_ = 380,
COUNT_ = 381,
SUM_ = 382,
AVG_ = 383,
BREAK_ = 384,
CONTINUE_ = 385,
SIZEOF_ = 386,
TRANSFORM_EXPR_ = 387,
BARE_ = 388,
BOTTOMINFO_ = 389,
METIS_ = 390,
KMETIS_ = 391,
KEYLOGFILE_ = 392,
SCALE_ = 393,
BURCHARD_ = 394,
REBODY_ = 395,
BOUNDARY_ = 396,
ORIENTATION_ = 397,
OMETIS_ = 398,
SQ_MEAN_CURV_ = 399,
FRONTCOLOR_ = 400,
SINGLE_REDEFD_ = 401,
METHOD_NAME_ = 402,
TASK_EXEC_ = 403,
RAWEST_VERAVG_ = 404,
SINGLE_LETTER_ARG_ = 405,
BACKCOLOR_ = 406,
LAGRANGE_ = 407,
RETURN_ = 408,
TRANSFORM_EXPR_VERB_ = 409,
OOGLFILE_ = 410,
PARALLEL_EXEC_ = 411,
BINARY_OFF_FILE_ = 412,
SPRINTF_ = 413,
CONVERT_TO_QUANTS_ = 414,
METIS_FACTOR_ = 415,
FUNCTION_ = 416,
EXPRINT_ = 417,
DIHEDRAL_ = 418,
WRAP_VERTEX_ = 419,
ARRAYIDENT_ = 420,
DATE_AND_TIME_ = 421,
LOCAL_ = 422,
SHOW_EXPR_ = 423,
SHOW_TRANS_ = 424,
AXIAL_POINT_ = 425,
ENERGY_ = 426,
CONSERVED_ = 427,
INFO_ONLY_ = 428,
ASSIGN_ = 429,
PROCEDURE_ = 430,
FOREACH_ = 431,
STRINGGLOBAL_ = 432,
EQUIANGULATE_ = 433,
HISTOGRAM_ = 434,
LOGHISTOGRAM_ = 435,
AREA_FIXED_ = 436,
QUIT_ = 437,
WARNING_MESSAGES_ = 438,
IF_ = 439,
WHILE_ = 440,
DO_ = 441,
NO_REFINE_ = 442,
STRING_ = 443,
NONCONTENT_ = 444,
FOR_ = 445,
HIT_PARTNER_ = 446,
FRONTBODY_ = 447,
BACKBODY_ = 448,
COLORFILE_ = 449,
PERM_STRINGGLOBAL_ = 450,
FUNCTION_IDENT_ = 451,
THICKEN_ = 452,
COLORMAP_ = 453,
REDIRECT_ = 454,
NEWVERTEX_ = 455,
NEWEDGE_ = 456,
NEWFACET_ = 457,
MODULUS_ = 458,
TARGET_ = 459,
VALUE_ = 460,
INVERSE_PERIODS_ = 461,
NEWBODY_ = 462,
DELTA_ = 463,
GAP_CONSTANT_ = 464,
DUMP_ = 465,
NOTCH_ = 466,
QUANTITY_ = 467,
LOAD_ = 468,
PERM_PROCEDURE_ = 469,
PROCEDURE_WORD_ = 470,
DYNAMIC_LOAD_FUNC_ = 471,
PERM_IDENT_ = 472,
PERMLOAD_ = 473,
HELP_ = 474,
VERTEX_AVERAGE_ = 475,
METHOD_INSTANCE_ = 476,
RAW_VERTEX_AVERAGE_ = 477,
OPTIMIZE_ = 478,
REDIRECTOVER_ = 479,
TOLERANCE_ = 480,
RAWEST_VERTEX_AVERAGE_ = 481,
JIGGLE_ = 482,
VIEW_TRANSFORMS_ = 483,
CLOSE_SHOW_ = 484,
IS_DEFINED_ = 485,
NODISPLAY_ = 486,
PERM_ASSIGN_ = 487,
PHASE_ = 488,
VIEW_TRANSFORM_SWAP_COLORS_ = 489,
BACKQUOTE_COMMA_ = 490,
INTERNAL_VARIABLE_ = 491,
DIRICHLET_ = 492,
SOBOLEV_ = 493,
VIEW_TRANSFORM_PARITY_ = 494,
SOBOLEV_SEEK_ = 495,
DIRICHLET_SEEK_ = 496,
HESSIAN_SEEK_ = 497,
REORDER_STORAGE_ = 498,
RENUMBER_ALL_ = 499,
CONSTRAINT_NAME_ = 500,
BOUNDARY_NAME_ = 501,
PROCEDURE_IDENT_ = 502,
POP_TRI_TO_EDGE_ = 503,
POP_EDGE_TO_TRI_ = 504,
POP_QUAD_TO_QUAD_ = 505,
SHOWVERB_ = 506,
PROCEDURES_ = 507,
MPI_TASK_ATTR_ = 508,
T1_EDGESWAP_ = 509,
MERGE_EDGE_ = 510,
MERGE_FACET_ = 511,
MERGE_VERTEX_ = 512,
RESET_COUNTS_ = 513,
VALID_ELEMENT_ = 514,
MID_EDGE_ = 515,
MID_FACET_ = 516,
GO_COUNT_ = 517,
ELEMENT_IDENT_ = 518,
BODY_METIS_ = 519,
REVERSE_ORIENTATION_ = 520,
MATRIX_MULTIPLY_ = 521,
MATRIX_INVERSE_ = 522,
BINARY_PRINTF_ = 523,
DUMP_MEMLIST_ = 524,
FREE_DISCARDS_ = 525,
REPARTITION_ = 526,
METIS_READJUST_ = 527,
MEAN_CURVATURE_ = 528,
GLOBAL_ = 529,
LEAD_INTEGER_AT_ = 530,
INTEGER_AT_ = 531,
MATRIX_DETERMINANT_ = 532,
SUBCOMMAND_ = 533,
ABORT_ = 534,
BREAKPOINT_ = 535,
WHEREAMI_ = 536,
ADDLOAD_ = 537,
SIMPLEX_TO_FE_ = 538,
DISPLAY_TEXT_ = 539,
DELETE_TEXT_ = 540,
SUPPRESS_WARNING_ = 541,
UNSUPPRESS_WARNING_ = 542,
RESET_PROFILING_ = 543,
VALID_CONSTRAINT_ = 544,
VALID_BOUNDARY_ = 545,
ARRAY_ATTRIBUTE_ = 546,
PROFILING_ = 547,
ASSIGNOP_ = 548,
PIPE_ = 549,
THEN_ = 550,
ELSE_ = 551,
OR_ = 552,
AND_ = 553,
NOT_ = 554,
NE_ = 555,
GE_ = 556,
LE_ = 557,
EQ_ = 558,
ON_CONSTRAINT_ = 559,
HIT_CONSTRAINT_ = 560,
ON_BOUNDARY_ = 561,
ON_QUANTITY_ = 562,
ON_METHOD_INSTANCE_ = 563,
DOT_ = 564,
IDIV_ = 565,
IMOD_ = 566,
EPRINT_ = 567
};
#endif
/* Tokens. */
#define EXPRESSION_START_ 258
#define COMMAND_START_ 259
#define HISTORY_ 260
#define GEOMVIEW_ 261
#define VIEW_MATRIX_ 262
#define LEAD_INTEGER_ 263
#define INTEGER_ 264
#define REAL_ 265
#define SIGNED_NUMBER_ 266
#define NEWIDENT_ 267
#define REDEFINE_ 268
#define MATHFUNC_ 269
#define MATHFUNC2_ 270
#define POW_ 271
#define USERFUNC_ 272
#define MIDV_ 273
#define DATAFILENAME_ 274
#define LOGFILE_ 275
#define PI_ 276
#define E_ 277
#define G_ 278
#define PARAM_ 279
#define SYMBOL_ 280
#define TOTAL_ 281
#define EXTRA_ATTRIBUTE_ 282
#define FIXEDVOL_ 283
#define IDENT_ 284
#define UMINUS_ 285
#define SHELL_ 286
#define COLOR_ 287
#define HESSIAN_ 288
#define VOLCONST_ 289
#define TORUS_PERIODS_ 290
#define VERTICES_ 291
#define EDGES_ 292
#define FACETS_ 293
#define BODIES_ 294
#define HESSIAN_MENU_ 295
#define POSTSCRIPT_ 296
#define LENGTH_ 297
#define AREA_ 298
#define VOLUME_ 299
#define ID_ 300
#define OID_ 301
#define TAG_ 302
#define ORIGINAL_ 303
#define FACETEDGES_ 304
#define WRAP_ 305
#define QUOTATION_ 306
#define UNSET_ 307
#define TOPINFO_ 308
#define OPACITY_ 309
#define VALENCE_ 310
#define HESSIAN_SADDLE_ 311
#define SET_ 312
#define FIXED_ 313
#define DENSITY_ 314
#define PRESSURE_ 315
#define CONSTRAINT_ 316
#define COORD_ 317
#define DISSOLVE_ 318
#define WHERE_ 319
#define LIST_ 320
#define SHOW_ 321
#define DELETE_ 322
#define REFINE_ 323
#define RECALC_ 324
#define SHOWQ_ 325
#define EDGESWAP_ 326
#define FIX_ 327
#define UNFIX_ 328
#define TOGGLENAME_ 329
#define TOGGLEVALUE_ 330
#define STAR_ 331
#define QUANTITY_NAME_ 332
#define PAUSE_ 333
#define GO_ 334
#define SHOW_VOL_ 335
#define CHECK_ 336
#define READ_ 337
#define ZOOM_ 338
#define ON_ 339
#define OFF_ 340
#define GEOMPIPE_ 341
#define SELF_ 342
#define SINGLE_LETTER_ 343
#define LONG_JIGGLE_ 344
#define RAW_VERAVG_ 345
#define COUNTS_ 346
#define CHDIR_ 347
#define ALICE_ 348
#define STABILITY_TEST_ 349
#define DEFINE_ 350
#define UPLUS_ 351
#define DATATYPE_ 352
#define FLUSH_COUNTS_ 353
#define AUTOCHOP_ 354
#define UTEST_ 355
#define ATTRIBUTE_ 356
#define RITZ_ 357
#define MOVE_ 358
#define VERTEXNORMAL_ 359
#define POP_ 360
#define SYSTEM_ 361
#define TETRA_POINT_ 362
#define TRIPLE_POINT_ 363
#define LANCZOS_ 364
#define EIGENPROBE_ 365
#define EXEC_ 366
#define AREAWEED_ 367
#define EDGEWEED_ 368
#define GRAVITY_ 369
#define EDGEDIVIDE_ 370
#define LINEAR_ 371
#define QUADRATIC_ 372
#define DIFFUSION_ 373
#define EXTRAPOLATE_ 374
#define TRANSFORM_DEPTH_ 375
#define PRINTF_ 376
#define ERRPRINTF_ 377
#define PRINT_ 378
#define MAX_ 379
#define MIN_ 380
#define COUNT_ 381
#define SUM_ 382
#define AVG_ 383
#define BREAK_ 384
#define CONTINUE_ 385
#define SIZEOF_ 386
#define TRANSFORM_EXPR_ 387
#define BARE_ 388
#define BOTTOMINFO_ 389
#define METIS_ 390
#define KMETIS_ 391
#define KEYLOGFILE_ 392
#define SCALE_ 393
#define BURCHARD_ 394
#define REBODY_ 395
#define BOUNDARY_ 396
#define ORIENTATION_ 397
#define OMETIS_ 398
#define SQ_MEAN_CURV_ 399
#define FRONTCOLOR_ 400
#define SINGLE_REDEFD_ 401
#define METHOD_NAME_ 402
#define TASK_EXEC_ 403
#define RAWEST_VERAVG_ 404
#define SINGLE_LETTER_ARG_ 405
#define BACKCOLOR_ 406
#define LAGRANGE_ 407
#define RETURN_ 408
#define TRANSFORM_EXPR_VERB_ 409
#define OOGLFILE_ 410
#define PARALLEL_EXEC_ 411
#define BINARY_OFF_FILE_ 412
#define SPRINTF_ 413
#define CONVERT_TO_QUANTS_ 414
#define METIS_FACTOR_ 415
#define FUNCTION_ 416
#define EXPRINT_ 417
#define DIHEDRAL_ 418
#define WRAP_VERTEX_ 419
#define ARRAYIDENT_ 420
#define DATE_AND_TIME_ 421
#define LOCAL_ 422
#define SHOW_EXPR_ 423
#define SHOW_TRANS_ 424
#define AXIAL_POINT_ 425
#define ENERGY_ 426
#define CONSERVED_ 427
#define INFO_ONLY_ 428
#define ASSIGN_ 429
#define PROCEDURE_ 430
#define FOREACH_ 431
#define STRINGGLOBAL_ 432
#define EQUIANGULATE_ 433
#define HISTOGRAM_ 434
#define LOGHISTOGRAM_ 435
#define AREA_FIXED_ 436
#define QUIT_ 437
#define WARNING_MESSAGES_ 438
#define IF_ 439
#define WHILE_ 440
#define DO_ 441
#define NO_REFINE_ 442
#define STRING_ 443
#define NONCONTENT_ 444
#define FOR_ 445
#define HIT_PARTNER_ 446
#define FRONTBODY_ 447
#define BACKBODY_ 448
#define COLORFILE_ 449
#define PERM_STRINGGLOBAL_ 450
#define FUNCTION_IDENT_ 451
#define THICKEN_ 452
#define COLORMAP_ 453
#define REDIRECT_ 454
#define NEWVERTEX_ 455
#define NEWEDGE_ 456
#define NEWFACET_ 457
#define MODULUS_ 458
#define TARGET_ 459
#define VALUE_ 460
#define INVERSE_PERIODS_ 461
#define NEWBODY_ 462
#define DELTA_ 463
#define GAP_CONSTANT_ 464
#define DUMP_ 465
#define NOTCH_ 466
#define QUANTITY_ 467
#define LOAD_ 468
#define PERM_PROCEDURE_ 469
#define PROCEDURE_WORD_ 470
#define DYNAMIC_LOAD_FUNC_ 471
#define PERM_IDENT_ 472
#define PERMLOAD_ 473
#define HELP_ 474
#define VERTEX_AVERAGE_ 475
#define METHOD_INSTANCE_ 476
#define RAW_VERTEX_AVERAGE_ 477
#define OPTIMIZE_ 478
#define REDIRECTOVER_ 479
#define TOLERANCE_ 480
#define RAWEST_VERTEX_AVERAGE_ 481
#define JIGGLE_ 482
#define VIEW_TRANSFORMS_ 483
#define CLOSE_SHOW_ 484
#define IS_DEFINED_ 485
#define NODISPLAY_ 486
#define PERM_ASSIGN_ 487
#define PHASE_ 488
#define VIEW_TRANSFORM_SWAP_COLORS_ 489
#define BACKQUOTE_COMMA_ 490
#define INTERNAL_VARIABLE_ 491
#define DIRICHLET_ 492
#define SOBOLEV_ 493
#define VIEW_TRANSFORM_PARITY_ 494
#define SOBOLEV_SEEK_ 495
#define DIRICHLET_SEEK_ 496
#define HESSIAN_SEEK_ 497
#define REORDER_STORAGE_ 498
#define RENUMBER_ALL_ 499
#define CONSTRAINT_NAME_ 500
#define BOUNDARY_NAME_ 501
#define PROCEDURE_IDENT_ 502
#define POP_TRI_TO_EDGE_ 503
#define POP_EDGE_TO_TRI_ 504
#define POP_QUAD_TO_QUAD_ 505
#define SHOWVERB_ 506
#define PROCEDURES_ 507
#define MPI_TASK_ATTR_ 508
#define T1_EDGESWAP_ 509
#define MERGE_EDGE_ 510
#define MERGE_FACET_ 511
#define MERGE_VERTEX_ 512
#define RESET_COUNTS_ 513
#define VALID_ELEMENT_ 514
#define MID_EDGE_ 515
#define MID_FACET_ 516
#define GO_COUNT_ 517
#define ELEMENT_IDENT_ 518
#define BODY_METIS_ 519
#define REVERSE_ORIENTATION_ 520
#define MATRIX_MULTIPLY_ 521
#define MATRIX_INVERSE_ 522
#define BINARY_PRINTF_ 523
#define DUMP_MEMLIST_ 524
#define FREE_DISCARDS_ 525
#define REPARTITION_ 526
#define METIS_READJUST_ 527
#define MEAN_CURVATURE_ 528
#define GLOBAL_ 529
#define LEAD_INTEGER_AT_ 530
#define INTEGER_AT_ 531
#define MATRIX_DETERMINANT_ 532
#define SUBCOMMAND_ 533
#define ABORT_ 534
#define BREAKPOINT_ 535
#define WHEREAMI_ 536
#define ADDLOAD_ 537
#define SIMPLEX_TO_FE_ 538
#define DISPLAY_TEXT_ 539
#define DELETE_TEXT_ 540
#define SUPPRESS_WARNING_ 541
#define UNSUPPRESS_WARNING_ 542
#define RESET_PROFILING_ 543
#define VALID_CONSTRAINT_ 544
#define VALID_BOUNDARY_ 545
#define ARRAY_ATTRIBUTE_ 546
#define PROFILING_ 547
#define ASSIGNOP_ 548
#define PIPE_ 549
#define THEN_ 550
#define ELSE_ 551
#define OR_ 552
#define AND_ 553
#define NOT_ 554
#define NE_ 555
#define GE_ 556
#define LE_ 557
#define EQ_ 558
#define ON_CONSTRAINT_ 559
#define HIT_CONSTRAINT_ 560
#define ON_BOUNDARY_ 561
#define ON_QUANTITY_ 562
#define ON_METHOD_INSTANCE_ 563
#define DOT_ 564
#define IDIV_ 565
#define IMOD_ 566
#define EPRINT_ 567
#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
typedef int YYSTYPE;
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
#endif
evolver-2.30c.dfsg/src/tordup.c 0000644 0001753 0001753 00000035221 11410765113 016701 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/***********************************************************************
*
* File: tordup.c
*
* Function: tordup()
*
* Purpose: Duplicate a torus configuration in the direction of
* one period. Meant for studying long-term behavior
* of Ostwald ripening on ever larger scales. Also good
* for duplicating a single cell and resolving vertices
* to try to beat Kelvin.
*/
#include "include.h"
static int v_count;
static int ecount;
static int fcount;
static int bcount;
static int fecount;
static element_id *vlist,*elist,*flist,*felist,*blist;
void tordup(m)
int m; /* period to duplicate, 0,1, or 2 */
{
vertex_id v_id;
edge_id e_id;
facet_id f_id;
body_id b_id;
facetedge_id fe_id;
facetedge_id new_fe;
facet_id new_f;
body_id new_b;
edge_id new_e;
int i,j;
REAL *x;
REAL adjust;
facetedge_id *body_fe_list;
v_count = web.skel[VERTEX].max_ord+1;
ecount = web.skel[EDGE].max_ord+1;
fcount = web.skel[FACET].max_ord+1;
bcount = web.skel[BODY].max_ord+1;
fecount = web.skel[FACETEDGE].max_ord+1;
/* allocate room for lists of old and new elements */
vlist = (element_id *)temp_calloc(sizeof(element_id),2*v_count);
elist = (element_id *)temp_calloc(sizeof(element_id),2*ecount);
flist = (element_id *)temp_calloc(sizeof(element_id),2*fcount);
blist = (element_id *)temp_calloc(sizeof(element_id),2*bcount);
felist = (element_id *)temp_calloc(sizeof(element_id),2*fecount);
body_fe_list = (element_id *)temp_calloc(sizeof(element_id),2*bcount);
/* record old body data */
FOR_ALL_BODIES(b_id)
{ blist[loc_ordinal(b_id)] = b_id;
body_fe_list[loc_ordinal(b_id)] = get_body_fe(b_id);
}
/* relocate new vertices */
FOR_ALL_VERTICES(v_id)
{ /* list old vertices */
i = loc_ordinal(v_id);
vlist[i] = v_id;
}
for ( i = 0 ; i < v_count ; i++ )
{ /* create corresponding new vertices */
v_id = vlist[i];
if ( !valid_id(v_id) ) continue;
vlist[i+v_count] = dup_vertex(v_id);
x = get_coord(vlist[i+v_count]);
for ( j = 0 ; j < SDIM ; j++ )
x[j] += web.torus_period[m][j];
}
/* fix edge endpoints */
FOR_ALL_EDGES(e_id)
{ /* list old edges */
i = loc_ordinal(e_id);
elist[i] = e_id;
}
for ( i = 0 ; i < ecount ; i++ )
{ /* create corresponding new edges */
vertex_id h,t;
WRAPTYPE wrap;
e_id = elist[i];
if ( !valid_id(e_id) ) continue;
new_e = dup_edge(e_id);
elist[i+ecount] = new_e;
h = get_edge_headv(e_id);
t = get_edge_tailv(e_id);
if ( web.modeltype == QUADRATIC )
{ free_element(get_edge_midv(new_e));
set_edge_midv(new_e,vlist[v_count+loc_ordinal(get_edge_midv(e_id))]);
}
wrap = get_edge_wrap(e_id);
if ( (wrap >> (TWRAPBITS*m)) & WRAPMASK )
{ remove_vertex_edge(h,inverse_id(e_id));
set_edge_headv(e_id,upgrade(h));
set_edge_headv(new_e,h);
set_edge_tailv(new_e,upgrade(t));
}
else
{ set_edge_headv(new_e,upgrade(h));
set_edge_tailv(new_e,upgrade(t));
}
}
/* new facets */
FOR_ALL_FACETS(f_id)
{
i = loc_ordinal(f_id);
flist[i]= f_id;
}
for ( i = 0 ; i < fcount ; i++ )
{ /* create corresponding new facets */
f_id = flist[i];
if ( !valid_id(f_id) ) continue;
new_f = dup_facet(f_id);
flist[i+fcount] = new_f;
}
/* new facet-edges */
FOR_ALL_FACETEDGES(fe_id)
{
i = loc_ordinal(fe_id);
felist[i] = fe_id;
}
for ( i = 0 ; i < fecount ; i++ )
{ /* create corresponding new facet-edges */
fe_id = felist[i];
if ( !valid_id(fe_id) ) continue;
f_id = get_fe_facet(fe_id);
e_id = get_fe_edge(fe_id);
new_fe = new_facetedge(upgrade(f_id),upgrade(e_id));
felist[i+fecount] = new_fe;
}
for ( i = 0 ; i < fecount ; i++ )
{ /* upgrade links */
fe_id = felist[i];
if ( !valid_id(fe_id) ) continue; /* only want old ones */
new_fe = upgrade(fe_id);
set_next_edge(new_fe,upgrade(get_next_edge(fe_id)));
set_prev_edge(new_fe,upgrade(get_prev_edge(fe_id)));
set_next_facet(new_fe,upgrade(get_next_facet(fe_id)));
set_prev_facet(new_fe,upgrade(get_prev_facet(fe_id)));
}
/* upgrade edge fe links */
for ( i = 0 ; i < ecount ; i++ )
{
e_id = elist[i];
if ( !valid_id(e_id) ) continue;
fe_id = get_edge_fe(e_id);
set_edge_fe(upgrade(e_id),upgrade(fe_id));
}
/* go around old facets, linking in new facetedges if necessary */
for ( i = 0 ; i < fcount ; i++ )
{
int newflag;
facetedge_id fe,first_fe,new_next_fe,next_fe;
f_id = flist[i];
if ( !valid_id(f_id) ) continue;
new_f = upgrade(f_id);
newflag = 0; /* whether we should be doing new fe's */
fe = first_fe = get_facet_fe(f_id);
if ( !valid_id(fe) ) continue;
set_facet_fe(new_f,upgrade(fe));
do
{
int sign;
new_fe = upgrade(fe);
if ( newflag )
{
set_fe_facet(fe,new_f);
set_fe_facet(new_fe,f_id);
}
next_fe = get_next_edge(fe);
new_next_fe = upgrade(next_fe);
sign = 0;
if ( !inverted(get_fe_edge(fe)) )
if ( get_fe_wrap(fe) & (WRAPMASK<<(TWRAPBITS*m)) )
sign++;
if ( inverted(get_fe_edge(next_fe)) )
if ( get_fe_wrap(next_fe) & (WRAPMASK<<(TWRAPBITS*m)) )
sign++;
if ( sign == 1 )
{
/* cross-link */
set_next_edge(fe,new_next_fe);
set_prev_edge(new_next_fe,fe);
set_next_edge(new_fe,next_fe);
set_prev_edge(next_fe,new_fe);
newflag = !newflag;
}
fe = next_fe;
}
while ( !equal_id(fe,first_fe) );
if ( newflag )
{ /* really only one facet, so get rid of new one */
fe = first_fe;
do
{
set_fe_facet(fe,f_id);
fe = get_next_edge(fe);
}
while ( !equal_id(fe,first_fe) );
free_element(new_f);
}
}
/* unwrapping appropriate edges */
for ( i = 0 ; i < ecount ; i++ )
{ WRAPTYPE mask = WRAPMASK<<(TWRAPBITS*m);
WRAPTYPE wrap,oldwrap,newwrap;
int wrapnum;
if ( !valid_id(elist[i]) ) continue;
wrap = get_edge_wrap(elist[i]);
wrapnum = WRAPNUM((wrap>>(TWRAPBITS*m)) & WRAPMASK);
oldwrap = (wrap & (~mask))|(((wrapnum>>1)&WRAPMASK)<<(TWRAPBITS*m));
newwrap = (wrap & (~mask))|((((wrapnum+1)>>1)&WRAPMASK)<<(TWRAPBITS*m));
set_edge_wrap(elist[i],oldwrap);
set_edge_wrap(elist[i+ecount],newwrap);
}
/* create corresponding new facets */
for ( i = 0 ; i < fcount ; i++ )
{
f_id = flist[i];
if ( !valid_id(f_id) ) continue;
new_f = flist[i+fcount];
/* erase body-facet links; will reset later */
set_facet_body(f_id,NULLBODY);
set_facet_body(inverse_id(f_id), NULLBODY);
set_facet_body(new_f,NULLBODY);
set_facet_body(inverse_id(new_f), NULLBODY);
}
/* new bodies */
for ( i = 0 ; i < bcount ; i++ )
{ /* create corresponding new facet-edges */
b_id = blist[i];
if ( !valid_id(b_id) ) continue;
new_b = dup_body(b_id);
blist[i+bcount] = new_b;
fe_id = body_fe_list[i];
f_id = get_fe_facet(fe_id);
set_facet_body(f_id,b_id);
/* reset, since was wiped earlier */
body_fe_list[bcount+i] = upgrade(fe_id);
if ( get_battr(b_id) & HAVE_CENTEROFMASS )
{ REAL *oldcm = get_body_cm(b_id);
REAL *newcm = get_body_cm(new_b);
oldcm[m] = 0.5;
newcm[m] = 0.5;
}
}
/* adjust facet bodies */
if ( web.representation == STRING )
{
for ( i = 0 ; i < fcount ; i++ )
if ( valid_id(flist[i]) )
{ b_id = get_facet_body(flist[i]);
if ( !valid_id(b_id) ) continue;
b_id = upgrade(b_id);
if ( valid_id(flist[i+fcount]) )
set_facet_body(flist[i+fcount],b_id);
else free_element(b_id);
}
}
else /* SOAPFILM */
{ /* have to go around finding contiguous facets of bodies */
int changeflag;
facet_id ff_id;
/* start with canonical facets of old bodies */
for ( i = 0 ; i < bcount ; i++ )
{
b_id = blist[i];
if ( !valid_id(b_id) ) continue;
f_id = get_body_facet(b_id);
set_facet_body(f_id,b_id);
}
/* go around finding adjacent facets */
do
{ facetedge_id sentinel;
changeflag = 0;
fe_id = NULLFACETEDGE;
while ( generate_all(FACETEDGE,&fe_id,&sentinel) )
{ if ( equal_id(get_next_facet(fe_id),fe_id) )
continue; /* valence 1 edge */
f_id = get_fe_facet(fe_id);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ ff_id = inverse_id(get_fe_facet(get_prev_facet(fe_id)));
if ( !valid_id(get_facet_body(ff_id)) )
{ set_facet_body(ff_id,b_id);
changeflag++;
}
}
invert(fe_id);
f_id = get_fe_facet(fe_id);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ ff_id = inverse_id(get_fe_facet(get_prev_facet(fe_id)));
if ( !valid_id(get_facet_body(ff_id)) )
{ set_facet_body(ff_id,b_id);
changeflag++;
}
}
}
} while ( changeflag );
/* now find new bodies whose canonical faces
have not been usurped */
for ( i = 0 ; i < bcount ; i++ )
{
b_id = blist[i+bcount];
if ( !valid_id(b_id) ) continue;
f_id = get_fe_facet(body_fe_list[i+bcount]);
if ( valid_id(get_facet_body(f_id)) )
{ /* two bodies are really one */
free_element(b_id);
set_body_volume(blist[i],2*get_body_volume(blist[i]),SETSTAMP);
set_body_oldvolume(blist[i],2*get_body_oldvolume(blist[i]));
if ( get_battr(b_id) & FIXEDVOL )
set_body_fixvol(blist[i],2*get_body_fixvol(blist[i]));
continue;
}
set_facet_body(f_id,b_id);
}
/* go around finding adjacent facets */
do
{ facetedge_id sentinel;
changeflag = 0;
fe_id = NULLFACETEDGE;
while ( generate_all(FACETEDGE,&fe_id,&sentinel) )
{ if ( equal_id(get_next_facet(fe_id),fe_id) )
continue; /* valence 1 edge */
f_id = get_fe_facet(fe_id);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ ff_id = inverse_id(get_fe_facet(get_prev_facet(fe_id)));
if ( !valid_id(get_facet_body(ff_id)) )
{ set_facet_body(ff_id,b_id);
changeflag++;
}
}
invert(fe_id);
f_id = get_fe_facet(fe_id);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ ff_id = inverse_id(get_fe_facet(get_prev_facet(fe_id)));
if ( !valid_id(get_facet_body(ff_id)) )
{ set_facet_body(ff_id,b_id);
changeflag++;
}
}
}
} while ( changeflag );
}
/* adjust torus period and inverse period matrix */
for ( i = 0 ; i < SDIM ; i++ )
{ sprintf(msg,"2*(%s)",print_express(&torus_period_expr[m][i],' '));
cmdptr = msg;
exparse(0,&torus_period_expr[m][i],USERCOPY);
cmdptr = NULL;
}
if ( web.torus_display_period )
for ( i = 0 ; i < SDIM ; i++ )
{ sprintf(msg,"2*(%s)",print_express(&torus_display_period_expr[m][i],' '));
cmdptr = msg;
exparse(0,&torus_display_period_expr[m][i],USERCOPY);
cmdptr = NULL;
}
calc_periods(NO_ADJUST_VOLUMES);
/* phase boundary energies */
if ( phase_flag && (web.representation == STRING) )
FOR_ALL_EDGES(e_id)
set_e_phase_density(e_id);
if ( phase_flag && (web.representation != STRING) )
FOR_ALL_FACETS(f_id)
set_f_phase_density(f_id);
if ( everything_quantities_flag )
reconvert_bodies_to_quantities();
/* free lists */
temp_free((char *)vlist);
temp_free((char *)elist);
temp_free((char *)flist);
temp_free((char *)blist);
temp_free((char *)felist);
temp_free((char *)body_fe_list);
/* fix up volconsts */
calc_content(Q_INFO|Q_FIXED); /* all volumes */
/* get volume of piece of unit cell */
if ( SDIM == 2 )
{
adjust = web.torusv /* /2 */;
}
else /* web.representation == SOAPFILM */
{
adjust = web.torusv /* /6 */;
}
/* adjust volconsts */
FOR_ALL_BODIES(b_id)
{ REAL vol = get_body_volume(b_id);
REAL old = get_body_oldvolume(b_id);
REAL vc = get_body_volconst(b_id);
REAL calcvol = vol-vc;
REAL newvc = old - calcvol;
newvc = adjust*floor(0.5+newvc/adjust);
set_body_volconst(b_id,newvc);
set_body_volume(b_id,calcvol+newvc,SETSTAMP);
}
top_timestamp = ++global_timestamp;
}
/**************************************************
*
* Function: upgrade()
*
* Purpose: Find the new element corresponding
* to an old element.
*/
element_id upgrade(id)
element_id id;
{
int j = loc_ordinal(id);
element_id new_id;
if ( !valid_id(id) ) return NULLID;
switch( id_type(id) )
{
case VERTEX: new_id = vlist[j+v_count];
if ( !equal_id(id,vlist[j]) ) invert(new_id);
break;
case EDGE : new_id = elist[j+ecount];
if ( !equal_id(id,elist[j]) ) invert(new_id);
break;
case FACET : new_id = flist[j+fcount];
if ( !equal_id(id,flist[j]) ) invert(new_id);
break;
case BODY : new_id = blist[j+bcount];
if ( !equal_id(id,blist[j]) ) invert(new_id);
break;
case FACETEDGE: new_id = felist[j+fecount];
if ( !equal_id(id,felist[j]) ) invert(new_id);
break;
default: new_id = NULLID;
}
return new_id;
}
/********************************************************************
*
* function: reconvert_bodies_to_quantities()
*
* purpose: straightens out body quantities after messing around
* with rebody() or tordup(). Erases all old instances
* and recreates whole structure.
*/
void reconvert_bodies_to_quantities()
{ int type;
int k;
struct method_instance *mi;
struct element *e_ptr;
body_id b_id;
element_id id;
for ( type = VERTEX ; type <= FACET ; type++ )
{ int meth_offset = get_meth_offset(type);
int *methlist;
FOR_ALL_ELEMENTS(type,id)
{ e_ptr = elptr(id);
methlist = (int*)((char*)e_ptr+meth_offset);
for ( k = 0 ; k < (int)e_ptr->method_count ; k++ )
{
mi = METH_INSTANCE(abs(methlist[k]));
if ( mi->flags & BODY_INSTANCE )
{ methlist[k] = methlist[--(e_ptr->method_count)];
k--;
}
}
}
}
FOR_ALL_BODIES(b_id)
convert_new_body_to_quantity(b_id);
convert_bodies_to_quantities();
}
evolver-2.30c.dfsg/src/userfunc.c 0000644 0001753 0001753 00000032374 11410765113 017224 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: userfunc.c
*
* Purpose: Lets user compile own function definitions for use in
* expressions. Function passed pointer to coordinate array.
* User should also provide derivative function.
* After defining functions, add names to arrays userfunc,
* userfunc_deriv, and userfunc_second that follow all the
* function definitions.
* Names in this file don't mattter; the first function
* in the arrays is usr1 in datafile or queries, etc.
* When invoked in Evolver formulas, these functions do
* not take arguments; arguments are implicitly point
* coordinates.
* Example: (usr1 + usr3)/usr10.
*
* Also has functions for handling dynamic load libraries.
* And elliptic functions.
*/
#include "include.h"
/**************************************************************************/
/**************************************************************************
*
* function: userfunc_init()
*
* purpose: called once at the start of a surface to give user functions
* a chance to initialize.
*/
void userfunc_init()
{
/* do whatever it takes to initialize user functions */
/* Example of error reporting.
kb_error(2201,"Error in userfunc_init\n",RECOVERABLE);
*/
}
/* usr1 as defined here gives conformal metric for 3-sphere in
stereographic projection */
REAL usr1 ARGS((REAL *));
REAL usr1_deriv ARGS((REAL *,REAL *));
REAL usr1_seconds ARGS((REAL *,REAL *,REAL **));
REAL usr1(x)
REAL *x; /* incoming parameters */
{ REAL denom;
denom = 4+x[0]*x[0]+x[1]*x[1]+x[2]*x[2];
return 16/denom/denom;
}
REAL usr1_deriv(x,partials)
REAL *x; /* incoming parameters */
REAL *partials; /* outgoing partial derivatives */
{ REAL denom,cube;
int i;
denom = 4+x[0]*x[0]+x[1]*x[1]+x[2]*x[2];
cube = denom*denom*denom;
for ( i = 0 ; i < SDIM ; i++ )
partials[i] = -64/cube*x[i];
return 16/denom/denom;
}
REAL usr1_seconds(x,partials,seconds)
REAL *x; /* incoming parameters */
REAL *partials; /* outgoing partial derivatives */
REAL **seconds; /* outgoing second derivatives */
{ REAL denom,cube,quart;
int i,j;
denom = 4+x[0]*x[0]+x[1]*x[1]+x[2]*x[2];
cube = denom*denom*denom;
quart = cube*denom;
for ( i = 0 ; i < SDIM ; i++ )
partials[i] = -64/cube*x[i];
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ )
seconds[i][j] = 384*x[i]*x[j]/quart;
seconds[i][i] -= 64/cube;
}
return 16/denom/denom;
}
/***************************************************************************/
/* Another example of a user function, which is a polynomial in x,y,z. */
/* This function is referred to as usr2 in expressions. */
static REAL usr_poly ARGS((REAL *));
static REAL usr_poly_grad ARGS((REAL *,REAL *));
static REAL usr_poly_hess ARGS((REAL *,REAL *,REAL **));
static REAL usr_poly(x)
REAL *x; /* incoming parameters */
{
return x[0]*x[0] + x[1]*x[2] + x[2]*x[2]*x[2];
}
static REAL usr_poly_grad(x,partials)
REAL *x; /* incoming parameters */
REAL *partials; /* outgoing partial derivatives */
{
partials[0] = 2*x[0];
partials[1] = x[2];
partials[2] = x[1] + 3*x[2]*x[2];
return x[0]*x[0] + x[1]*x[2] + x[2]*x[2]*x[2];
}
static REAL usr_poly_hess(x,partials,seconds)
REAL *x; /* incoming parameters */
REAL *partials; /* outgoing partial derivatives */
REAL **seconds; /* outgoing second derivatives */
{
partials[0] = 2*x[0];
partials[1] = x[2];
partials[2] = x[1] + 3*x[2]*x[2];
seconds[0][0] = 2.0;
seconds[0][1] = seconds[1][0] = 0.0;
seconds[0][2] = seconds[2][0] = 0.0;
seconds[1][1] = 0.0;
seconds[1][2] = seconds[2][1] = 1.0;
seconds[2][2] = 6*x[2];
return x[0]*x[0] + x[1]*x[2] + x[2]*x[2]*x[2];
}
/**************************************************************************/
/* Add your functions to these arrays; this is how they will be invoked! */
#ifdef NOPROTO
REAL (*userfunc[])() = {usr1,usr_poly};
REAL (*userfunc_deriv[])() = {usr1_deriv,usr_poly_grad};
REAL (*userfunc_seconds[])() = {usr1_seconds,usr_poly_hess};
#else
REAL (*userfunc[])(REAL*) = {usr1,usr_poly};
REAL (*userfunc_deriv[])(REAL*,REAL*) = {usr1_deriv,usr_poly_grad};
REAL (*userfunc_seconds[])(REAL*,REAL*,REAL**) = {usr1_seconds,usr_poly_hess};
#endif
/**************************************************************************/
/**************************************************************************/
/* A user defined attribute function. Undocumented. */
/* Use "user_attr" in queries like length or area or id */
REAL user_attribute(id)
element_id id;
{
/* a sample smorgasbord */
switch ( id_type(id) )
{ case VERTEX: return get_coord(id)[0];
case EDGE: return get_edge_length(id);
case FACET: return get_facet_area(id);
case BODY: return get_body_volume(id);
case FACETEDGE: return (REAL)(loc_ordinal(id)+1);
}
return 0.0;
}
/*********************************************************************
**********************************************************************
D Y N A M I C L O A D L I B R A R I E S
**********************************************************************
*********************************************************************/
/*********************************************************************
*
* function: load_library()
*
* purpose: Find and load dynamic library. Searches current directory,
* EVOLVERPATH, default library path.
*/
#ifdef WIN32
#define dlopen(name,mode) LoadLibrary(name)
#define dlclose(handle) FreeLibrary(handle)
#define dlsym(handle,name) GetProcAddress(handle,name)
#endif
void load_library(libname)
char *libname;
{
#ifdef ENABLE_DLL
int k;
char *env;
char path[200];
int len;
void *fd;
for ( k = 0 ; k < MAX_DLL ; k++ )
if ( dll_list[k].name == NULL ) break;
if ( k >= MAX_DLL )
kb_error(2202,"Too many dynamic load libraries.\n",DATAFILE_ERROR);
env = getenv("EVOLVERPATH");
/* try current directory first */
strcpy(path,"./");
strncpy(path+2,libname,sizeof(path)-2);
while ( (fd = dlopen(path,RTLD_NOW)) == NULL)
{ /* try paths in EVOLVERPATH */
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,libname,sizeof(path)-len-2);
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
/* try given name */
if ( ! fd )
{ strncpy(path,libname,sizeof(path));
fd = dlopen(path,RTLD_NOW);
}
if ( ! fd )
{ sprintf(errmsg,"Cannot open dynamic library %s. Reason:\n",libname);
#ifndef WIN32
strncpy(errmsg+strlen(errmsg),dlerror(),sizeof(errmsg)-strlen(errmsg)-2);
#endif
kb_error(2203,errmsg,DATAFILE_ERROR);
}
dll_list[k].name = mycalloc(1,strlen(libname)+4);
strcpy(dll_list[k].name,libname);
dll_list[k].handle = fd;
#else
kb_error(2204,"This Evolver not compiled for dynamic load libraries.\n",
DATAFILE_ERROR);
#endif
}
/*************************************************************************
*
* function: unload_libraries
*
* purpose: unload dynamic link libraries
*/
void unload_libraries()
{
int k;
for ( k = 0 ; k < MAX_DLL ; k++ )
if ( dll_list[k].name )
{ myfree(dll_list[k].name);
dll_list[k].name = NULL;
#ifdef ENABLE_DLL
dlclose(dll_list[k].handle);
dll_list[k].handle = NULL;
#endif
}
}
/*********************************************************************
*
* function: search_libraries()
*
* purpose: find function name in dynamic load libraries.
*
* return: pointer to function. NULL if not found.
*/
dll_func_type search_libraries(funcname)
char *funcname;
{
#ifdef ENABLE_DLL
int i;
dll_func_type f;
for ( i = 0 ; i < MAX_DLL ; i++ )
if ( dll_list[i].handle )
{ f = (dll_func_type)dlsym(dll_list[i].handle,funcname);
if ( f ) return f;
}
#endif
return NULL;
}
/****************************************************************************
E L L I P T I C F U N C T I O N S
****************************************************************************/
/*****************************
Complete elliptic integrals
*****************************/
REAL ellipticK(m)
REAL m;
{ REAL a,b,anext;
if ( m >= 1.0 )
kb_error(2422,"ellipticK domain violation, parameter >= 1.\n",RECOVERABLE);
a = 1.0;
b = sqrt(sqrt(1 - m));
while ( fabs(a-b) > machine_eps )
{ anext = (a + b)/2;
b = sqrt(sqrt(a*b*(a*a+b*b)/2));
a = anext;
}
return M_PI/2/a/a;
}
REAL ellipticE(m)
REAL m;
{ REAL a,b,anext;
REAL K,sum = 0;
REAL ff = 1.0;
if ( m > 1.0 )
kb_error(2423,"ellipticE domain violation, parameter > 1.\n",RECOVERABLE);
if ( m == 1.0 ) return 1.0;
a = 1.0;
b = sqrt(sqrt(1 - m));
while ( fabs(a-b) > machine_eps )
{ REAL aa = a*a, bb = b*b;
sum += ff*(aa*aa - (aa+bb)*(aa+bb)/4);
ff *= 4;
anext = (a + b)/2;
b = sqrt(sqrt(a*b*(a*a+b*b)/2));
a = anext;
}
K = M_PI/2/a/a;
return K*(1.0 - sum);
}
REAL ellipticEdm(m)
REAL m;
{ if ( m == 1.0 ) return 1.0e31;
return m==0 ? -M_PI/8 : (ellipticE(m) - ellipticK(m))/2/m;
}
REAL ellipticKdm(m)
REAL m;
{ return m==0 ? M_PI/8 : (ellipticE(m) - (1-m)*ellipticK(m))/2/m/(1-m);
}
REAL ellipticEdmdm(m)
REAL m;
{ return (m==0) ? -3./64*M_PI : ((m-2)*ellipticE(m) - 2*(m-1)*ellipticK(m))
/4/m/m/(1-m);
}
REAL ellipticKdmdm(m)
REAL m;
{ return (m == 0) ? 9./64*M_PI :
((4*m-2)*ellipticE(m) + (2-5*m+3*m*m)*ellipticK(m))/4/m/m/(1-m)/(1-m);
}
REAL incompleteEllipticFdphi(phi,m)
REAL phi,m;
{ return 1/sqrt(1 - m*sin(phi)*sin(phi));
}
/* following Abramowitz and Stegun 17.6 */
REAL incompleteEllipticE(phi,m)
REAL phi,m;
{ REAL p,tanp,a,b,c,poweroftwo,csum,E,csinphisum,F,K,retval;
REAL anext,bnext,cnext;
if ( m > 1.0 )
kb_error(2424,"incompleteEllipticE domain violation, parameter > 1.\n",
RECOVERABLE);
if ( m == 0 ) return phi;
p = phi;
tanp = tan(p);
a = 1.0;
b = sqrt(1-m);
c = sqrt(m);
poweroftwo = 1.0;
csum = c*c;
csinphisum = 0;
while ( c > machine_eps )
{
p = 2*p + atan((b/a - 1)*tanp/(1+b/a*tanp*tanp));
tanp = (1+b/a)*tanp/(1-b/a*tanp*tanp);
anext = (a+b)/2;
bnext = sqrt(a*b);
cnext = (a-b)/2;
a = anext; b = bnext; c = cnext;
poweroftwo *= 2;
csum += poweroftwo*c*c;
csinphisum += c*sin(p);
}
K = M_PI/2/a;
E = K - csum*K/2;
F = p/poweroftwo/a;
retval = E/K*F + csinphisum;
return retval;
}
REAL incompleteEllipticF(phi,m)
REAL phi,m;
{ REAL p,tanp,a,b,c,poweroftwo,csum,csinphisum,F;
REAL anext,bnext,cnext;
p = phi;
tanp = tan(p);
a = 1.0;
b = sqrt(1-m);
c = sqrt(m);
poweroftwo = 1.0;
csum = c*c;
csinphisum = 0;
if ( m > 1.0 )
kb_error(2425,"incompleteEllipticE domain violation, parameter > 1.\n",
RECOVERABLE);
if ( m == 0 ) return phi;
while ( c > machine_eps )
{
p = 2*p + atan((b/a - 1)*tanp/(1+b/a*tanp*tanp));
tanp = (1+b/a)*tanp/(1-b/a*tanp*tanp);
anext = (a+b)/2;
bnext = sqrt(a*b);
cnext = (a-b)/2;
a = anext; b = bnext; c = cnext;
poweroftwo *= 2;
csum += poweroftwo*c*c;
csinphisum += c*sin(p);
}
F = p/poweroftwo/a;
return F;
}
REAL incompleteEllipticEdphi(phi,m)
REAL phi,m;
{ return sqrt(1 - m*sin(phi)*sin(phi));
}
REAL incompleteEllipticEdm(phi,m)
REAL phi,m;
{ if ( m == 0 )
return -(2*phi-sin(2*phi))/8;
return (incompleteEllipticE(phi,m)-incompleteEllipticF(phi,m))/2/m;
}
REAL incompleteEllipticFdm(phi,m)
REAL phi,m;
{ if ( m == 0 )
return (2*phi-sin(2*phi))/8;
return incompleteEllipticE(phi,m)/2/(m-1)/m
- incompleteEllipticF(phi,m)/2/m
+ sin(2*phi)/4/(m-1)/sqrt(1-m*sin(phi)*sin(phi));
}
REAL incompleteEllipticEseconds(phi,m,dphi,dm,ddphi,ddm,dphidm)
REAL phi,m; /* input */
REAL *dphi,*dm,*ddphi,*ddm,*dphidm; /* output */
{ REAL E,F;
REAL s = sin(phi);
REAL s2 = sin(2*phi);
REAL d = sqrt(1-m*sin(phi)*sin(phi));
E = incompleteEllipticE(phi,m);
F = incompleteEllipticF(phi,m);
*dphi = d;
if ( m == 0 )
{ *dm = -(2*phi-s2)/8;
*ddm = -1./128*(12*phi-8*s2+sin(4*phi));
}
else
{ *dm = (E - F)/2/m;
*ddm = -1./8/(m-1)/m/m*(2*(m-2)*E - 4*(m-1)*F + m*s2/d);
}
*ddphi = -m*cos(phi)*s/d;
*dphidm = -s*s/2/d;
return E;
}
REAL incompleteEllipticFseconds(phi,m,dphi,dm,ddphi,ddm,dphidm)
REAL phi,m; /* input */
REAL *dphi,*dm,*ddphi,*ddm,*dphidm; /* output */
{ REAL E,F;
REAL s = sin(phi);
REAL s2 = sin(2*phi);
REAL d = sqrt(1-m*sin(phi)*sin(phi));
E = incompleteEllipticE(phi,m);
F = incompleteEllipticF(phi,m);
*dphi = 1/d;
if ( m == 0 )
{ *dm = (2*phi-s2)/8;
*ddm = 3./128*(12*phi-8*s2+sin(2*phi));
}
else
{ *dm = -E/2/(m-1)/m - F/2/m + s2/4/(m-1)/d;
*ddm = E/2/(m-1)/m/m + E/2/(m-1)/(m-1)/m
- (E-F)/4/(m-1)/m/m + F/2/m/m + s*s*s2/8/(m-1)/d/d/d
- s2/4/(m-1)/(m-1)/d + E/4/(m-1)/m/m
+ F/4/m/m - s2/8/m/(m-1)/d;
}
*ddphi = m*cos(phi)*s/d/d/d;
*dphidm = s*s/2/d/d/d;
return F;
}
evolver-2.30c.dfsg/src/resource.h 0000644 0001753 0001753 00000001022 11410765113 017210 0 ustar hazelsct hazelsct //{{NO_DEPENDENCIES}}
// Microsoft Developer Studio generated include file.
// Used by evolver.rc
//
#define IDI_ICON1 101
// Next default values for new objects
//
#ifdef APSTUDIO_INVOKED
#ifndef APSTUDIO_READONLY_SYMBOLS
#define _APS_NEXT_RESOURCE_VALUE 102
#define _APS_NEXT_COMMAND_VALUE 40001
#define _APS_NEXT_CONTROL_VALUE 1000
#define _APS_NEXT_SYMED_VALUE 101
#endif
#endif
evolver-2.30c.dfsg/src/include.h 0000644 0001753 0001753 00000041107 11410765113 017014 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**************************************************************
* File: include.h *
* Purpose: master include file for all Evolver source files. *
**************************************************************/
#if defined(WINTHREADS) || defined(PTHREADS)
#define THREADS
#define PARALLEL_MACHINE
#define SHARED_MEMORY
#endif
/* for tracking memory usage */
#ifdef MEMSTRINGS
#define mycalloc(num,size) kb_calloc(num,size,__FILE__,__LINE__)
#define temp_calloc(num,size) kb_temp_calloc(num,size,__FILE__,__LINE__)
#define temp_realloc(oldptr,size) kb_temp_realloc(oldptr,size,__FILE__,__LINE__)
#define kb_realloc(ptr,new) KB_realloc(ptr,new,__FILE__,__LINE__)
#define dmatrix(a,b,c,d) kb_dmatrix(a,b,c,d,__FILE__,__LINE__)
#define dmatrix3(a,b,c) kb_dmatrix3(a,b,c,__FILE__,__LINE__)
#define dmatrix4(a,b,c,d) kb_dmatrix4(a,b,c,d,__FILE__,__LINE__)
#define temp_dmatrix(a,b,c,d) kb_temp_dmatrix(a,b,c,d,__FILE__,__LINE__)
#define temp_dmatrix3(a,b,c) kb_temp_dmatrix3(a,b,c,__FILE__,__LINE__)
#define temp_dmatrix4(a,b,c,d) kb_temp_dmatrix4(a,b,c,d,__FILE__,__LINE__)
#define my_list_calloc(a,b,c) list_calloc(a,b,c,__FILE__,__LINE__)
#define my_list_realloc(a,b,c) list_realloc(a,b,c,__FILE__,__LINE__)
#else
#define mycalloc(num,size) kb_calloc(num,size)
#define temp_calloc(num,size) kb_temp_calloc(num,size)
#define temp_realloc(oldptr,size) kb_temp_realloc(oldptr,size)
#define kb_realloc(ptr,new) KB_realloc(ptr,new)
#define dmatrix(a,b,c,d) kb_dmatrix(a,b,c,d)
#define dmatrix3(a,b,c) kb_dmatrix3(a,b,c)
#define dmatrix4(a,b,c,d) kb_dmatrix4(a,b,c,d)
#define temp_dmatrix(a,b,c,d) kb_temp_dmatrix(a,b,c,d)
#define temp_dmatrix3(a,b,c) kb_temp_dmatrix3(a,b,c)
#define temp_dmatrix4(a,b,c,d) kb_temp_dmatrix4(a,b,c,d)
#define my_list_calloc(a,b,c) list_calloc(a,b,c)
#define my_list_realloc(a,b,c) list_realloc(a,b,c)
#endif
#include
/* speed up to replace rep stosd; assumes size multiple of int */
#ifdef KBMEMSET
#define memset0(dest,count) { int im; int *pm = (int*)(dest) ; \
for ( im = (count)/sizeof(int) ; im > 0 ; im-- ) *(pm++) = 0; }
#else
#define memset0(dest,count) memset(dest,0,count)
#endif
/* Precision */
#ifdef LONGDOUBLE
#define REAL long double
#define DOT dot
#define DWIDTH ((sizeof(REAL)==16) ? 35 : 22)
#define DPREC ((sizeof(REAL)==16) ? 32 : 19)
#else
#ifdef FLOAT
#define REAL float
#define DOT dotf
#define v3d v3f
#define v2d v2f
#else
#define REAL double
#define DOT dot
#endif
#endif
#ifdef USE_READLINE //CSL
#define MOREPROMPT (char *)1
#define CONTPROMPT (char *)2
#endif
/* following also works for Cray */
#ifdef GENERIC
/* Adjust header file names if yours are different */
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define drand48() ((REAL)rand()/RAND_MAX)
#define srand48(seed) srand(seed)
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
/* MAXALLOC is maximum size allocable by calloc() */
#define MAXALLOC 0x7FFFFFFFL
/* Some don't declare calloc, getenv, and bsearch in header files */
#if defined(__GNUC__) /* CSL */
/* PATHCHAR is name-separating character in paths */
#define PATHCHAR '/'
/* ENVPATHCHAR is the path separating character in environment strings */
#define ENVPATHCHAR ":"
#define FCAST (int(*)(const void*,const void *))
#else
char *calloc();
char *getenv();
char *bsearch();
/* PATHCHAR is name-separating character in paths */
#define PATHCHAR '/'
/* ENVPATHCHAR is the path separating character in environment strings */
#define ENVPATHCHAR ":"
/* NOPROTO should be defined for systems that don't do ANSI prototypes */
#define NOPROTO
#endif
#endif
#ifdef _HPUX_SOURCE
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
#define MAXALLOC 0x7FFFFFFFL
char *getenv();
#define PATHCHAR '/'
#define ENVPATHCHAR ":"
#define FCAST (int(*)(const void*,const void *))
#endif
#if defined(LINUX) || defined(__CYGWIN__)
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
/* MAXALLOC is maximum size allocable by calloc() */
#define MAXALLOC 0x7FFFFFFFL
/* Some don't declare calloc, getenv, and bsearch in header files */
/* Commenting these out now, since too many conflicts with headers.
#ifndef MAC_OS_X
char *calloc();
char *getenv();
char *bsearch();
#endif
*/
/* PATHCHAR is name-separating character in paths */
#define PATHCHAR '/'
/* ENVPATHCHAR is the path separating character in environment strings */
#define ENVPATHCHAR ":"
#define FCAST (int(*)(const void*,const void *))
#endif
#ifdef DECALPHA
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) finite(x)
#define MAXALLOC 0x7FFFFFFFL
char *getenv();
#define PATHCHAR '/'
#define ENVPATHCHAR ":"
#endif
#ifdef MAC_APP
/* this was done with THINK C */
/* Adjust header file names if yours are different */
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
/* MAXALLOC is maximum size allocable by calloc() */
#define MAXALLOC 0x7FFFFFFFL
/* Macs don't have environments */
#define getenv(a) ":fe;:doc"
/* PATHCHAR is name-separating character in paths */
#define PATHCHAR ':'
/* ENVPATHCHAR is the path separating character in environment strings */
#define ENVPATHCHAR ";"
#define drand48() ((REAL)rand()/RAND_MAX)
#define srand48(seed) srand(seed)
#define NOPIPE
/* cast for comparison functions for qsort() and bsearch() */
#define FCAST (__cmp_func)
/* to avoid Think C name conflict in a header file */
#define extend my_extend
#define NO_YACC_DEBUG
/* for workaround of Symantec 8.0.5 68K compiler bug */
#define ANSI_DEF
#endif
#ifdef MAC_CW
/* this was done with CODE WARRIOR */
/* Adjust header file names if yours are different */
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
/* MAXALLOC is maximum size allocable by calloc() */
#define MAXALLOC 0x7FFFFFFFL
/* Macs don't have environments */
#define getenv(a) ":fe;:doc;::fe;::doc;:::fe;:::doc"
/* PATHCHAR is name-separating character in paths */
#define PATHCHAR ':'
/* ENVPATHCHAR is the path separating character in environment strings */
#define ENVPATHCHAR ";"
#define drand48() ((REAL)rand()/RAND_MAX)
#define srand48(seed) srand(seed)
#define NOPIPE
/* cast for comparison functions for qsort() and bsearch() */
#define FCAST (void*)
/* to avoid Think C name conflict in a header file */
#define extend my_extend
/* for workaround of Symantec 8.0.5 68K compiler bug */
#define ANSI_DEF
#endif
#ifdef IRIS
/* this weirdness was needed on an IRIX 5.2 machine */
/* due to inconsistent use of _SIZE_T and _SIZE_T_ in headers */
#if !defined(_SIZE_T) && !defined(_SIZE_T_)
typedef unsigned size_t;
#endif
#define _SIZE_T
#define _SIZE_T_
/* Kludge for IRIX 6.5 */
#include
#undef isalpha
#undef isdigit
#undef isprint
#undef islower
#undef isupper
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) finite(x)
#define MAXALLOC 0x7FFFFFFFL
#define PATHCHAR '/'
#define ENVPATHCHAR ":"
#define FCAST (int(*)(const void*,const void *))
#ifdef SGI_MULTI
#define PARALLEL_MACHINE
#define SHARED_MEMORY
#define GET_THREAD_ID m_get_myid()
#include
extern int _fork(void (*)(), ...);
extern int _park_procs(void);
extern int _rele_procs(void);
extern void _sync(void);
extern int _kill_procs(void);
extern int _get_myid(void);
extern int _set_procs(int);
extern int _get_numprocs(void);
extern unsigned m_next(void);
extern void m_lock(void);
extern void m_unlock(void);
#endif
#endif
#ifdef SGI_MULTI
#include
#include
#define M_LOCK(addr) (locklist[0]?ussetlock(locklist[((long)(addr))&(_MAXLOCKS-1)]):0)
#define M_UNLOCK(addr) (locklist[0]?usunsetlock(locklist[((long)(addr))&(_MAXLOCKS-1)]):0)
#endif
#ifdef GCC
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
#define MAXALLOC 0x7FFFFFFFL
#ifdef MSDOS
#define PATHCHAR '\\'
#define ENVPATHCHAR ";"
#else
#define PATHCHAR '/'
#define ENVPATHCHAR ":"
#endif
#define FCAST (int(*)(const void*,const void *))
#define drand48() ((REAL)random()/0x7FFFFFFF)
#define srand48(seed) srandom(seed)
#endif
#ifdef SUN
#include
#include
#include
#include
#include
#ifdef strdup
#undef strdup
#endif
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) finite(x)
#define MAXALLOC 0x7FFFFFFFL
char *getenv();
/* char *calloc(); */
#define PATHCHAR '/'
#define ENVPATHCHAR ":"
/* #define memmove(dest,src,n) kb_memmove(dest,src,n) */
#define NOPROTO
#define FCAST (int(*)(const void*,const void *))
/* following is to undo something mysterious done by prof.h */
#undef MARK
#endif
#ifdef MSC
#define _CRT_SECURE_NO_DEPRECATE 1
#pragma warning(disable:4996)
#include
#define _USERENTRY
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
#ifndef MAXINT
#define MAXINT INT_MAX
#endif
#define MAXALLOC 0x7FFFFFFFL
#define PATHCHAR '\\'
#define ENVPATHCHAR ";"
#define farcalloc(num,size) (void far *)halloc(num,size)
#define farfree(ptr) hfree((void huge *)ptr)
#define FCAST (int(*)(const void*,const void *))
#define NOPIPEXX
#define popen _popen
#define pclose _pclose
#define _export
#define FPRESET _fpreset()
/* since graphics in parallel thread */
#define PARALLEL_MACHINE
#endif
#if defined(__WIN32__) && !defined(__CYGWIN__)
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#define is_finite(x) (((x)>(-1e300))&&((x)<1e300))
#define MAXALLOC 0x7FFFFFFFL
#define PATHCHAR '\\'
#define ENVPATHCHAR ";"
#define NOPIPEXX
#pragma hdrstop
/* so qsort() and bsearch() below agree with prototypes */
#define FCAST (int(*)(const void*,const void *))
#define drand48() ((REAL)rand()/RAND_MAX)
#define srand48(seed) srand(seed)
#else
#define __int32 int
#endif
#ifdef MAC_OS_X
/* rogue constant from some header */
#endif
#ifdef MPI_EVOLVER
#define PARALLEL_MACHINE
#include "mpi.h"
#undef MPI_REAL
#ifdef LONG_DOUBLE
#define MPI_REAL MPI_LONG_DOUBLE
#elif defined(FLOAT)
#define MPI_REAL MPI_FLOAT
#else
#define MPI_REAL MPI_DOUBLE
#endif
#define MPI_EXPORT_MAX 4
#endif
#ifndef SGI_MULTI
#define m_get_myid() 0
#endif
#ifdef TC
#define atold _atold
#endif
#ifndef TC
#ifndef huge
#define huge
#endif
#endif
#ifndef FCAST
#define FCAST
#endif
typedef int DY_OFFSET ;
/* Some don't have these manifest constants in math.h (namely, Microsoft) */
#ifndef M_LN2
#define M_E 2.71828182845904523536
#define M_PI 3.14159265358979323846
#define M_LN2 0.693147180559945309417
#endif
#ifdef LONGDOUBLE
#undef M_E
#define M_E 2.7182818284590452353602874713527L
#undef M_PI
#ifdef TC
#define M_PI (atan(1.0)*4)
#else
#define M_PI 3.1415926535897932384626433832795L
#endif
#undef M_LN2
#define M_LN2 0.693147180559945309417L
#endif
#ifndef DBL_EPSILON
#define DBL_EPSILON 2.2204460492503131e-16
#endif
/* can undefine or redefine these if your system has decent string functions */
#ifndef stricmp
#define stricmp(s1,s2) kb_stricmp((s1),(s2))
#define strnicmp(s1,s2,n) kb_strnicmp((s1),(s2),(n))
#endif
#ifndef strstr
#define strstr(s1,s2) kb_strstr((s1),(s2))
#endif
#ifndef strupr
#define strupr(a) kb_strupr(a)
#endif
/* Since tolower and toupper don't always check case before converting */
#undef tolower
#undef toupper
#ifndef MSC
#define tolower(c) (isupper(c) ? ((c)-'A'+'a') : c)
#define toupper(c) (islower(c) ? ((c)-'a'+'A') : c)
#endif
#ifndef MAXDOUBLE
#define MAXDOUBLE 1.0e38
#endif
#ifdef NOPROTO
/* some compilers still don't like prototypes with arguments */
#define ARGS(x) ()
#else
#define ARGS(x) x
#endif
/* for converting old-style function defs to new */
#ifdef __cplusplus
#define ARGS1(old,a) (a)
#define ARGS2(old,a,b) (a,b)
#define ARGS3(old,a,b,c) (a,b,c)
#define ARGS4(old,a,b,c,d) (a,b,c,d)
#define ARGS5(old,a,b,c,d,e) (a,b,c,d,e)
#define ARGS6(old,a,b,c,d,e,f) (a,b,c,d,e,f)
#define CONST const
#else
#define ARGS1(old,a) old a;
#define ARGS2(old,a,b) old a; b;
#define ARGS3(old,a,b,c) old a; b; c;
#define ARGS4(old,a,b,c,d) old a; b; c; d;
#define ARGS5(old,a,b,c,d,e) old a; b; c; d; e;
#define ARGS6(old,a,b,c,d,e,f) old a; b; c; d; e; f;
#ifndef CONST
#define CONST
#endif
#endif
#ifdef ENABLE_DLL
#ifndef WIN32
#include
#endif
#endif
#ifdef USE_READLINE
#include
#include
#endif
#ifdef PTHREADS
#include
#endif
/* Evolver header files */
#ifdef __cplusplus
extern "C" {
#endif
#include "model.h"
#include "storage.h"
#include "skeleton.h"
#include "extern.h"
#include "express.h"
#include "quantity.h"
#include "web.h"
#include "lex.h"
#ifdef __cplusplus
}
#endif
#include "proto.h"
/* in case of non-parallel machines */
#ifndef M_LOCK
#define M_LOCK(addr)
#define M_UNLOCK(addr)
#endif
#ifndef MAXINT
#define MAXINT (~(1<<(8*sizeof(int)-1)))
#endif
#ifndef FPRESET
#define FPRESET
#endif
#if defined(LONGDOUBLE) && !defined(NOLONGMATHFUNC)
/* have to do these after math.h */
#define sin sinl
#define cos cosl
#define tan tanl
#define asin asinl
#define acos acosl
#define atan atanl
#define sinh sinhl
#define cosh coshl
#define tanh tanhl
#define asinh asinhl
#define acosh acoshl
#define atanh atanhl
#define exp expl
#define log logl
#define pow powl
#define sqrt sqrtl
#define ceil ceill
#define fabs fabsl
extern REAL fabsl(REAL); /* wasn't in IRIX6.1 math.h */
#define floor floorl
#define fmod fmodl
#define modf modfl
#ifdef LINUX
long double strtold(const char *, char **);
#define atof(a) strtold(a,NULL)
#else
#define atof atold
#endif
#endif
#ifdef INLINE
#include "inline.h"
#endif
/* for things we really want to be plain double */
#ifndef DOUBLE
#define DOUBLE double
#endif
#ifdef MSC
#define toupper(c) kb_upper_array[c]
#define tolower(c) kb_lower_array[c]
#endif
#ifdef MPI_EVOLVER
#include "mpi_evolver.h"
#endif
evolver-2.30c.dfsg/src/verpopst.c 0000644 0001753 0001753 00000101035 11410765113 017243 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/******************************************************************
*
* File: verpopst.c
*
* Purpose: In string model, pop vertices with 4 or more edges into
* a configuration of vertices with only 3 edges each.
* Works in 3-space. No assumptions about edges bounding
* facets or not, but does treat facets properly.
*/
#include "include.h"
/*********************************************************************
*
* Function: verpop_str()
*
* Purpose: Assembles list of edges for each vertex, and calls
* single-vertex routine for vertices with more than 3
* edges. List is first made as list of edge-vertex
* pairs, then sorted on vertex. Also deletes
* bare, nonfixed vertices.
*
* Return: Number of vertices popped.
*/
int verpop_str()
{ vertex_id v_id;
int popcount = 0;
FOR_ALL_VERTICES(v_id)
{ int valence = get_vertex_evalence(v_id);
if ( valence == 0 ) popcount += dissolve_vertex(v_id);
else if ( valence > 3 )
popcount += poponest(v_id,valence);
else if ( (valence >= 2) && (get_vattr(v_id) & (CONSTRAINT|BOUNDARY)) )
popcount += poponest(v_id,valence);
}
if ( popcount )
{ calc_content(Q_FIXED);
calc_pressure();
calc_energy();
}
return popcount;
}
/**************************************************************************
*
* function: pop_string_vertex()
*
* purpose: try popping given vertex; implements pop vertex in string model.
*/
int pop_string_vertex(v_id)
vertex_id v_id;
{ int valence = get_vertex_evalence(v_id);
int popcount = 0;
if ( valence == 0 ) popcount = dissolve_vertex(v_id);
else if ( valence > 3 )
popcount = poponest(v_id,valence);
else if ( (valence >= 2) && (get_vattr(v_id) & (CONSTRAINT|BOUNDARY)) )
popcount = poponest(v_id,valence);
return popcount;
}
/*****************************************************************************
*
* function: poponest()
*
* purpose: pop vertex with more that 3 edges
*
*/
/* comparison routine for qsort */
static int vecomp(a,b)
struct veredge *a,*b;
{
if ( a->v_id < b->v_id ) return -1;
if ( a->v_id > b->v_id ) return 1;
return 0;
}
int poponest(v_id,edges)
vertex_id v_id;
int edges; /* number of edges at this vertex */
{ edge_id e_id;
int i,j;
vertex_id new_v;
edge_id new_e;
facetedge_id fe_id;
REAL cosine,maxcos;
REAL *x;
int si=0,sj=0;
struct side_x { edge_id e_id; /* which edge */
REAL vec[MAXCOORD]; /* side vector, from vertex */
REAL norm; /* length of side */
} *side;
if ( valid_id ( get_vertex_fe(v_id) ) )
return new_popverst(v_id,edges);
side = (struct side_x *)temp_calloc(sizeof(struct side_x),edges);
/* get edge vectors */
e_id = get_vertex_edge(v_id);
for ( i = 0 ; i < edges ; i++ )
{
side[i].e_id = e_id;
get_edge_tail_tangent(e_id,side[i].vec);
side[i].norm = sqrt(SDIM_dot(side[i].vec,side[i].vec));
e_id = get_next_tail_edge(e_id);
}
while ( edges > 3 )
{
/* find closest pair of edges */
maxcos = -2.0;
for ( i = 0 ; i < edges ; i++ )
{
for ( j = i+1 ; j < edges ; j++ )
{
cosine = SDIM_dot(side[i].vec,side[j].vec)/ side[i].norm/side[j].norm;
if ( cosine > maxcos )
{
/* toss in a little randomness if a choice of ways */
/* but big problem if edges not adjacent! */
/* if ( (maxcos > -0.5) && (rand() & 0x0100) ) continue; */
maxcos = cosine;
si = i;
sj = j;
}
}
}
/* split off edges si and sj */
new_v = dup_vertex(v_id); /* new vertex in same spot */
new_e = new_edge(v_id,new_v,NULLID);
set_edge_color(new_e,BLACK);
remove_vertex_edge(v_id,side[si].e_id);
set_edge_tailv(side[si].e_id,new_v);
remove_vertex_edge(v_id,side[sj].e_id);
set_edge_tailv(side[sj].e_id,new_v);
if ( get_vattr(v_id) & BOUNDARY )
set_edge_boundary_num(new_e,get_edge_boundary(v_id)->num);
/* take care of facet incidences, assuming plane configuration */
do
{ facetedge_id first_fe;
fe_id = first_fe = get_edge_fe(side[si].e_id);
if ( valid_id(fe_id) )
do
{
edge_id next_e;
facetedge_id next_fe,new_fe,other_fe;
facet_id f_id;
/* see if this facet got split */
next_fe = get_prev_edge(fe_id);
next_e = get_fe_edge(next_fe);
if ( equal_id(inverse_id(side[sj].e_id),next_e) ) goto loopbottom;
/* install new facetedge */
f_id = get_fe_facet(fe_id);
new_fe = new_facetedge(f_id,new_e);
set_prev_edge(fe_id,new_fe);
set_next_edge(next_fe,new_fe);
set_prev_edge(new_fe,next_fe);
set_next_edge(new_fe,fe_id);
other_fe = get_edge_fe(new_e);
if ( valid_id(other_fe) )
{
set_next_facet(new_fe,other_fe);
set_prev_facet(new_fe,other_fe);
set_prev_facet(other_fe,new_fe);
set_next_facet(other_fe,new_fe);
}
else
{
set_edge_fe(new_e,new_fe);
set_next_facet(new_fe,new_fe);
set_prev_facet(new_fe,new_fe);
}
loopbottom:
fe_id = get_next_facet(fe_id);
} while ( valid_id(fe_id) && !equal_id(fe_id,first_fe) );
/* swap roles of sj and si */
i = sj; sj = si; si = i;
}
while ( sj < si ); /* exit when swapped back */
/* adjust edge list for another round, if necessary */
/* direction of new edge is average of old two */
/* Also move new vertex a little ways away to avoid zero edge */
edges --;
x = get_coord(new_v);
for ( i = 0 ; i < SDIM ; i++ )
{
side[si].vec[i] = side[si].vec[i]/side[si].norm
+ side[sj].vec[i]/side[si].norm;
x[i] += 0.000001 * side[si].vec[i];
}
side[si].norm = sqrt(SDIM_dot(side[si].vec,side[si].vec));
side[si].e_id = new_e;
if ( sj < edges ) /* trim top of list */
side[sj] = side[edges];
if ( phase_flag && (web.representation == STRING) )
set_e_phase_density(new_e);
else
set_edge_density(new_e,(get_edge_density(side[si].e_id)
+ get_edge_density(side[sj].e_id))/2);
}
temp_free((char *)side);
return 1;
}
/*****************************************************************************
*
* function: new_popverst()
*
* purpose: pop vertex with more that 3 edges with variable density
* Finds pair with greatest net force, allowing for force
* of introduced edge.
*
*/
struct side_t { edge_id e_id; /* which edge */
facetedge_id fe; /* canonical fe */
REAL vec[MAXCOORD]; /* side vector, from vertex */
REAL norm; /* length of side */
REAL density;
int degfree; /* degrees of freedom */
} ;
int anglecomp ARGS((struct side_t *,struct side_t *));
int anglecomp(a,b)
struct side_t *a,*b;
{ REAL aa = atan2(a->vec[1],a->vec[0]);
REAL bb = atan2(b->vec[1],b->vec[0]);
if ( aa < bb ) return -1;
if ( aa > bb ) return 1;
return 0;
}
int new_popverst(v_id,edges)
vertex_id v_id; /* vertex being popped */
int edges; /* number of edges at this vertex */
{
int i,j,m;
int besti;
vertex_id new_v;
edge_id new_e;
edge_id e_id,first_e;
edge_id e1,e2; /* edges to be pulled out */
REAL *x;
facet_id f1,f2;
REAL ff,f[MAXCOORD],fproj[MAXCOORD],ffmax;
REAL new_density=0.0;
struct side_t *side;
REAL bestmove[MAXCOORD];
facetedge_id fe_id,new_fe1,new_fe2,other_fe;
int attr1,attr2,attrv;
REAL cosa;
facetedge_id fe;
int degfree; /* degrees of freedom of popping vertex */
struct boundary *vbdry; /* boundary of popping vertex */
conmap_t *vmap,*emap; /* constraint list of popping vertex */
/* First, quick checks to rule out most vertices */
edges = get_vertex_evalence(v_id);
attrv = get_vattr(v_id);
if ( !(attrv&FIXED) && !(attrv&(BOUNDARY|CONSTRAINT)) && (edges <= 3) )
return 0; /* typical interior vertex */
if ( edges <= 1 ) return 0;
/* Now, we have to get more detailed info */
/* Get degrees of freedom of vertex */
degfree = SDIM;
if ( attrv & FIXED ) degfree = 0;
else if ( attrv & BOUNDARY )
{ vbdry = get_boundary(v_id);
if ( (vbdry->attr & NONWALL) )
degfree = vbdry->pcount;
}
else if ( attrv & CONSTRAINT )
{ vmap = get_v_constraint_map(v_id);
for ( i = 1; i <= (int)vmap[0] ; i++ )
if (!((get_constraint(vmap[i])->attr)&(NONPOSITIVE|NONNEGATIVE|NONWALL)))
degfree--;
}
side = (struct side_t *)temp_calloc(edges+1,sizeof(struct side_t));
/* get edge vectors */
e_id = first_e = get_vertex_edge(v_id);
for ( i = 0 ; i < edges ; i++ )
{
if ( !valid_id(e_id) )
{ sprintf(errmsg,"Pop vertex: Invalid edge at vertex %s.\n",
ELNAME(v_id));
kb_error(1382,errmsg,RECOVERABLE);
}
/* Get degrees of freedom of edge */
attr1 = get_eattr(e_id);
side[i].degfree = SDIM;
if ( attr1 & FIXED ) side[i].degfree = 0;
else if ( attr1 & BOUNDARY )
{ if ( !(get_edge_boundary(e_id)->attr & NONWALL) )
side[i].degfree = get_edge_boundary(e_id)->pcount;
}
else if ( attr1 & CONSTRAINT )
{ emap = get_e_constraint_map(e_id);
for ( j = 1; j <= (int)emap[0] ; j++ )
if (!((get_constraint(emap[j])->attr)&(NONPOSITIVE|NONNEGATIVE|NONWALL)))
side[i].degfree--;
}
side[i].e_id = e_id;
side[i].fe = get_edge_fe(e_id);
if ( valid_id(side[i].fe) )
{ f1 = get_fe_facet(side[i].fe);
if ( valid_id(f1) && inverted(f1) )
side[i].fe = get_next_facet(side[i].fe);
}
get_edge_tail_tangent(side[i].e_id,side[i].vec);
side[i].norm = sqrt(SDIM_dot(side[i].vec,side[i].vec));
if ( side[i].norm <= 0.0 )
{ sprintf(errmsg,"verpop: edge %s length zero. \n",
ELNAME(side[i].e_id));
kb_error(1383,errmsg,WARNING);
temp_free((char *)side);
return 0;
}
side[i].density = get_edge_density(side[i].e_id);
e_id = get_next_tail_edge(e_id);
if ( equal_id(e_id,first_e) && ( i < edges-1 ) )
{ sprintf(errmsg,
"Internal error: Expected %d edges; found %d.\n",edges,i+1);
outstring(errmsg);
kb_error(1384,
"new_popverst(): Not expected number of edges around vertex\n",
RECOVERABLE);
}
}
if ( edges==3 )
if ( ( (side[0].degfree <= degfree) ? 1:0 )
+ ( (side[1].degfree <= degfree) ? 1:0 )
+ ( (side[2].degfree <= degfree) ? 1:0 ) >= 2 )
{ temp_free((char *)side);
return 0;
}
/* order edges around vertex geometrically */
/*
if ( SDIM == 2 )
qsort((char*)side,edges,sizeof(struct side_t),FCAST anglecomp);
else
*/
{ /* see if we can use facet info */
facetedge_id fe;
int top,bottom;
int ends = 0; /* can have at most two ends of facet fan */
for ( i = 0 ; i < edges ; i++ )
{ if ( !valid_id(get_fe_facet(side[i].fe)) ) goto order_fail;
if ( equal_id(get_next_facet(side[i].fe),side[i].fe) ) ends++;
}
if ( (ends != 0) && (ends != 2) ) goto order_fail;
if ( ends == 2 )
{ /* move an end to the first slot */
for ( i = 0 ; i < edges ; i++ )
{ if ( equal_id(get_next_facet(side[i].fe),side[i].fe) )
{ struct side_t temp;
if ( i == 0 ) break;
temp = side[0];
side[0] = side[i];
side[i] = temp;
break;
}
}
}
/* now trace path around facets */
fe = side[0].fe;
for ( i = 1 ; i < edges ; i++ )
{ facetedge_id next_fe = inverse_id(get_prev_edge(fe));
edge_id next_e = get_fe_edge(next_fe);
for ( j = i; j < edges ; j++ )
if ( equal_id(side[j].e_id,next_e) )
{ struct side_t temp;
if ( i == j ) break;
temp = side[j];
side[j] = side[i];
side[i] = temp;
break;
}
if ( j == edges ) goto order_fail;
fe = get_next_facet(next_fe);
}
goto order_succeed;
order_fail:
/* try geometric ordering by adding closest to existing chain */
/* Leave first where it is, as initial link in chain */
side[edges] = side[0];
top = edges;
bottom = 0;
while ( top - bottom > 1 )
{ REAL topgap,bottomgap,topcos,bottomcos;
int topbest=0,bottombest=0;
bottomgap = topgap = -1e30;
for ( i = bottom+1 ; i < top ; i++ )
{ bottomcos = SDIM_dot(side[i].vec,side[bottom].vec)/
side[i].norm/side[bottom].norm;
if ( bottomcos > bottomgap )
{ bottomgap = bottomcos; bottombest = i; }
topcos = SDIM_dot(side[i].vec,side[top].vec)/
side[i].norm/side[top].norm;
if ( topcos > topgap )
{ topgap = topcos; topbest = i; }
}
if ( topgap > bottomgap )
{ /* add at top */
top--;
if ( topbest != top )
{ struct side_t temp = side[top];
side[top] = side[topbest];
side[topbest] = temp;
}
}
else
{ /* add at bottom */
bottom++;
if ( bottombest != bottom )
{ struct side_t temp = side[bottom];
side[bottom] = side[bottombest];
side[bottombest] = temp;
}
}
}
order_succeed: ;
}
side[edges] = side[0]; /* easy wraparound */
if ( edges == 2 )
{ /* must be constraint or boundary or fixed */
if ( (side[0].degfree <= degfree) || (side[1].degfree <= degfree ) )
{ temp_free((char *)side);
return 0;
}
if ( (side[0].degfree <= 1 ) && (side[1].degfree <= 1 ) )
{ temp_free((char *)side);
return 0;
}
besti = 0;
/* find angle between edges to see which way we want to pop */
cosa = SDIM_dot(side[0].vec,side[1].vec);
e1 = side[0].e_id;
e2 = side[1].e_id;
if ( (side[0].degfree > degfree) && (side[1].degfree > degfree) &&
(degfree >= 1) && (cosa < 0.0) )
{ /* split apart along constraint rather than make Y */
if ( verbose_flag )
{ sprintf(msg,"Popping vertex %s.\n",ELNAME(v_id));
outstring(msg);
}
new_v = dup_vertex(v_id); /* new vertex in same spot, to be pulled out */
attrv = get_vattr(new_v);
remove_vertex_edge(v_id,e2);
set_edge_tailv(e2,new_v);
fe = get_edge_fe(e1);
set_prev_edge(fe,inverse_id(fe));
fe = get_edge_fe(e2);
set_prev_edge(fe,inverse_id(fe));
goto newpop_exit;
}
}
if ( pop_disjoin_flag && (edges == 4) )
{ /* see if exactly two opposite wedges have same body */
facetedge_id fe_id[4];
facet_id f_id[4];
body_id b_id[4];
int same02,same13;
REAL *xnew,*xold,*x0,*x1,*x2,*x3;
for ( i = 0 ; i < edges ; i++ )
{ /* assume positive facets on bodies */
fe_id[i] = get_edge_fe(side[i].e_id);
if ( !valid_id(fe_id[i]) )
{ f_id[i] = b_id[i] = NULLID;
continue;
}
f_id[i] = get_fe_facet(fe_id[i]);
if ( inverted(f_id[i]) )
{ fe_id[i] = get_next_facet(fe_id[i]);
f_id[i] = get_fe_facet(fe_id[i]);
if ( inverted(f_id[i]) )
{ f_id[i] = b_id[i] = fe_id[i] = NULLID;
continue;
}
}
b_id[i] = get_facet_body(f_id[i]);
}
same02 = equal_id(b_id[0],b_id[2]) && valid_id(b_id[0]);
same13 = equal_id(b_id[1],b_id[3]) && valid_id(b_id[1]);
if ( same02 != same13 )
{ /* do the disjoin */
if ( same13 )
{ /* shuffle things so same02 */
element_id temp;
struct side_t tempside = side[0];
side[0] = side[1]; side[1] = side[2]; side[2] = side[3];
side[3] = tempside;
temp = fe_id[0]; fe_id[0] = fe_id[1]; fe_id[1] = fe_id[2];
fe_id[2] = fe_id[3]; fe_id[3] = temp;
temp = f_id[0]; f_id[0] = f_id[1]; f_id[1] = f_id[2];
f_id[2] = f_id[3]; f_id[3] = temp;
temp = b_id[0]; b_id[0] = b_id[1]; b_id[1] = b_id[2];
b_id[2] = b_id[3]; b_id[3] = temp;
}
/* now the real action */
new_v = dup_vertex(v_id); /* new vertex in same spot */
remove_vertex_edge(v_id,side[1].e_id);
set_edge_tailv(side[1].e_id,new_v);
remove_vertex_edge(v_id,side[2].e_id);
set_edge_tailv(side[2].e_id,new_v);
if ( valid_id(f_id[0]) )
{ /* have to merge facets */
facetedge_id fe_a = fe_id[0];
facetedge_id fe_b = inverse_id(get_prev_edge(fe_a));
facetedge_id fe_c = fe_id[2];
facetedge_id fe_d = inverse_id(get_prev_edge(fe_c));
set_prev_edge(fe_a,inverse_id(fe_d));
set_prev_edge(fe_b,inverse_id(fe_c));
set_prev_edge(fe_c,inverse_id(fe_b));
set_prev_edge(fe_d,inverse_id(fe_a));
if ( !equal_id(f_id[0],f_id[2]) )
{ /* merge f_id[2] into f_id[1] */
facetedge_id fe = fe_c;
do
{ set_fe_facet(fe,f_id[0]);
fe = get_next_edge(fe);
} while ( valid_id(fe) && !equal_element(f_id[0],get_fe_facet(fe)) );
fe = inverse_id(fe_d);
do
{ set_fe_facet(fe,f_id[0]);
fe = get_prev_edge(fe);
} while ( valid_id(fe) && !equal_element(f_id[0],get_fe_facet(fe)) );
set_facet_body(f_id[2],NULLID);
free_element(f_id[2]);
}
}
/* spread the vertices a bit */
xold = get_coord(v_id);
xnew = get_coord(new_v);
x0 = side[0].vec;
x1 = side[1].vec;
x2 = side[2].vec;
x3 = side[3].vec;
for ( i = 0 ; i < SDIM ; i++ )
{ xold[i] += 0.05*x0[i] - 0.05*x1[i] - 0.05*x2[i] + 0.05*x3[i];
xnew[i] += -0.05*x0[i] + 0.05*x1[i] + 0.05*x2[i] - 0.05*x3[i];
}
temp_free((char *)side);
return 1;
}
/* else fall through and do ordinary wedge splitting */
}
/* If here, want to do Y pull out */
/* find two edges that pull apart the most */
ffmax = 0.01; /* margin to prevent looping with autopop */
besti = -1;
for ( i = 0 ; i < edges ; i++ )
{
e1 = side[i].e_id;
e2 = side[i+1].e_id;
/* test to see if this pair is valid */
if ( side[i].degfree < 1 ) continue;
if ( side[i+1].degfree < 1 ) continue;
attr1 = get_eattr(e1);
attr2 = get_eattr(e2);
if ( get_edge_boundary(e1) != get_edge_boundary(e2) )
continue;
if ( (attr1 & CONSTRAINT) || (attr2 & CONSTRAINT) )
{ conmap_t *map1 = get_e_constraint_map(e1);
conmap_t *map2 = get_e_constraint_map(e2);
conmap_t ii,jj,found;
found = 0;
for ( ii = 1 ; ii <= map1[0] ; ii++ )
{ for ( jj = 1; jj <= map2[0] ; jj++ )
if ( map1[ii] == map2[jj] ) found++;
}
if ( (found != map1[0]) && ( found != map2[0]) )
continue;
}
if ( (edges <= 3) && (side[(6-i-i-1)%3].degfree <= degfree) )
{
if ((side[i].degfree <= degfree)||(side[i+1].degfree <= degfree) )
continue; /* fake wall ??? */
}
/* check to see if better than what we have */
for ( m = 0 ; m < SDIM ; m++ )
{ f[m] = (side[i].density*side[i].vec[m]/side[i].norm
+ side[i+1].density*side[i+1].vec[m]/side[i+1].norm);
}
if ( (degfree < SDIM) &&
((side[i].degfree <= degfree) || (side[i+1].degfree <= degfree)) )
{ force_project(f,v_id,fproj);
ff = sqrt(SDIM_dot(fproj,fproj));
}
else ff = sqrt(SDIM_dot(f,f));
if ( phase_flag )
{
f1 = get_fe_facet(get_prev_facet(side[i].fe));
f2 = get_fe_facet(side[i+1].fe);
new_density = phase_data[get_f_phase(f1)][get_f_phase(f2)];
}
else /* use minimal density of wedge edges */
{ REAL den1,den2;
den1 = get_edge_density(e1);
den2 = get_edge_density(e2);
new_density = (den1 < den2) ? den1 : den2;
}
if ( ff - new_density > ffmax )
{ REAL mag; /* size of new edge */
ffmax = ff - new_density ; besti = i;
mag = 0.1*((side[i].norm < side[i+1].norm) ?
side[i].norm : side[i+1].norm);
for ( m = 0 ; m < SDIM ; m++ )
bestmove[m] = mag*f[m]/ff;
}
}
if ( besti == -1 )
{ temp_free((char *)side);
return 0;
}
if ( verbose_flag )
{ sprintf(msg,"Popping vertex %s.\n",ELNAME(v_id));
outstring(msg);
}
/* split off edges besti and besti+1 */
e1 = side[besti].e_id;
e2 = side[besti+1].e_id;
attr1 = get_eattr(e1);
attr2 = get_eattr(e2);
new_v = dup_vertex(v_id); /* new vertex in same spot, to be pulled out */
attrv = get_vattr(new_v);
/* move new vertex a little ways away to avoid zero edge */
x = get_coord(new_v);
for ( i = 0 ; i < SDIM ; i++ )
x[i] += bestmove[i];
new_e = new_edge(v_id,new_v,NULLID);
set_edge_color(new_e,BLACK);
remove_vertex_edge(v_id,e1);
set_edge_tailv(e1,new_v);
remove_vertex_edge(v_id,e2);
set_edge_tailv(e2,new_v);
set_edge_density(new_e,new_density);
if ( (attr1 & NONCONTENT) || (attr2 & NONCONTENT) )
set_attr(new_e,NONCONTENT);
if ( (attr1 & NO_REFINE) || (attr2 & NO_REFINE) )
set_attr(new_e,NO_REFINE);
/* want to be careful here; new vertex and edge should get union of
properties of the two wedge edges */
unset_attr(new_v,FIXED);
if ( attrv & CONSTRAINT )
{ conmap_t *map = get_v_constraint_map(new_v);
for ( i = map[0] ; i >= 0 ; i-- ) map[i] = 0;
unset_attr(new_v,CONSTRAINT);
}
if ( attrv & BOUNDARY )
{ set_boundary_num(new_v,0);
unset_attr(new_v,BOUNDARY);
}
if ( (attr1 & CONSTRAINT) || (attr2 & CONSTRAINT) )
{ conmap_t *map1 = get_e_constraint_map(e1);
conmap_t *map2 = get_e_constraint_map(e2);
conmap_t i,j;
for ( i = 1 ; i <= map1[0] ; i++ )
{ set_v_constraint_map(new_v,map1[i]);
set_e_constraint_map(new_e,map1[i]);
}
for ( j = 1 ; j <= map2[0] ; j++ )
{ set_v_constraint_map(new_v,map2[j]);
set_e_constraint_map(new_e,map2[j]);
}
}
else if ( ((attr1 & BOUNDARY) || (attr2 & BOUNDARY))
&& (get_vattr(v_id) & BOUNDARY) )
{ struct boundary *b1 = get_edge_boundary(e1);
struct boundary *b2 = get_edge_boundary(e2);
struct boundary *bv = get_boundary(v_id);
if ( (b1 == bv) || (b2 == bv) )
{ set_edge_boundary_num(new_e,bv->num);
set_boundary_num(new_v,bv->num);
b_extrapolate(bv,get_coord(v_id),x,x,get_param(v_id),
get_param(new_v),new_v);
}
}
/* take care of facet incidences, assuming plane configuration */
new_fe1 = NULLID;
f1 = get_fe_facet(side[besti].fe);
if ( valid_id(f1) )
{ /* install new facetedge */
fe_id = side[besti].fe;
fe_id = inverse_id(fe_id);
other_fe = get_next_edge(fe_id);
if ( !equal_element(side[besti+1].e_id,get_fe_edge(other_fe)) )
{ new_fe1 = new_facetedge(f1,new_e);
set_edge_fe(new_e,new_fe1);
set_prev_edge(other_fe,inverse_id(new_fe1));
set_next_edge(fe_id,inverse_id(new_fe1));
set_prev_edge(new_fe1,inverse_id(other_fe));
set_next_edge(new_fe1,inverse_id(fe_id));
set_next_facet(new_fe1,new_fe1);
set_prev_facet(new_fe1,new_fe1);
}
}
fe_id = get_prev_facet(side[besti].fe);
if ( !equal_id(fe_id,side[besti].fe) )
{ f1 = get_fe_facet(fe_id);
if ( valid_id(f1) )
{ /* install new facetedge */
fe_id = inverse_id(fe_id);
other_fe = get_next_edge(fe_id);
if ( !equal_element(side[besti+1].e_id,get_fe_edge(other_fe)) )
{
new_fe1 = new_facetedge(f1,new_e);
set_edge_fe(new_e,new_fe1);
set_prev_edge(other_fe,inverse_id(new_fe1));
set_next_edge(fe_id,inverse_id(new_fe1));
set_prev_edge(new_fe1,inverse_id(other_fe));
set_next_edge(new_fe1,inverse_id(fe_id));
set_next_facet(new_fe1,new_fe1);
set_prev_facet(new_fe1,new_fe1);
}
}
}
f2 = get_fe_facet(side[besti+1].fe);
if ( valid_id(f2) )
{
fe_id = side[besti+1].fe;
other_fe = get_prev_edge(fe_id);
if ( !equal_element(side[besti].e_id,get_fe_edge(other_fe)) )
{ new_fe2 = new_facetedge(f2,new_e);
set_edge_fe(new_e,new_fe2);
set_next_edge(other_fe,new_fe2);
set_prev_edge(fe_id,new_fe2);
set_next_edge(new_fe2,fe_id);
set_prev_edge(new_fe2,other_fe);
if ( valid_id(new_fe1) )
{ set_prev_facet(new_fe1,new_fe2);
set_next_facet(new_fe1,new_fe2);
set_prev_facet(new_fe2,new_fe1);
set_next_facet(new_fe2,new_fe1);
} else
{ set_next_facet(new_fe2,new_fe2);
set_prev_facet(new_fe2,new_fe2);
}
}
}
fe_id = get_next_facet(side[besti+1].fe);
if ( !equal_id(fe_id,side[besti+1].fe) )
{
f2 = get_fe_facet(fe_id);
if ( valid_id(f2) )
{
other_fe = get_prev_edge(fe_id);
if ( !equal_element(side[besti].e_id,get_fe_edge(other_fe)) )
{ new_fe2 = new_facetedge(f2,new_e);
set_edge_fe(new_e,new_fe2);
set_next_edge(other_fe,new_fe2);
set_prev_edge(fe_id,new_fe2);
set_next_edge(new_fe2,fe_id);
set_prev_edge(new_fe2,other_fe);
if ( valid_id(new_fe1) )
{ set_prev_facet(new_fe1,new_fe2);
set_next_facet(new_fe1,new_fe2);
set_prev_facet(new_fe2,new_fe1);
set_next_facet(new_fe2,new_fe1);
} else
{ set_next_facet(new_fe2,new_fe2);
set_prev_facet(new_fe2,new_fe2);
}
}
}
}
/* make sure new edge has at least one facetedge structure */
if ( !valid_id(get_edge_fe(new_e)) )
{ facetedge_id new_fe = new_facetedge(NULLID,new_e);
set_edge_fe(new_e,new_fe);
set_next_edge(new_fe,inverse_id(new_fe));
set_prev_edge(new_fe,inverse_id(new_fe));
set_next_facet(new_fe,new_fe);
set_prev_facet(new_fe,new_fe);
}
newpop_exit:
temp_free((char *)side);
if ( (edges > 4) || ((edges > 2) && (degfree < SDIM)) )
return 1 + new_popverst(v_id,edges-1); /* recurse if need */
return 1;
}
/******************************************************************************
Autopop and autochop functions.
*****************************************************************************/
edge_id *autopop_list; /* list of short edges found */
edge_id *autochop_list; /* list of long edges found */
/*****************************************************************************
*
* Function: autopop_init()
*
* Purpose: Allocates lists for accumulating poppable or choppable edges.
*/
void autopop_init()
{
if ( autopop_flag )
{
autopop_list = (edge_id *)temp_calloc(web.skel[EDGE].count+web.skel[FACET].count,sizeof(edge_id));
}
if ( autochop_flag )
{
autochop_list = (edge_id *)temp_calloc(web.skel[EDGE].count,sizeof(edge_id));
}
} /* end autopop_init() */
/**************************************************************************
*
* Function: autopop_cleanup()
*
* Purpose: deallocate lists
*/
void autopop_cleanup()
{ if ( autochop_list )
{ temp_free((char*)autochop_list);
autochop_list = NULL;
}
if ( autopop_list )
{ temp_free((char*)autopop_list);
autopop_list = NULL;
}
} /* end autopop_cleanup() */
/********************************************************************
*
* function: autopop_detect()
*
* purpose: Find which edges will shrink to zero length or beyond.
* (half length when runge-kutta in effect)
* Uses velocity attribute of vertices to predict motion,
* so it does not chop growing small edges produced by
* topology changes.
* Makes a list, but does not change anything. Do
* motion, then call autopop_pop() to eliminate edges.
* Also detects for autochop.
*
* Soapfilm model: also detects for facets disappearing.
*/
void autopop_detect(scale)
REAL scale; /* scale factor for motion */
{
edge_id e_id;
REAL minlength = sqrt(2*scale); /* stability critical length */
if ( autopop_quartic_flag )
minlength = 2*sqrt(sqrt(scale));
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_autopop_detect(scale);
return;
}
#endif
autopop_init();
autopop_count = 0;
autochop_count = 0;
FOR_ALL_EDGES(e_id)
{
vertex_id headv = get_edge_headv(e_id);
REAL *headf = get_velocity(headv);
vertex_id tailv = get_edge_tailv(e_id);
REAL *tailf = get_velocity(tailv);
REAL tailtan[MAXCOORD],headtan[MAXCOORD];
REAL length,dx;
get_edge_tail_tangent(e_id,tailtan);
get_edge_tail_tangent(inverse_id(e_id),headtan);
length = sqrt(SDIM_dot(tailtan,tailtan));
if ( length > 0.0 )
dx = -scale*(SDIM_dot(headf,headtan)
+ SDIM_dot(tailf,tailtan))/length;
else dx = 0.0;
if ( autopop_flag && (dx <= 0.0) )
{ if ( (length < minlength) ||
(length + dx <= (runge_kutta_flag ? 0.52*length : 0.0)) )
{ if ( immediate_autopop_flag )
{ int ret = eliminate_edge(e_id);
if ( ret ) free_element(e_id);
continue; /* next edge */
}
else /* add to list */
autopop_list[autopop_count++] = e_id;
}
}
if ( autochop_flag )
if ( length + dx > autochop_length)
{ /* add to list */
autochop_list[autochop_count++] = e_id;
}
}
if ( web.representation == SOAPFILM )
{ facet_id f_id;
FOR_ALL_FACETS(f_id)
{ int i;
REAL sides[FACET_EDGES][MAXCOORD];
REAL *velocities[FACET_VERTS];
REAL area=0.0,area_rate;
facetedge_id fe;
REAL perim = 0.0;
fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ e_id = get_fe_edge(fe);
get_edge_side(e_id,sides[i]);
velocities[i] = get_velocity(get_edge_tailv(e_id));
fe = get_next_edge(fe);
}
/* get area rate of change */
area_rate = 0.0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ int ii = (i==0)?2:(i-1);
REAL s1s1,s1s2,s2s2,s1v,s2v;
s1s1 = SDIM_dot(sides[i],sides[i]);
s2s2 = SDIM_dot(sides[ii],sides[ii]);
s1s2 = -SDIM_dot(sides[i],sides[ii]);
s1v = SDIM_dot(sides[i],velocities[i]);
s2v = -SDIM_dot(sides[ii],velocities[i]);
area = sqrt(s1s1*s2s2 - s1s2*s1s2);
area_rate -= (s1v*(s2s2 - s1s2) + s2v*(s1s1 - s1s2))/area;
perim += sqrt(s1s1);
}
if ( (area_rate < 0) && (area + scale*area_rate <= minlength*perim/2) )
{ if ( immediate_autopop_flag )
eliminate_facet(f_id);
else /* add to list */
autopop_list[autopop_count++] = f_id;
}
} /* end facet loop */
} /* end facet detect */
} /* end autopop_detect() */
/***********************************************************************
*
* function: autopop_pop()
*
* purpose: After motion, eliminate edges found by autopop_detect()
* and pop any resulting bad vertices.
* In soapfilm model, can also delete facets.
*
*/
void autopop_pop()
{
int k;
int popped = 0;
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_autopop_pop();
return;
}
#endif
if ( autopop_list == NULL ) return;
#ifdef MPI_EVOLVER
if ( this_task != MASTER_TASK )
mpi_delete_init();
#endif
for ( k = 0 ; k < autopop_count ; k++ )
{ if ( id_type(autopop_list[k]) == EDGE )
{ if ((get_eattr(autopop_list[k])&ALLOCATED) &&
eliminate_edge(autopop_list[k]))
free_element(autopop_list[k]);
}
else
eliminate_facet(autopop_list[k]);
}
if ( autopop_count )
{
if ( web.representation == STRING )
popped = verpop_str();
else
popped = popfilm();
}
if ( (autopop_count > 0) || (popped > 0) )
{ sprintf(msg,"Autopopped %d edges, %d vertices.\n",autopop_count,popped);
outstring(msg);
}
temp_free((char *)autopop_list);
autopop_list = NULL;
autopop_count = 0;
#ifdef MPI_EVOLVER
if ( this_task != MASTER_TASK )
mpi_task_delete_wrapup();
#endif
free_discards(DISCARDS_SOME); /* prevents auto pileup */
}
/***********************************************************************
*
* function: autochop_chop()
*
* purpose: After motion, divides edges found by autochop_detect()
*
*/
void autochop_chop()
{
int k;
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_autopop_chop();
return;
}
#endif
if ( autochop_list == NULL ) return;
for ( k = 0 ; k < autochop_count ; k++ )
{ /* printf("chopping edge %s\n",ELNAME(autochop_list[k])); */
if ( !valid_element(autochop_list[k]) )
continue;
edge_refine(autochop_list[k]);
}
if ( autochop_count > 0 )
{ sprintf(msg,"Autochopped %d edges.\n",autochop_count);
outstring(msg);
}
temp_free((char *)autochop_list);
autochop_list = NULL;
autochop_count = 0;
}
evolver-2.30c.dfsg/src/mindeg.c 0000644 0001753 0001753 00000176412 11410765113 016637 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
#include "include.h"
/*************************************************************
*
* file: mindeg.c
*
* Purpose: My own minimum degree sparse matrix factoring algorithm
*/
/* This file is basically the old version with compaction to take up
less memory.
*/
/* Algorithm: at each stage, eliminated vertices fall into disjoint
clusters, representing factored hessian of region with fixed boundary.
Vertex of minimal degree is eliminated, sometimes resulting in
merging of clusters. */
/* clusters or regions also called cliques in the literature */
/* Nodes are gathered into supernodes, defined as having same set of
cliques. Supernodes are ordered by degree, and independent
supernodes are eliminated in degree order until reach lower bound
estimate for next round. Independence means not sharing region.
*/
/* This version has supernodes as persistent structures */
/* data structures */
static struct md_vertex {
int supernode; /* which it belongs to */
int timestamp;
size_t newspot; /* for merging region matrices */
} *vlist;
struct region { int vercount; /* number of boundary vertices */
int verlist; /* vertex list spot, dynamically allocated */
int verpnum; /* vertex positions in parent */
int supercount; /* number of boundary supernodes */
int superlist; /* boundary supernode list spot */
int timestamp; /* marking for independence */
int merged; /* region merged with, or self */
int son; /* for start of merge list */
int size; /* number of vertices, incl eliminated */
#define BROTHER superlist
/* for merging to parent */
int next; /* doubly linked list of actives */
int prev; /* doubly linked list of actives */
} ;
static int regionstart; /* start of active list */
static int last_region; /* end of region chain */
/* supernode is collection of equivalent vertices */
/* defined as having same set of regions */
static struct supernode { int rcount; /* number of regions */
int rlist; /* list of regions spot */
int degree;
int flag; /* see below */
float height; /* for ordering of elimination */
int verlist; /* list of vertices spot */
int vercount; /* number of vertices */
int rtimestamp; /* for marking on changed region */
int stimestamp; /* for marking touched */
int next; /* doubly linked list of actives */
int prev; /* doubly linked list of actives */
} *slist ;
/* flag bits */
#define MD_AUG_CON 1
static int superstart; /* start of active list */
static int margin; /* how high to go above minimum degree, command line -m */
static int total_fill; /* total number of fill in factored matrix */
static REAL total_flops; /* total operation count, counting mul+add as 2 */
static int passes; /* number of times through main loop */
void dsolve();
extern int mindeg_debug_level; /*
0 none
1 print lowest degree
2 print supernode sizes
3 print vertex elim
4 print region absorbing
5 print region merging
*/
static int minabsorb = 2; /* max size region to try to absorb */
static int vtimestamp; /* for marking vertices */
static int stimestamp; /* for marking supernodes */
static int rtimestamp; /* for marking regions for independence */
static int old_rtimestamp; /* for saving previous value */
extern int mindeg_margin; /* how high to go above minimum degree, user var */
extern int mindeg_min_region_size; /* merge smaller regions with parent */
static int total_fill; /* total number of fill in factored matrix */
static int L_total; /* allocated spaces for final trianuglar matrix */
static int elim_count; /* number of variables eliminated so far */
/* macros for conveniently accessing working storage */
#define REG(spot) ((struct region *)(S->ISP+(spot)))
#define SNODE(spot) ((struct supernode *)(S->ISP+(spot)))
#define INT(spot) (S->ISP+(spot))
#define CHAR(spot) ((char*)(S->ISP+(spot)))
/* trial stuff */
int K; /* current row number */
int *xIL; /* next uneliminated vertex */
int *xJL; /* lists of rows to be added to uneliminated rows:
i > K => xJL(i) is first row to be added to row i,
i < K => xJL(i) is row following row i in some list of rows.
xJL(i) = -1 indicates end of list */
int md_alloc ARGS((struct linsys *, int));
int region_alloc ARGS((struct linsys *));
int supernode_compare ARGS((struct supernode **,struct supernode **));
int degree_compare ARGS((struct supernode *,struct supernode *));
void do_region_absorb ARGS((struct linsys *,int,int));
int exact_degree ARGS((struct linsys *,struct supernode *));
int exact_sdegree ARGS((struct linsys *,struct supernode *));
void traverse_recur ARGS((struct linsys *,struct region *,int*,int*));
void permute_recur ARGS((struct linsys *,struct region *));
void factor_recur ARGS((struct linsys *,struct region *));
void sparse_permute ARGS((struct linsys *));
void md_vertex_setup ARGS((struct linsys *));
void md_supernode_setup ARGS((struct linsys *));
void md_region_string ARGS((struct linsys *));
void md_supernode_regions ARGS((struct linsys *));
void degree_sort ARGS((struct linsys *));
void multiple_eliminate ARGS((struct linsys *));
void region_absorb ARGS((struct linsys *));
void clean_supernodes ARGS((struct linsys *));
void merge_supernodes ARGS((struct linsys *));
void traverse_region_tree ARGS((struct linsys *));
void mass_eliminate ARGS((struct linsys *,struct supernode*));
void show_mindeg_state ARGS((struct linsys *));
struct supernode **superheap; /* for heap ordering */
static int heapcount; /* how many in heap */
static struct supernode sentinel;
/**************************************************************************
*
* function: show_mindeg_state()
*
* purpose: Do graphical display of current factorization state.
* Sets all edges between non-eliminated vertices to red,
* others to black. Pauses for user response.
*/
void show_mindeg_state(S)
struct linsys *S;
{ char *marks; /* unelim node numbers */
edge_id e_id;
int j;
int rcount;
struct region *r;
int rnum;
int snum;
struct supernode *s;
/* count regions */
for ( rnum = regionstart, rcount=0 ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
rcount++;
}
/* figure out which vertices are not eliminated */
marks = temp_calloc(S->N,1);
for ( snum = superstart ; snum >= 0 ; snum = s->next )
{ s = slist + snum;
for ( j = 0 ; j < s->vercount ; j++ )
marks[INT(s->verlist)[j]] = 1;
}
FOR_ALL_EDGES(e_id)
{ struct hess_verlist *vh = get_vertex_vhead(get_edge_headv(e_id));
struct hess_verlist *vt = get_vertex_vhead(get_edge_tailv(e_id));
if ( marks[vh->rownum] && marks[vt->rownum] )
set_edge_color(e_id,RED);
else set_edge_color(e_id,WHITE);
}
update_display();
sprintf(msg,"Elimcount %d of %d; regions %d\n",elim_count,S->N,rcount);
prompt(msg,errmsg,100);
temp_free(marks);
}
/*****************************************************************************
*
* function: md_alloc()
*
* purpose: allocate workspace in linsys ISP. ISP[0] is amount allocated in ints.
* No deallocation. No initialization. NSP is arena size in ints.
* User must allocate ISP and set NSP before first call.
* return: offset from start
*/
int md_alloc(S,bytes)
struct linsys *S;
int bytes; /* bytes wanted */
{ int spot;
int size; /* in ints */
size = (bytes+3)/sizeof(int);
if ( S->ISP[0] + size + 1 > S->NSP )
{ int newsize = (int)(1.5*S->NSP)+bytes;
S->ISP = (int*)temp_realloc((char*)S->ISP,newsize*sizeof(int));
S->NSP = newsize;
}
spot = S->ISP[0] + 1;
S->ISP[0] += size;
return spot;
}
/***************************************************************************
*
* function: region_alloc()
*
* purpose: allocate new region structure in workspace
*
*/
int region_alloc(S)
struct linsys *S;
{ int spot;
struct region *r;
spot = md_alloc(S,sizeof(struct region));
if ( last_region >= 0 ) REG(last_region)->next = spot;
else regionstart = spot;
r = REG(spot);
r->prev = last_region;
r->next = -1;
r->merged = spot; /* self */
r->son = -1;
last_region = spot;
return spot;
}
/*****************************************************************************
*
* function: md_vertex_setup()
*
* purpose: initialize matrix vertex list, one vertex per matrix row,
* and establish mapping between surface elements and rows.
*
*/
void md_vertex_setup(S)
struct linsys *S;
{ int i,k;
struct hess_verlist *vh;
vertex_id v_id;
body_id b_id;
vlist = (struct md_vertex *)temp_calloc(S->N,sizeof(struct md_vertex));
/* set up reverse indexing from vlist to vheads */
FOR_ALL_VERTICES(v_id)
{ vh = get_vertex_vhead(v_id);
for ( k = 0 ; k < vh->freedom ; k++ )
vlist[vh->rownum+k].newspot = vh - vhead;
}
for ( i = 0 ; i < optparamcount ; i++ )
{ vh = vhead + optparam[i].vhead_index;
vlist[vh->rownum].newspot = vh - vhead;
}
if ( augmented_hessian_mode )
{
if ( !everything_quantities_flag ) /* bodies */
{ FOR_ALL_BODIES(b_id)
{ vh = get_body_vhead(b_id);
if ( vh->freedom )
vlist[vh->rownum].newspot = vh - vhead;
}
}
for ( i=0 ; i < gen_quant_count ; i++ )
{ vh = vhead + GEN_QUANT(i)->vhead_index;
if ( vh->freedom )
vlist[vh->rownum].newspot = vh - vhead;
}
}
}
/*****************************************************************************
*
* function: md_region_string()
*
* purpose: initialize region list with one region per edge,
*/
void md_region_string(S)
struct linsys *S;
{ int j,k,p,q;
size_t n1,n2;
int rcount;
struct region *r;
char *entrymark; /* for tagging done entries of A */
int size;
int newspot,spot; /* index into workspace */
size_t n1_end;
entrymark = temp_calloc(S->IA[S->N],sizeof(char));
/* estimate regions needed */
regionstart = md_alloc(S,0); /* since may need realloc for vertices */
last_region = -1;
for ( j = 0 ; j < vhead_count ; j++ ) vhead[j].flags &= ~HV_DONE;
/* fill in one region per edge detected in array */
rcount = 0;
for ( p = 0 ; p < S->N ; p++ )
{ for ( q = S->IA[p]-A_OFF ; q < S->IA[p+1]-A_OFF ; q++ )
{ int s1,s2;
if ( entrymark[q] ) continue;
n1 = vlist[p].newspot;
n2 = vlist[S->JA[q]-A_OFF].newspot;
if ( n1 == n2 ) continue; /* don't do just one vertex here */
if ( n1 > n2 ) { size_t tmp = n1; n1 = n2; n2 = tmp; }
/* need new region */
spot = region_alloc(S);
r = REG(spot);
/* find its supernodes */
s1 = vlist[vhead[n1].rownum].supernode;
s2 = vlist[vhead[n2].rownum].supernode;
r->supercount = (s1==s2) ? 1 : 2;
newspot = md_alloc(S,r->supercount*sizeof(int));
r = REG(spot); /* in case of reallocation of workspace */
r->superlist = newspot;
INT(r->superlist)[0] = s1;
if ( s1 != s2 )
INT(r->superlist)[1] = s2;
size = vhead[n1].freedom + vhead[n2].freedom;
r->size = r->vercount = size;
newspot = md_alloc(S,r->vercount*sizeof(int));
r = REG(spot); /* in case of reallocation of workspace */
r->verlist = newspot;
for ( k = 0 ; k < vhead[n1].freedom ; k++ )
INT(r->verlist)[k] = vhead[n1].rownum + k;
for ( k = 0 ; k < vhead[n2].freedom ; k++ )
INT(r->verlist)[vhead[n1].freedom+k] = vhead[n2].rownum + k;
/* the edge */
for ( k = 0 ; k < vhead[n1].freedom ; k++ )
{ int row;
row = vhead[n1].rownum + k;
for ( spot = S->IA[row]-A_OFF ; spot < S->IA[row+1]-A_OFF ; spot++ )
if ( S->JA[spot]-A_OFF >= vhead[n2].rownum ) break;
/* entry may not exist if value 0 */
for ( j = 0 ; (spotIA[row+1]-A_OFF) && (jJA[spot]-A_OFF > vhead[n2].rownum+j ) continue;
entrymark[spot] = 'x';
spot++;
}
}
/* the vertices */
if ( !(vhead[n1].flags & HV_DONE) )
{ for ( k = 0 ; k < vhead[n1].freedom ; k++ )
{ int row;
row = vhead[n1].rownum + k;
for ( spot = S->IA[row]-A_OFF ; spot < S->IA[row+1]-A_OFF ; spot++ )
if ( S->JA[spot]-A_OFF >= vhead[n1].rownum ) break;
for ( j=0 ; (spotIA[row+1]-A_OFF) && (jJA[spot]-A_OFF > vhead[n1].rownum+j ) continue;
entrymark[spot] = 'x';
spot++;
}
}
vhead[n1].flags |= HV_DONE;
}
if ( !(vhead[n2].flags & HV_DONE) )
{ for ( k = 0 ; k < vhead[n2].freedom ; k++ )
{ int row;
row = vhead[n2].rownum + k;
for ( spot = S->IA[row]-A_OFF ; spot < S->IA[row+1]-A_OFF ; spot++ )
if ( S->JA[spot]-A_OFF >= vhead[n2].rownum ) break;
for ( j = 0 ; (spotIA[row+1]-A_OFF)&&(jJA[spot]-A_OFF > vhead[n2].rownum+j ) continue;
entrymark[spot] = 'x';
spot++;
}
}
vhead[n2].flags |= HV_DONE;
}
rcount++;
}
}
/* now see if any vertices have been missed */
n1_end = augmented_hessian_mode ? vhead_count :
web.skel[VERTEX].max_ord+1 + optparamcount;
for ( n1 = 0 ; n1 < n1_end ; n1++ )
{ if ( vhead[n1].flags & HV_DONE ) continue;
if ( vhead[n1].freedom == 0 ) continue;
/* need new region */
spot = region_alloc(S);
r = REG(spot);
r->supercount = 1;
newspot = md_alloc(S,r->supercount*sizeof(int));
r = REG(spot); /* in case of reallocation of workspace */
r->superlist = newspot;
INT(r->superlist)[0] = vlist[vhead[n1].rownum].supernode;
size = vhead[n1].freedom;
r->size = r->vercount = size;
newspot = md_alloc(S,r->vercount*sizeof(int));
r = REG(spot); /* in case of reallocation of workspace */
r->verlist = newspot;
for ( k = 0 ; k < vhead[n1].freedom ; k++ )
INT(r->verlist)[k] = vhead[n1].rownum + k;
/* fill matrix */
for ( k = 0 ; k < vhead[n1].freedom ; k++ )
{ int row;
row = vhead[n1].rownum + k;
for ( spot = S->IA[row]-A_OFF ; spot < S->IA[row+1]-A_OFF ; spot++ )
if ( S->JA[spot]-A_OFF >= vhead[n1].rownum ) break;
for ( j=0 ; (spotIA[row+1]-A_OFF) && (jJA[spot]-A_OFF > vhead[n1].rownum+j ) continue;
entrymark[spot] = 'x';
spot++;
}
}
vhead[n1].flags |= HV_DONE;
rcount++;
}
temp_free(entrymark);
}
/*****************************************************************************
*
* function: md_region_soapfilm()
*
* purpose: initialize region list with one region per facet or edge
* Film quadratic mode will need per facet.
*/
#ifdef FACETREGIONS
void md_region_soapfilm(S)
struct linsys *S;
{ int i,j,k,n;
int ecount;
struct md_vertex *v;
struct region *r;
}
#endif
/*****************************************************************************
*
* function: md_supernode_regions()
*
* purpose: set up lists of regions per supernode
*/
void md_supernode_regions(S)
struct linsys *S;
{ int k,rnum,snum;
struct region *r;
struct supernode *s;
/* count number of correspondences needed */
for ( rnum = regionstart ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
for ( k = 0 ; k < r->supercount ; k++ )
slist[INT(r->superlist)[k]].rcount++;
}
for ( snum = superstart ; snum >= 0 ; snum = s->next )
{ s = slist + snum;
s->rlist = md_alloc(S,s->rcount*sizeof(int));
s->rcount = 0; /* reset so can use as index in loading */
}
for ( rnum = regionstart; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
for ( k = 0 ; k < r->supercount ; k++ )
{ s = slist + INT(r->superlist)[k];
INT(s->rlist)[s->rcount++] = rnum;
}
}
}
/***************************************************************************
*
* function: md_supernode_setup()
*
* purpose: Create one supernode per vertex. Does not set regions.
*/
int supercount;
void md_supernode_setup(S)
struct linsys *S;
{ int n,i,j;
struct supernode *s;
int vhead_hi;
struct hess_verlist *vh;
vhead_hi = augmented_hessian_mode ? vhead_count :
web.skel[VERTEX].max_ord+1 + optparamcount;
/* allocate supernode list */
for ( n = 0, supercount = 0; n < vhead_hi ; n++ )
if ( vhead[n].freedom > 0 ) supercount++;
slist = (struct supernode *)temp_calloc(supercount,sizeof(struct supernode));
s = slist;
supercount = 0;
/* Higher-order Lagrange edge and facet innards */
if ( web.lagrange_order >= 3 ) /* do edge innards */
{ edge_id e_id;
vertex_id *v;
FOR_ALL_EDGES(e_id)
{ int df; /* total degrees of freedom on edge */
v = get_edge_vertices(e_id);
for ( j = 1, df = 0 ; j < web.lagrange_order ; j++ )
{ vh = get_vertex_vhead(v[j]);
df += vh->freedom;
vh->flags |= SUPERNODE_DONE;
}
if ( df == 0 ) continue;
s->verlist = md_alloc(S,df*sizeof(int));
for ( j = 1 ; j < web.lagrange_order ; j++ )
{ vh = get_vertex_vhead(v[j]);
if ( vh->freedom > 0 )
{
for ( i = 0 ; i < vh->freedom ; i++ )
{ INT(s->verlist)[s->vercount+i] = vh->rownum + i;
vlist[INT(s->verlist)[s->vercount+i]].supernode = supercount;
}
s->vercount += vh->freedom;
}
}
s->next = supercount+1;
s->prev = supercount-1;
supercount++;
s++;
}
} /* end edge innards */
/* do facet innards */
if ( (web.lagrange_order >= 4) && (web.representation == SOAPFILM) )
{ facet_id f_id;
vertex_id *v;
int ctrl = (web.lagrange_order+1)*(web.lagrange_order+2)/2;
FOR_ALL_FACETS(f_id)
{ int df; /* total degrees of freedom on facet interior */
v = get_facet_vertices(f_id);
for ( j = 1, df = 0 ; j < ctrl ; j++ )
{ if ( !(get_vattr(v[j]) & Q_MIDFACET) ) continue;
vh = get_vertex_vhead(v[j]);
df += vh->freedom;
vh->flags |= SUPERNODE_DONE;
}
if ( df == 0 ) continue;
s->verlist = md_alloc(S,df*sizeof(int));
for ( j = 1 ; j < ctrl ; j++ )
{ if ( !(get_vattr(v[j]) & Q_MIDFACET) ) continue;
vh = get_vertex_vhead(v[j]);
for ( i = 0 ; i < vh->freedom ; i++ )
{ INT(s->verlist)[s->vercount+i] = vh->rownum + i;
vlist[INT(s->verlist)[s->vercount+i]].supernode = supercount;
}
s->vercount += vh->freedom;
}
s->next = supercount+1;
s->prev = supercount-1;
supercount++;
s++;
}
} /* end facet innards */
/* now all single vertices and miscellaneous */
for ( n = 0 ; n < vhead_hi ; n++ )
if ( vhead[n].freedom > 0 && !(vhead[n].flags & SUPERNODE_DONE) )
{ s->vercount = vhead[n].freedom;
s->verlist = md_alloc(S,s->vercount*sizeof(int));
for ( i = 0 ; i < vhead[n].freedom ; i++ )
{ INT(s->verlist)[i] = vhead[n].rownum + i;
vlist[INT(s->verlist)[i]].supernode = supercount;
}
/* s->height = get_coord(vhead[n].v_id)[0];*/ /* not so good */
s->height = (float)n; /* pretty good */
if ( (s->vercount == 1) && (S->A[S->IA[s->verlist]-A_OFF] == 0.0) )
s->flag |= MD_AUG_CON; /* so don't eliminate constraints first */
s->next = supercount+1;
s->prev = supercount-1;
supercount++;
s++;
}
slist[0].prev = -1;
slist[supercount-1].next = -1;
superstart = 0;
}
/****************************************************************************
*
* function: clean_supernodes()
*
* purpose: eliminate merged regions from supernode region lists
*/
void clean_supernodes(S)
struct linsys *S;
{ struct supernode *s;
int i,j,k,m;
int n;
for ( n = superstart ; n >= 0 ; n = s->next )
{ s = slist + n;
for ( i=0,j=0 ; i < s->rcount ; i++ )
{ int rnum = INT(s->rlist)[i];
while ( REG(rnum)->merged != rnum ) rnum = REG(rnum)->merged;
if ( REG(rnum)->timestamp > old_rtimestamp )
s->rtimestamp = REG(rnum)->timestamp; /* mark as affected */
for ( k = 0 ; k < j ; k++ )
{ if ( INT(s->rlist)[k] == rnum ) break; /* duplicate */
if ( INT(s->rlist)[k] > rnum ) /* insert */
{ for ( m = j ; m > k ; m-- ) INT(s->rlist)[m] = INT(s->rlist)[m-1];
INT(s->rlist)[k] = rnum;
j++;
break;
}
}
if ( k == j ) { INT(s->rlist)[j++] = rnum; }
}
s->rcount = j;
}
}
/****************************************************************************
*
* function: supernode_compare()
*
* purpose: lexical comparison of supernode region lists
* return -1 for a < b, 0 for a == b, 1 for a > b
*/
struct linsys *SSS; /* for communication with compare routine */
int supernode_compare(aa,bb)
struct supernode **aa,**bb;
{ int k;
struct linsys *S;
struct supernode *a = *aa, *b = *bb;
if ( a->rcount < b->rcount ) return -1;
if ( a->rcount > b->rcount ) return 1;
S = SSS;
for ( k = 0 ; k < a->rcount ; k++ )
{ if ( INT(a->rlist)[k] < INT(b->rlist)[k] ) return -1;
if ( INT(a->rlist)[k] > INT(b->rlist)[k] ) return 1;
}
return 0;
}
/****************************************************************************
*
* function: merge_supernodes()
*
* purpose: merge supernodes with same regions
*/
void merge_supernodes(S)
struct linsys *S;
{
struct supernode **sslist,*s,*ss;
int n,k,j,i;
int count;
int newverlist;
if ( superstart < 0 ) { supercount = 0; return; } /* all done */
/* make list to sort */
sslist = (struct supernode **)temp_calloc(supercount,sizeof(struct supernode *));
/* fill list */
for ( n = superstart, count = 0 ; n >= 0 ; n = s->next )
{ s = slist + n; /* only do touched supernodes */
if ( s->rtimestamp > old_rtimestamp ) sslist[count++] = s;
}
/* sort */
SSS = S; /* for communication with compare routine */
qsort((char*)sslist,count,sizeof(struct supernode *),FCAST supernode_compare);
/* merge */
for ( n = 1, k = 0 ; n < count ; n++ )
{ s = sslist[k];
if ( supernode_compare(sslist+n ,&s) == 0 )
{ /* merge */
ss = sslist[n];
if ( mindeg_debug_level > 7 )
printf("Merging supernode %d into %d.\n",ss-slist,s-slist);
newverlist = md_alloc(S,(s->vercount+ss->vercount)*sizeof(int));
memcpy(CHAR(newverlist),CHAR(s->verlist),s->vercount*sizeof(int));
memcpy(CHAR(newverlist+s->vercount),CHAR(ss->verlist),
ss->vercount*sizeof(int));
s->verlist = newverlist;
s->vercount += ss->vercount;
s->flag = 0;
if ( s->height < ss->height ) s->height = ss->height;
ss->verlist = -1;
ss->vercount = 0;
ss->flag = 0;
if ( ss->next >= 0 ) slist[ss->next].prev = ss->prev;
if ( ss->prev >= 0 ) slist[ss->prev].next = ss->next;
else superstart = ss->next;
supercount--;
/* remove from region supernode list */
for ( j = 0 ; j < ss->rcount ; j++ )
{ struct region *r = REG(INT(ss->rlist)[j]);
for ( i = 0 ; i < r->supercount ; i++ )
if ( INT(r->superlist)[i] == (sslist[n]-slist) ) break;
r->supercount--;
for ( ; i < r->supercount ; i++ )
INT(r->superlist)[i] = INT(r->superlist)[i+1];
}
}
else /* keep supernode */
{ k = n;
}
}
temp_free((char*)sslist);
}
/****************************************************************************
*
* function do_region_absorb(keeper,goner)
*
* purpose: absorb one region into another
*
*/
void do_region_absorb(S,keeper,goner)
struct linsys *S;
int keeper,goner; /* the regions */
{ int n;
struct region *rk = REG(keeper),*rg = REG(goner);
/* find spots in keeper matrix */
for ( n = 0 ; n < rk->vercount ; n++ )
vlist[INT(rk->verlist)[n]].newspot = n;
rg->merged = keeper;
if ( rg->next >= 0 ) REG(rg->next)->prev = rg->prev;
else last_region = rg->prev;
if ( rg->prev >= 0 ) REG(rg->prev)->next = rg->next;
else regionstart = rg->next;
rg->BROTHER = rk->son;
rk->son = goner;
/* rg->size = rg->vercount; */
}
/****************************************************************************
*
* function region_absorb()
*
* purpose: see if any regions entirely contained in others
*
*/
void region_absorb(S)
struct linsys *S;
{ int i,j,k;
struct region *r;
struct supernode *s;
int absorbcount = 0;
int maxab = 0;
for ( i = regionstart ; i >= 0 ; i = r->next )
{ r = REG(i);
if ( r->supercount > minabsorb ) continue;
/* timestamp supernodes of r */
stimestamp++;
for ( j = 0 ; j < r->supercount ; j++ )
slist[INT(r->superlist)[j]].stimestamp = stimestamp;
/* pick a supernode */
s = slist + INT(r->superlist)[0];
/* test regions of s */
for ( k = 0 ; k < s->rcount ; k++ )
{ int rnum = INT(s->rlist)[k];
struct region *rr;
int count;
while ( REG(rnum)->merged != rnum ) rnum = REG(rnum)->merged;
rr = REG(rnum);
if ( rr->supercount <= r->supercount ) continue;
for ( j = 0, count = 0 ; j < rr->supercount ; j++ )
count += (slist[INT(rr->superlist)[j]].stimestamp == stimestamp);
if ( count == r->supercount ) /* have it */
{
if ( r->supercount > maxab ) maxab = r->supercount;
do_region_absorb(S,rnum,i);
if ( mindeg_debug_level >= 5 )
printf("Absorbing region %d with %d.\n",i,rnum);
absorbcount++;
break;
}
}
}
if ( mindeg_debug_level > 1 )
printf("Absorbed %d; max size %d\n",absorbcount,maxab);
}
/****************************************************************************
*
* function: degree_compare()
*
* purpose: compare supernode degrees, breaking ties by verlist spot.
*/
int degree_compare(s1,s2)
struct supernode *s1,*s2;
{ int diff = s1->degree - s2->degree;
if ( s1->flag & MD_AUG_CON )
{ if ( s2->flag & MD_AUG_CON )
return (s1->height < s2->height) ? -1 : 1;
else return 1;
}
if ( s2->flag & MD_AUG_CON ) return -1;
if ( diff ) return diff;
return (s1->height < s2->height) ? -1 : 1;
/* high order, since high first */
}
/**************************************************************************
*
* function: exact_degree()
*
* purpose: calculate exact external degree of supernode as union of
* component regions. Union is calculated by timestamping
* vertices.
* return: number of vertices in union.
*/
int exact_degree(S,s)
struct linsys *S;
struct supernode *s;
{ int i,j,degree;
struct region *r;
struct supernode *ss;
stimestamp += 2; /* for current supernode */
SSS = S;
for ( i = 0, degree = 0 ; i < s->rcount ; i++ )
{ r = REG(INT(s->rlist)[i]);
for ( j = 0 ; j < r->supercount ; j++ )
{ ss = slist + INT(r->superlist)[j];
if ( ss->stimestamp < stimestamp )
{ degree += ss->vercount ; ss->stimestamp = stimestamp; }
}
}
return degree - s->vercount;
}
/**************************************************************************
*
* function: exact_sdegree()
*
* purpose: calculate exact supernode degree of supernode as union of
* component regions. Union is calculated by timestamping
* supernode.
* return: number of supernodes in union, including self.
*/
int exact_sdegree(S,s)
struct linsys *S;
struct supernode *s;
{ int i,j,degree;
struct region *r;
struct supernode *ss;
stimestamp++; /* for current supernode */
for ( i = 0, degree = 0 ; i < s->rcount ; i++ )
{ r = REG(INT(s->rlist)[i]);
for ( j = 0 ; j < r->supercount ; j++ )
{ ss = slist + INT(r->superlist)[j];
if ( ss->stimestamp < stimestamp )
{ degree++ ; ss->stimestamp = stimestamp; }
}
}
return degree;
}
/****************************************************************************
*
* function: degree_sort()
*
* purpose: order supernodes by degree. Degree is external degree, the number
* of nodes bordering the region left after removing the supernode.
*/
void degree_sort(S)
struct linsys *S;
{ int n;
struct supernode *s;
int spot;
heapcount = 0;
for ( n = superstart ; n >= 0 ; n = s->next )
{ s = slist + n;
if ( s->rcount == 0 ) continue; /* empty */
/* calculate degree */
if ( s->rtimestamp > old_rtimestamp )
s->degree = exact_degree(S,s);
/* insert in heap */
spot = ++heapcount; /* using heap[1] as root for convenience */
while ( spot>1 ) /* filter down */
{
if ( degree_compare(s,superheap[spot>>1]) < 0 )
superheap[spot] = superheap[spot>>1];
else break;
spot >>= 1;
}
superheap[spot] = s;
}
if ( heapcount != supercount )
kb_error(2467,"Internal error: degree_sort() has heapcount != supercount.\n",
RECOVERABLE);
}
/******************************************************************************
*
* function: mass_eliminate()
*
* purpose: eliminate one supernode, if independent
*/
void mass_eliminate(S,s)
struct linsys *S;
struct supernode *s;
{ int i,k;
struct region *r,*rk;
struct md_vertex *v;
int newvlist;
int newslist;
int vercount;
int size,ssize;
int scount;
int rkeep;
int sontotal = 0; /* of elim nodes of sons */
/* check independence and gather son elim totals */
for ( i = 0 ; i < s->rcount ; i++ )
{ int rnum = INT(s->rlist)[i];
r = REG(rnum);
if ( r->timestamp == rtimestamp ) return; /* not independent */
if ( r->son < 0 )
sontotal += r->size - r->vercount;
}
if ( mindeg_debug_level >= 2 )
printf("Eliminating supernode %d, size %d.\n",s-slist,s->vercount);
/* mark timestamps */
for ( i = 0 ; i < s->rcount ; i++ )
{ r = REG(INT(s->rlist)[i]);
r->timestamp = rtimestamp;
}
/* create merged supernode and vertex lists */
/* with eliminated supernode vertices at end */
if ( sontotal > mindeg_min_region_size )
sontotal = 0; /* don't merge with sons */
size = s->degree + s->vercount + sontotal;
newvlist = md_alloc(S,size*sizeof(int));
ssize = exact_sdegree(S,s);
newslist = md_alloc(S,ssize*sizeof(int));
/* first, elim supernode at end */
vtimestamp++; /* new round */
stimestamp++; /* new round */
INT(newslist)[ssize-1] = s-slist;
s->stimestamp = stimestamp;
vercount = s->degree;
for ( k = 0 ; k < s->vercount ; k++ )
{ INT(newvlist)[vercount++] = INT(s->verlist)[k];
vlist[INT(s->verlist)[k]].timestamp = vtimestamp;
S->P[elim_count+k] = INT(s->verlist)[k];
S->IP[INT(s->verlist)[k]] = elim_count+k;
}
/* and sons, if merging */
if ( sontotal > 0 )
for ( i = 0 ; i < s->rcount ; i++ )
{ int j;
r = REG(INT(s->rlist)[i]);
if ( r->son >= 0 ) continue;
for ( j = r->vercount ; j < r->size ; j++ )
INT(newvlist)[vercount++] = INT(r->verlist)[j];
}
vercount = 0;
scount = 0;
for ( i = 0 ; i < s->rcount ; i++ )
{ struct supernode *ss;
r = REG(INT(s->rlist)[i]);
for ( k = 0 ; k < r->supercount ; k++ )
{ ss = slist + INT(r->superlist)[k];
if ( ss->stimestamp == stimestamp ) continue;
INT(newslist)[scount++] = INT(r->superlist)[k];
ss->stimestamp = stimestamp;
ss->rtimestamp = rtimestamp;
}
for ( k = 0 ; k < r->vercount ; k++ )
{ v = vlist + INT(r->verlist)[k];
if ( v->timestamp == vtimestamp ) continue;
INT(newvlist)[vercount++] = INT(r->verlist)[k];
v->timestamp = vtimestamp;
}
}
/* set up new region */
rkeep = region_alloc(S);
rk = REG(rkeep);
rk->verlist = newvlist;
rk->vercount = vercount;
rk->superlist = newslist;
rk->supercount = scount;
rk->son = -1;
if ( vercount != s->degree )
printf("vercount %d != degree %d, supernode %d\n",vercount,s->degree,s-slist);
/* mark all old regions as merged and remove from active list */
for ( i = 0 ; i < s->rcount ; i++ )
{ int rnum = INT(s->rlist)[i];
r = REG(rnum);
r->merged = rkeep;
if ( (r->size > r->vercount) || ( r->son >= 0 ) )
{ /* keep nonleaf regions */
r->BROTHER = rk->son;
rk->son = rnum;
}
else if ( mindeg_debug_level >= 5 )
{ if (r->size == r->vercount)
printf("Dropping nodeless region %d\n",rnum);
else
printf("Incorporating small region %d into region %d\n",rnum,rkeep);
}
if ( r->next >= 0 ) REG(r->next)->prev = r->prev;
else last_region = r->prev;
if ( r->prev >= 0 ) REG(r->prev)->next = r->next;
else regionstart = r->next;
if ( mindeg_debug_level >= 5 )
printf("Merging region %d with %d.\n",INT(s->rlist)[i],rkeep);
}
/* eliminate nodes */
rk = REG(rkeep);
rk->size = size;
if ( mindeg_debug_level >= 5 )
printf("New region %d size %d vercount %d son %d.\n",
rkeep,rk->size,rk->vercount,rk->son);
if ( mindeg_debug_level >= 7 )
{ printf("Border: ");
for ( i = 0 ; i < rk->vercount ; i++ )
printf("%d ",INT(rk->verlist)[i]);
printf(" elim: ");
for ( ; i < rk->size ; i++ )
printf("%d ",INT(rk->verlist)[i]);
}
elim_count += s->vercount;
/* delete this supernode */
if ( s->next >= 0 ) slist[s->next].prev = s->prev;
if ( s->prev >= 0 ) slist[s->prev].next = s->next;
else superstart = s->next;
s->verlist = -1;
supercount--;
s->rcount = 0; /* inactivate */
}
/******************************************************************************
*
* function: groom_regions_recur()
*
* purpose: Traverse newly created region tree, gathering stats
* (and maybe compacting)
*/
static int final_regions; /* number making it to factoring */
static int final_versizes; /* number making it to factoring */
void groom_regions_recur(S,r)
struct linsys *S;
struct region *r;
{ struct region *rr;
int son,k;
for ( son = r->son ; son >= 0 ; son = rr->BROTHER )
{ rr = REG(son);
groom_regions_recur(S,rr);
}
/* record fills per vertex for later factoring */
for ( k = r->vercount ; k < r->size ; k++ )
{ int v = INT(r->verlist)[k];
S->LIA[v] += r->size - (k - r->vercount);
}
/* gather stats */
{ int vn = r->vercount,vd = r->size;
total_fill += (vd*(vd+1) - vn*(vn+1))/2;
total_flops += ((vd+1.)*vd*(vd+2.) - (vn+1.)*vn*(vn+2.))/3;
}
final_regions++;
final_versizes += r->size;
}
/******************************************************************************
*
* function: compact_recur()
*
* purpose: Compact one region information to free up large amounts
* of storage before numerical factoring. Recursive.
*
* return: Offset (in ints) of new location in new_ISP
*/
static int *new_ISP; /* compacted storage */
static int new_ISP_spot;
int compact_recur(S,r)
struct linsys *S;
struct region *r;
{ struct region *rr;
int son;
int *v;
int retval;
int *rnumptr;
int i;
rnumptr = &(r->son);
for ( son = r->son ; son >= 0 ; son = rr->BROTHER )
{ rr = REG(son);
*rnumptr = compact_recur(S,rr);
rnumptr = &(((struct region*)(new_ISP + *rnumptr))->BROTHER);
}
/* now do this region */
retval = new_ISP_spot;
rr = (struct region *)(new_ISP + new_ISP_spot);
*rr = *r;
new_ISP_spot += sizeof(struct region)/sizeof(int);
v = INT(r->verlist);
rr->verlist = new_ISP_spot;
for ( i = 0 ; i < r->size ; i++ )
new_ISP[new_ISP_spot++] = v[i];
return retval;
}
/******************************************************************************
*
* function: compact_regions()
*
* purpose: Compact region information to free up large amounts
* of storage before numerical factoring.
*/
void compact_regions(S)
struct linsys *S;
{ int rnum;
int *new_rnum;
int new_NSP;
struct region *r;
new_NSP = final_regions*sizeof(struct region) + final_versizes*sizeof(int);
new_ISP = (int*)temp_calloc(new_NSP,1);
new_ISP_spot = 0;
new_rnum = ®ionstart;
for ( rnum = regionstart ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
*new_rnum = compact_recur(S,r);
new_rnum = &(((struct region*)(new_ISP+*new_rnum))->next);
}
temp_free((char*)S->ISP);
S->ISP = new_ISP;
S->NSP = new_NSP;
}
/******************************************************************************
*
* function: multiple_eliminate()
*
* purpose: eliminate independent supernodes of low degree
*/
void multiple_eliminate(S)
struct linsys *S;
{
int lowdegree;
int bounddegree; /* cutoff for multiple elimination */
int spot;
old_rtimestamp = rtimestamp; /* save, so know who changed */
rtimestamp++; /* new round of independence */
lowdegree = superheap[1]->degree; /* so we know where we started */
if ( mindeg_debug_level >= 1 ) printf("Low degree %d.\n",lowdegree);
/* using higher bounddegree leads to about 1/3 as many passes through
main loop, but not much reduction in total time */
bounddegree = lowdegree+margin; /* conservative to start with */
bounddegree = mindeg_margin < lowdegree ? lowdegree+mindeg_margin :
2*lowdegree;
sentinel.degree = 2+bounddegree; /* big degree */
sentinel.verlist = 1 << (8*sizeof(int)-2); /* big for degree_compare */
while ( superheap[1]->degree <= bounddegree )
{
mass_eliminate(S,superheap[1]);
/* now adjust heap */
spot = 1; /* empty spot */
for ( ;; )
{ if ( spot*2 > heapcount ) { superheap[spot] = &sentinel; break; }
if ( spot*2 == heapcount )
{ superheap[spot] = superheap[spot*2];
superheap[spot*2] = &sentinel;
break;
}
if ( degree_compare(superheap[spot*2],superheap[spot*2+1]) < 0 )
{ superheap[spot] = superheap[spot*2];
spot *= 2;
}
else
{ superheap[spot] = superheap[spot*2+1];
spot = spot*2 + 1;
}
}
}
}
/*************************************************************************
*
* function: traverse_region_tree()
*
* purpose: Traverse region tree after it's constructed, doing factoring.
* Uses remaining LA space as scratch space to assemble
* current supernode rows, prior to compaction.
* Everything stored in permuted order.
*/
static int treedepth;
static int IJA_base; /* number of entries in LIJA */
void traverse_recur(S,r,depth,fill)
struct linsys *S;
struct region *r;
int *depth; /* matrix depth of r and below */
int *fill; /* total fill of subtree */
{ int son;
struct region *rr;
int fillsum = 0;
int sondepth;
int maxdepth = 0;
int sonfill;
int thisfill;
treedepth++;
for ( son = r->son ; son >= 0 ; son = rr->BROTHER )
{ rr = REG(son);
traverse_recur(S,rr,&sondepth,&sonfill);
if ( sondepth > maxdepth ) maxdepth = sondepth;
fillsum += sonfill;
}
thisfill = (r->size*(r->size+1)
- r->vercount*(r->vercount+1))/2;
*fill = fillsum + thisfill;
*depth = maxdepth + (r->size*(r->size+1))/2;
{ int n; for (n=0;nsize*(r->size+1))/2); }
treedepth--;
}
/*********************************************************************************
*
* function: permute_recur()
*
* purpose: traverse region tree to find elimnation order
*
*/
void permute_recur(S,r)
struct linsys *S;
struct region *r;
{ int k;
struct region *rr;
int son;
if ( mindeg_debug_level > 5 )
printf("permute_recur region %d, vercount %d rsize %d\n",
(int*)r-S->ISP,r->vercount,r->size);
for ( son = r->son ; son >= 0 ; son = rr->BROTHER )
{ rr = REG(son);
permute_recur(S,rr);
}
for ( k = r->vercount ; k < r->size ; k++ )
{ S->P[K] = INT(r->verlist)[k];
S->IP[S->P[K]] = K;
K++;
}
IJA_base += r->size;
}
/*********************************************************************************
*
* function: sparse_permute()
*
* purpose: Permute sparse matrix structure according to permutation S->IP.
* Does upper triangular form, with rows in order.
* Leaves permuted sparse matrix in S->pIA,pJA,pA.
* Uses radix sort.
*/
void sparse_permute(S)
struct linsys *S;
{ int i,j,end,total;
int *cIA;
int *cJA;
REAL *cA;
/* allocate */
S->pIA = (int*)temp_realloc((char*)S->pIA,(S->N+1)*sizeof(int));
S->pJA = (int*)temp_realloc((char*)S->pJA,(S->IA[S->N]-A_OFF)*sizeof(int));
S->pA = (REAL*)temp_realloc((char*)S->pA,(S->IA[S->N]-A_OFF)*sizeof(REAL));
memset((char*)S->pIA,0,(S->N+1)*sizeof(int));
memset((char*)S->pJA,0,(S->IA[S->N]-A_OFF)*sizeof(int));
memset((char*)S->pA,0,(S->IA[S->N]-A_OFF)*sizeof(REAL));
cIA = (int*)temp_calloc(S->N+1,sizeof(int));
cJA = (int*)temp_calloc(S->IA[S->N]-A_OFF,sizeof(int));
cA = (REAL*)temp_calloc(S->IA[S->N]-A_OFF,sizeof(REAL));
/* sort on permuted column */
for ( i = 0 ; i < S->N ; i++ )
{ int ii = S->IP[i];
end = S->IA[i+1] - A_OFF;
for ( j = S->IA[i] - A_OFF ; j < end ; j++ )
{ int m = S->IP[S->JA[j]-A_OFF];
if ( ii < m )
cIA[m]++;
else cIA[ii]++;
}
}
for ( i = 0, total = 0 ; i < S->N ; i++ )
{ int tmp = cIA[i]; cIA[i] = total; total += tmp;
}
cIA[S->N] = total;
for ( i = 0 ; i < S->N ; i++ )
{ int ii = S->IP[i];
end = S->IA[i+1] - A_OFF;
for ( j = S->IA[i] - A_OFF ; j < end ; j++ )
{ int m = S->IP[S->JA[j]-A_OFF];
if ( ii < m )
{ cA[cIA[m]] = S->A[j]; cJA[cIA[m]++] = ii; }
else { cA[cIA[ii]] = S->A[j]; cJA[cIA[ii]++] = m; }
}
}
for ( i = S->N-1 ; i > 0 ; i-- ) cIA[i] = cIA[i-1];
cIA[0] = 0;
/* now sort on permuted row */
for ( i = 0 ; i < S->N ; i++ )
{ end = cIA[i+1];
for ( j = cIA[i] ; j < end ; j++ )
S->pIA[cJA[j]]++;
}
for ( i = 0, total = 0 ; i < S->N ; i++ )
{ int tmp = S->pIA[i]; S->pIA[i] = total; total += tmp;
}
S->pIA[S->N] = total;
for ( i = 0 ; i < S->N ; i++ )
{ end = cIA[i+1];
for ( j = cIA[i] ; j < end ; j++ )
{ S->pA[S->pIA[cJA[j]]] = cA[j]; S->pJA[S->pIA[cJA[j]]++] = i; }
}
for ( i = S->N-1 ; i > 0 ; i-- ) S->pIA[i] = S->pIA[i-1];
S->pIA[0] = 0;
temp_free((char*)cIA);
temp_free((char*)cJA);
temp_free((char*)cA);
}
/********************************************************************************
*
* function: factor_recur()
*
* purpose: Traverse region tree, factoring supernode at each.
*/
int vcompare ARGS((int*,int*));
int vcompare(a,b)
int *a,*b;
{ return *a-*b;
}
void factor_recur(S,r)
struct linsys *S;
struct region *r;
{ int to_elim = r->size - r->vercount;
REAL *base; /* scratch row start in LA */
int i,j,m,ii,ii_next;
int end;
REAL pivot;
int *jspot;
struct region *reg;
int son;
/* first, do sons */
for ( son = r->son ; son >= 0 ; son = reg->BROTHER )
{ reg = REG(son);
factor_recur(S,reg);
}
if ( to_elim == 0 ) return;
/* get verlist in proper order with permuted numbers */
for ( j = 0 ; j < r->size ; j++ )
INT(r->verlist)[j] = S->IP[INT(r->verlist)[j]];
qsort((char*)(INT(r->verlist)),r->size,sizeof(int), FCAST vcompare);
/* fill in full rows in scratch space */
for ( i = 0, base = S->LA + S->LIA[K] ; i < to_elim ; i++ )
{ REAL pa,pb,p11,p12,p21,p22;
int jj;
/* first, fill from original matrix */
end = S->pIA[K+i+1];
for ( j = S->pIA[K+i] ; j < end ; j++ )
base[S->pJA[j]-(K+i)] = S->pA[j];
/* incorporate the shift */
if ( S->lambda != 0.0 )
{
if ( hessian_linear_metric_flag )
{ if ( S->lambda != 0.0 )
{ end = Met.pIA[K+i+1];
for ( j = Met.pIA[K+i] ; j < end ; j++ )
base[Met.pJA[j]-(K+i)] -= S->lambda*Met.pA[j];
}
}
else if ( web.area_norm_flag )
base[0] -= S->lambda*Met.A[S->P[K+i]]; /* special metric matrix */
else if ( augmented_hessian_mode )
{ if ( S->P[K+i] < S->A_rows ) /* do not shift constraints! */
base[0] -= S->lambda;
}
else base[0] -= S->lambda;
}
/* next, add in previous rows that have entry in col K */
ii_next = 0;
for ( ii = xJL[K+i] ; ii >= 0 ; ii = ii_next )
{ REAL *subbase = base - (K+i);
REAL *la;
int *ja;
int IJdiff = S->LIA[ii] - S->LIJA[ii];
switch ( S->psize[ii] )
{ case ONEBYONE:
pivot = S->LA[S->LIA[ii]]*S->LA[xIL[ii]];
end = S->LIA[ii+1];
for ( j = xIL[ii],ja = S->LJA+j-IJdiff,la=S->LA+j ;
j < end ; j++,la++,ja++ )
subbase[*ja] -= pivot*(*la); /* big improvement */
ii_next = xJL[ii];
if ( ++(xIL[ii]) < end )
{ m = S->LJA[xIL[ii]-IJdiff];
xJL[ii] = xJL[m]; xJL[m] = ii;
}
break;
case ZEROPIVOT: /* nothing to add */
ii_next = xJL[ii];
if ( ++(xIL[ii]) < end )
{ m = S->LJA[xIL[ii]-IJdiff];
xJL[ii] = xJL[m]; xJL[m] = ii;
}
break;
case SECONDOFPAIR: /* will handle under FIRSTOFPAIR */
ii_next = xJL[ii];
break;
case FIRSTOFPAIR:
p11 = S->LA[S->LIA[ii]]; p21 = p12 = S->LA[S->LIA[ii]+1];
p22 = S->LA[S->LIA[ii+1]];
pa = p11*S->LA[xIL[ii]] + p12*S->LA[xIL[ii+1]];
pb = p21*S->LA[xIL[ii]] + p22*S->LA[xIL[ii+1]];
end = S->LIA[ii+1];
for ( j = xIL[ii], jj = xIL[ii+1] ; j < end ; j++,jj++ )
base[S->LJA[j-IJdiff]-(K+i)] -= pa*S->LA[j] + pb*S->LA[jj];
ii_next = xJL[ii];
if ( ++(xIL[ii]) < end )
{ m = S->LJA[xIL[ii]-IJdiff];
xJL[ii] = xJL[m]; xJL[m] = ii;
}
if ( ii_next == ii+1 ) ii_next = xJL[ii+1];
if ( ++(xIL[ii+1]) < end )
{ m = S->LJA[xIL[ii+1]-(S->LIA[ii+1]-S->LIJA[ii+1])];
xJL[ii+1] = xJL[m]; xJL[m] = ii+1;
}
break;
default: kb_error(1835,"Internal error: Illegal case of psize\n",
RECOVERABLE);
}
}
/* compress to dense form */
for ( j = to_elim ; j < r->size ; j++ )
{ REAL *to = base + j - i;
REAL *from = base + INT(r->verlist)[j] - (K+i);
if ( from != to )
{ *to = *from;
*from = 0.0; /* clear for next round */
}
}
S->LIA[K+i+1] = S->LIA[K+i] + r->size - i;
base += r->size - i;
}
/* fill in LJA */
for ( i = 0 ; i < to_elim ; i++ )
S->LIJA[K+i] = IJA_base + i;
jspot = S->LJA + S->LIJA[K];
for ( m = 0 ; m < r->size ; m++,jspot++ )
*jspot = INT(r->verlist)[m];
IJA_base += r->size;
/* factor */
for ( i = 0 ; i < to_elim ; i++ ) /* pivot row */
{ REAL *pivrow = S->LA + S->LIA[K+i];
int p;
REAL big,sigma,critsize;
int br;
/* first, decide on 1x1 or 2x2 pivot */
p = ONEBYONE; /* default pivot size 1 */
/* find max element in pivot row (same as pivot col) */
/* but only considering current supernode */
for ( j=i+1,big=-1.0,br = 0 ; j < to_elim ; j++ )
if ( fabs(pivrow[j-i]) > big )
{ big = fabs(pivrow[j-i]); br = j; }
critsize = hessian_epsilon * S->rowmag[S->P[K+i]];
if ( ((big <= critsize)||(!BK_flag))
&& (fabs(pivrow[0]) <= critsize) )
p = ZEROPIVOT;
else if ( (big*BKalpha > fabs(pivrow[0])) && BK_flag )
{ /* find max in row/col r */
REAL *rr;
for ( j = i, sigma = -1.0; j
LA + S->LIA[K+j] + br - j;
if ( fabs(*rr) > sigma ) sigma = fabs(*rr);
}
for ( rr = S->LA + S->LIA[K+br], j = br ; j < to_elim; rr++, j++ )
if ( fabs(*rr) > sigma ) sigma = fabs(*rr);
if ( BKalpha*big*big > sigma*fabs(pivrow[0]) )
{ p = FIRSTOFPAIR; }
}
if ( p == ZEROPIVOT )
{ S->psize[K+i] = ZEROPIVOT; S->zero++;
if ( S->P[K+i] >= S->A_rows ) S->degencon++;
memset((char*)pivrow,0,(r->size-i)*sizeof(REAL));
xIL[K+i] = -1;
}
else if ( p == ONEBYONE )
{ S->psize[K+i] = ONEBYONE;
pivot = 1/pivrow[0];
if ( pivot > 0.0 ) S->pos++; else S->neg++;
for ( j = i+1; j < to_elim ; j++ ) /* row down */
{ REAL *spot = S->LA + S->LIA[K+j];
REAL pp = pivrow[j-i]*pivot;
REAL *pr = pivrow + j - i;
/* this is the time-consuming inner loop */
for ( m = j ; m < r->size ; m++ , spot++, pr++)
/* semiheavy */ /* *spot -= pivrow[m-i]*pp; */
*spot -= (*pr)*pp; /* no improvement */
}
for ( m = i+1, pivrow++ ; m < r->size ; m++,pivrow++ )
*pivrow *= pivot; /* pivot row */
xIL[K+i] = S->LIA[K+i]+(to_elim-i);
if ( xIL[K+i] < S->LIA[K+i+1] )
{ m = S->LJA[xIL[K+i]-(S->LIA[K+i]-S->LIJA[K+i])];
xJL[K+i] = xJL[m]; xJL[m] = K+i;
}
S->psize[K+i] = ONEBYONE;
}
else /* 2x2 pivot */
{ REAL *pivrow1 = pivrow;
REAL *pivrow2 = S->LA + S->LIA[K+i+1];
REAL p11,p12,p22,detinv,*yy1,*yy2,pa1,pa2;
int k;
REAL *x;
S->psize[K+i] = FIRSTOFPAIR;
S->psize[K+i+1] = SECONDOFPAIR;
if ( br != i+1 ) /* swap rows to get adjacent */
{ REAL dtmp,*rii,*rr;
int c;
/* swap in matrix, both A and JA */
#define DSWAP(a,b) {dtmp=(a);(a)=(b);(b)=dtmp;}
for ( j = 0 ; j <= i ; j++ ) /* swap columns */
{ rr = S->LA + S->LIA[K+j] - j;
DSWAP(rr[i+1],rr[br]);
}
for ( j = i+2 ; j < br ; j++ ) /* across to down */
{ DSWAP(pivrow2[j-(i+1)],S->LA[S->LIA[K+j]+br-j]);
}
for ( j = br+1, rr=pivrow2+(br-i), rii=S->LA+S->LIA[K+br]+1 ;
j < r->size ; j++, rr++, rii++ )
{ DSWAP(*rr,*rii); }
DSWAP(pivrow2[0],S->LA[S->LIA[K+br]]); /* diag elements */
/* fix up LJA in swapped columns */
c = S->LJA[S->LIJA[K+i+1]];
S->LJA[S->LIJA[K+i+1]] = S->LJA[S->LIJA[K+br]];
S->LJA[S->LIJA[K+br]] = c;
}
/* now, actual 2x2 pivot */
p11 = pivrow1[0]; p12 = pivrow1[1]; p22 = pivrow2[0];
detinv = 1/(p11*p22 - p12*p12);
if ( detinv > 0.0 )
{ if ( p11+p22 > 0.0 ) S->pos += 2; else S->neg += 2; }
else { S->pos++; S->neg++; }
/* sweep through matrix */
for ( k = i+2, x = S->LA+S->LIA[K+i+2] ; k < to_elim ; k++ ) /* row */
{ pa1 = (pivrow1[k-i]*p22 - pivrow2[k-i-1]*p12)*detinv;
pa2 = (pivrow2[k-i-1]*p11 - pivrow1[k-i]*p12)*detinv;
for ( j=k,yy1=pivrow1+k-i,yy2=pivrow2+k-i-1 ; jsize;
j++ ,x++,yy1++,yy2++) /*col*/
{ *x -= pa1*(*yy1) + pa2*(*yy2);
}
pivrow1[k-i] = pa1;
pivrow2[k-i-1] = pa2;
}
for ( k = to_elim ; k < r->size ; k++ ) /* finish pivot rows */
{ pa1 = (pivrow1[k-i]*p22 - pivrow2[k-i-1]*p12)*detinv;
pa2 = (pivrow2[k-i-1]*p11 - pivrow1[k-i]*p12)*detinv;
pivrow1[k-i] = pa1;
pivrow2[k-i-1] = pa2;
}
xIL[K+i] = S->LIA[K+i]+(to_elim-i);
if ( xIL[K+i] < S->LIA[K+i+1] )
{ m = S->LJA[xIL[K+i]-(S->LIA[K+i]-S->LIJA[K+i])];
xJL[K+i] = xJL[m]; xJL[m] = K+i;
}
i++; /* since just did 2 rows */
xIL[K+i] = S->LIA[K+i]+(to_elim-i);
if ( xIL[K+i] < S->LIA[K+i+1] )
{ m = S->LJA[xIL[K+i]-(S->LIA[K+i]-S->LIJA[K+i])];
xJL[K+i] = xJL[m]; xJL[m] = K+i;
}
}
}
K += to_elim;
}
/**************************************************************************
*
* function: traverse_region_tree()
*
* purpose: do numerical factoring.
* Permutes nodes to factoring order according to region tree.
* Calls factor_recur().
*/
void traverse_region_tree(S)
struct linsys *S;
{ struct region *r;
int rnum,n;
int fill;
/* allocate space */
for ( fill = 0, n = 0 ; n < S->N ; n++ )
{ int tmp = S->LIA[n]; S->LIA[n] = fill; fill += tmp; }
S->LIA[S->N] = fill;
if ( fill != total_fill )
{ sprintf(errmsg,"Internal error: fill %d != total_fill %d\n",fill,total_fill);
kb_error(1836,errmsg,RECOVERABLE);
}
xIL = (int*)temp_calloc(S->N,sizeof(int));
xJL = (int*)temp_calloc(S->N,sizeof(int));
for ( n = 0 ; n < S->N ; n++ ) xJL[n] = -1; /* list terminators */
/* get tree traverse permutation order */
K = 0;
IJA_base = 0; /* for total LIJA entries */
for ( rnum = regionstart ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
permute_recur(S,r);
}
sparse_permute(S);
if ( hessian_linear_metric_flag && (S->lambda != 0.0) )
{ memcpy((char*)Met.P,(char*)S->P,S->N*sizeof(int));
memcpy((char*)Met.IP,(char*)S->IP,S->N*sizeof(int));
sparse_permute(&Met);
}
/* allocate L space */
S->Lsize = total_fill;
S->LJA = (int*)temp_realloc((char*)S->LJA,IJA_base*sizeof(int));
S->LIJA = (int*)temp_realloc((char*)S->LIJA,(S->N+1)*sizeof(int));
S->LA = (REAL*)temp_realloc((char*)S->LA,S->Lsize*sizeof(REAL));
memset(S->LJA,0,IJA_base*sizeof(int));
memset(S->LIJA,0,(S->N+1)*sizeof(int));
memset(S->LA,0,S->Lsize*sizeof(REAL));
K = 0; /* current row */
IJA_base = 0 ;
for ( rnum = regionstart ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
factor_recur(S,r);
}
temp_free((char*)xIL); xIL = NULL;
temp_free((char*)xJL); xJL = NULL;
/* test_print(S,0); */
/*debug */ /* dsolve(S); */
}
/*************************************************************************
*
* function: xmd_solve()
*
* purpose: solve factored system for given right hand side
* Factor stored as U, permuted order
* LJA indices in LIJA, LA indices in LIA
*
*/
void xmd_solve(S,B,x)
struct linsys *S; /* factored system */
REAL *B; /* incoming right hand side */
REAL *x; /* solution, may be rhs */
{
int n; /* row index */
int i;
int *jp; /* pointer into LIJA */
REAL *BB,*Y,*e;
if ( S->psize == NULL )
kb_error(1837,"Internal error: Must call xmd_factor before xmd_solve.\n",
RECOVERABLE);
/* Use existing working storage if possible */
if ( S->NSP*sizeof(int) < 2*S->N*sizeof(REAL))
{ S->ISP = (int*)temp_realloc((char*)S->ISP,2*S->N*sizeof(REAL));
S->NSP = (2*S->N*sizeof(REAL))/sizeof(int);
}
BB = (REAL*)S->ISP; /* intermediate solutions */
Y = ((REAL*)S->ISP) + S->N; /* intermediate solutions */
/* solve U^T Y = B */
for ( n = 0 ; n < S->N ; n++ ) BB[n] = B[S->P[n]]; /* permute */
for ( n = 0 ; n < S->N ; n++ )
{ int start,end;
Y[n] = BB[S->LJA[S->LIJA[n]]]; /* for BK inner permutation */
if ( Y[n] == 0.0 ) continue;
if ( S->psize[n] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S->LIA[n+1];
for ( i=S->LIA[n]+start, e=S->LA+i , jp=S->LJA+S->LIJA[n]+start ;
i < end ; i++,e++,jp++ )
BB[*jp] -= (*e)*Y[n];
}
/* solve D V = Y (will use Y to store V) */
for ( n = 0 ; n < S->N ; n++ )
{ if ( S->psize[n] == ONEBYONE )
Y[n] /= S->LA[S->LIA[n]];
else if ( S->psize[n] == ZEROPIVOT ) Y[n] = 0.0; /* generalized inverse */
else
{ REAL piv[2][2];
REAL pinv[2][2];
REAL det,yy;
piv[0][0] = S->LA[S->LIA[n]];
piv[0][1] = piv[1][0] = S->LA[S->LIA[n]+1];
piv[1][1] = S->LA[S->LIA[n+1]];
det = piv[0][0]*piv[1][1] - piv[0][1]*piv[1][0];
pinv[0][0] = piv[1][1]/det;
pinv[1][0] = pinv[0][1] = -piv[0][1]/det;
pinv[1][1] = piv[0][0]/det;
yy = Y[n]*pinv[0][0] + Y[n+1]*pinv[1][0];
Y[n+1] = Y[n]*pinv[0][1] + Y[n+1]*pinv[1][1];
Y[n] = yy;
n++;
}
}
/* solve U X = V */
for ( n = S->N-1 ; n >= 0 ; n-- )
{ int start,end;
if ( S->psize[n] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S->LIA[n+1];
for ( i=S->LIA[n]+start, e=S->LA+i, jp=S->LJA+S->LIJA[n]+start ;
i < end ; i++,e++,jp++ )
Y[n] -= (*e)*BB[*jp];
BB[S->LJA[S->LIJA[n]]] = Y[n];
}
/* unpermute */
for ( n = 0 ; n < S->N ; n++ )
x[S->P[n]] = BB[n];
}
/*************************************************************************
*
* function: xmd_solve_multi()
*
* purpose: solve factored system for multiple right hand sides
* Factor stored as U, permuted order
* LJA indices in LIJA, LA indices in LIA
*
*/
void xmd_solve_multi(S,B,x,rk)
struct linsys *S; /* factored system */
REAL **B; /* incoming right hand side */
REAL **x; /* solution, may be rhs */
int rk; /* number of right sides */
{ int k; /* rhs column index */
for ( k = 0 ; k < rk ; k++ )
xmd_solve(S,B[k],x[k]);
return;
#ifdef OLDXMDMULTI
/* something wrong with this */
{ int n; /* row index */
int i;
int *jp; /* pointer into LIJA */
REAL **BB,**Y,*e;
if ( S->psize == NULL )
kb_error(2531,"Internal error: Must call BK_factor before BK_solve.\n",RECOVERABLE);
BB = dmatrix(0,S->N-1,0,rk-1); /* intermediate solutions */
Y = dmatrix(0,S->N-1,0,rk-1); /* intermediate solutions */
/* solve U^T Y = B */
for ( n = 0 ; n < S->N ; n++ )
for ( k = 0 ; k < rk ; k++ )
BB[n][k] = B[k][S->P[n]]; /* permute */
for ( n = 0 ; n < S->N ; n++ )
{ int start,end;
REAL *yy,*bb,ee;
for ( yy = Y[n], k = 0 , bb = BB[S->LJA[S->LIJA[n]]]; k < rk ; k++ )
*(yy++) = *(bb++);
if ( S->psize[n] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S->LIA[n+1];
for ( i=S->LIA[n]+start, e=S->LA+i , jp=S->LJA+S->LIJA[n]+start ;
i < end ; i++,e++,jp++ )
{ ee = *e;
for ( bb = BB[*jp], yy = Y[n], k = 0 ; k < rk ; k++ )
*(bb++) -= ee*(*(yy++));
}
}
/* solve D V = Y (will use Y to store V) */
for ( n = 0 ; n < S->N ; n++ )
{ if ( S->psize[n] == ONEBYONE )
{ REAL *y,pinv;
pinv = 1.0/S->LA[S->LIA[n]];
for ( y = Y[n], k = 0 ; k < rk ; k++ )
*(y++) *= pinv;
}
else if ( S->psize[n] == ZEROPIVOT )
for ( k = 0 ; k < rk ; k++ ) Y[n][k] = 0.0; /* generalized inverse */
else
{ REAL piv[2][2];
REAL pinv[2][2];
REAL det,yy;
piv[0][0] = S->LA[S->LIA[n]];
piv[0][1] = piv[1][0] = S->LA[S->LIA[n]+1];
piv[1][1] = S->LA[S->LIA[n+1]];
det = piv[0][0]*piv[1][1] - piv[0][1]*piv[1][0];
pinv[0][0] = piv[1][1]/det;
pinv[1][0] = pinv[0][1] = -piv[0][1]/det;
pinv[1][1] = piv[0][0]/det;
for ( k = 0 ; k < rk ; k++ )
{ yy = Y[n][k]*pinv[0][0] + Y[n+1][k]*pinv[1][0];
Y[n+1][k] = Y[n][k]*pinv[0][1] + Y[n+1][k]*pinv[1][1];
Y[n][k] = yy;
}
n++;
}
}
/* solve U X = V */
for ( n = S->N-1 ; n >= 0 ; n-- )
{ int start,end;
REAL *yy,*bb,ee;
if ( S->psize[n] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S->LIA[n+1];
for ( i=S->LIA[n]+start, e=S->LA+i, jp=S->LJA+S->LIJA[n]+start ;
i < end ; i++,e++,jp++ )
{ ee = *e;
for ( yy = Y[n], bb = BB[*jp], k = 0 ; k < rk ; k++ )
*(yy++) -= ee*(*(bb++));
}
for ( yy = Y[n], bb = BB[S->LJA[S->LIJA[n]]], k = 0 ; k < rk ; k++ )
*(bb++) = *(yy++);
}
/* unpermute */
for ( n = 0 ; n < S->N ; n++ )
for ( k = 0 ; k < rk ; k++ )
x[k][S->P[n]] = BB[n][k];
free_matrix(Y);
free_matrix(BB);
}
#endif
}
/*************************************************************************/
void dsolve(S) /* solve as dense matrix */
struct linsys *S;
{ REAL **a,**u;
int i,j,k,m,jj;
int *xIP = (int*)temp_calloc(S->N,sizeof(int));
for ( k = 0 ; k < S->N ; k++ )
xIP[S->LJA[S->LIJA[k]]] = k;
a = dmatrix(0,S->N-1,0,S->N-1);
for ( i = 0 ; i < S->N ; i++ )
{ for ( j = S->IA[i]-A_OFF ; j < S->IA[i+1] - A_OFF ; j++ )
{ k = xIP[S->IP[i]];
m = xIP[S->IP[S->JA[j]-A_OFF]];
a[k][m] = a[m][k] = S->A[j];
}
}
for ( i = 0 ; i < S->N ; i++ )
{
if ( S->psize[i] == ONEBYONE )
{ for ( j = i+1 ; j < S->N ; j++ )
for ( k = i+1 ; k < S->N ; k++ )
a[j][k] -= a[i][j]*a[i][k]/a[i][i];
for ( k = i+1 ; k < S->N ; k++ )
a[i][k] /= a[i][i];
}
else if ( S->psize[i] == ZEROPIVOT )
{ a[i][i] = 0.0;
}
else
{ REAL p11,p12,p22,detinv,pa1,pa2;
p11 = a[i][i]; p12 = a[i][i+1]; p22 = a[i+1][i+1];
detinv = 1/(p11*p22 - p12*p12);
/* sweep through matrix */
for ( k = i+2 ; k < S->N ; k++ ) /* row */
{ pa1 = (a[i][k]*p22 - a[i+1][k]*p12)*detinv;
pa2 = (a[i+1][k]*p11 - a[i][k]*p12)*detinv;
for ( j=k ; j < S->N ; j++ ) /*col*/
{ a[k][j] -= pa1*a[i][j] + pa2*a[i+1][j];
}
a[i][k] = pa1;
a[i+1][k] = pa2;
}
i++; /* since did 2 rows */
}
}
u = dmatrix(0,S->N-1,0,S->N-1);
for ( i = 0 ; i < S->N ; i++ )
for ( j = S->LIA[i], jj = S->LIJA[i]; j < S->LIA[i+1] ; j++ )
u[i][S->LJA[jj]] = S->LA[j];
for ( i = 0 ; i < S->N ; i++ )
for ( j = i ; j < S->N ; j++ )
if ( fabs(a[i][j]-u[i][j]) > 100*machine_eps )
{ printf("u[%d][%d] = %20.15f a[%d][%d] = %20.15f\n",
i,j,(DOUBLE)u[i][j],i,j,(DOUBLE)a[i][j]);
break;
}
free_matrix(a);
free_matrix(u);
temp_free((char*)xIP);
}
/***************************************************************************
*
* function: xmd_factor()
*
* purpose: experimental minimal degree factoring of system
*
*/
void xmd_factor(S)
struct linsys *S;
{ int i,j;
int rnum;
struct region *r;
if ( S->N <= 0 )
{ kb_error(1839,"Internal error: Empty linear system.\n",WARNING);
return;
}
total_flops = total_fill = 0;
rtimestamp = 0;
stimestamp = 0;
old_rtimestamp = -1; /* less than rtimestamp first time around */
vtimestamp = 0;
S->neg = S->zero = S->pos = 0;
S->degencon = 0;
/* working storage */
S->NSP = 4*S->IA[S->N];
S->ISP = (int*)temp_realloc((char*)S->ISP,S->NSP*sizeof(int));
memset(S->ISP,0,S->NSP*sizeof(int));
/* row magnitudes for nullity detection */
S->rowmag = (REAL *)temp_realloc((char*)S->rowmag,S->N*sizeof(REAL));
memset(S->rowmag,0,S->N*sizeof(REAL));
for ( i = 0 ; i < S->N ; i++ )
{ int end = S->IA[i+1] - A_OFF;
for ( j = S->IA[i]-A_OFF ; j < end ; j++ )
{ S->rowmag[i] += S->A[j]*S->A[j];
S->rowmag[S->JA[j]-A_OFF] += S->A[j]*S->A[j];
}
}
for ( i = 0 ; i < S->N ; i++ )
S->rowmag[i] = sqrt(S->rowmag[i]);
md_vertex_setup(S);
md_supernode_setup(S);
md_region_string(S);
md_supernode_regions(S);
/* space for lists */
superheap = (struct supernode**)temp_calloc(supercount+1,
sizeof(struct supernode*));
/* final lower triangular matrix storage */
S->psize = (int*)temp_realloc((char*)S->psize,S->N*sizeof(int));
S->LIA = (int*)temp_realloc((char*)S->LIA,(S->N+1)*sizeof(int));
memset((char*)S->psize,0,S->N*sizeof(int));
memset((char*)S->LIA,0,(S->N+1)*sizeof(int));
L_total = 0;
elim_count = 0;
for(passes=0;;passes++)
{
if ( supercount == 0 ) break;
degree_sort(S);
multiple_eliminate(S);
region_absorb(S); /* needed to have few passes through main loop */
clean_supernodes(S); /* supernodes stamped */
merge_supernodes(S);
if ( mindeg_debug_level == -1 )
show_mindeg_state(S);
}
S->LIA[elim_count] = L_total; /* final sentinel */
/* free temp storage */
temp_free((char*)slist);
temp_free((char*)vlist); vlist = NULL;
temp_free((char*)superheap); superheap = NULL;
/* gather stats */
final_regions = 0;
final_versizes = 0;
for ( rnum = regionstart ; rnum >= 0 ; rnum = r->next )
{ r = REG(rnum);
groom_regions_recur(S,r);
}
compact_regions(S);
traverse_region_tree(S);
eigen_pos = S->pos;
eigen_neg = S->neg;
eigen_zero = S->zero;
if ( !hessian_quiet_flag )
{
printf("Variables: %d Original fill: %d\n",S->N,S->IA[S->N]);
printf("Workspace: %d bytes\n",S->ISP[0]*sizeof(int));
printf("Passes through main loop: %d\n",passes);
printf("Total_fill: %d\n",total_fill);
printf("Total_flops: %g\n",total_flops);
}
}
evolver-2.30c.dfsg/src/boundary.c 0000644 0001753 0001753 00000045542 11410765113 017216 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**************************************************************
*
* File: boundary.c
*
* Purpose: Handle boundary computations.
*/
#include "include.h"
/***************************************************************
*
* Function: b_proj()
*
* Purpose: Construct projection matrices from R^n vectors
* to parameter tangent space or to boundary tangent
* space.
*
* Mathematical background:
* Let T[i] be the boundary tangent along parameter i, and
* let V be the vector in R^n. Let C be the linear combination
* coefficients that give the projection of V:
* (proj V)[j] = C[i]*T[i][j] (sum on repeated indices)
* The projection is defined by having identical dot products with
* the tangents as does V:
* C[i]*T[i][j]*T[k][j] = V[j]*T[k][j] for all k.
* Define the matrix A by A[i][k] = T[i][j]*T[k][j], and let B be
* its inverse. Note A and B are symmetric. So
* A[k][i]*C[i] = T[k][j]*V[j]
* and
* C[i] = B[i][k]*T[k][j]*V[j].
* So the coefficient projection matrix is D[i][j] = B[i][k]*T[k][j].
* (which is returned for PARAMPROJ)
* And
* (proj V)[m] = C[i]*T[i][m] = T[i][m]*B[i][k]*T[k][j]*V[j]
* so the tangent projection matrix is
* E[m][j] = T[i][m]*B[i][k]*T[k][j].
* (which is returned for TANJPROJ)
*/
void b_proj(bdry,param,a,type,v_id)
struct boundary *bdry; /* boundary involved */
REAL *param; /* parameter values to use */
REAL **a; /* returned matrix */
int type; /* PARAMPROJ or TANGPROJ */
vertex_id v_id; /* so can use extra attributes */
{
int pcount = bdry->pcount;
int i,j,k,m;
REAL dummy; /* for eval_all function value */
REAL temp[MAXCOORD];
MAT2D(B,3,3); /* both A and B above */
MAT2D(T,MAXCOORD,MAXCOORD);
for ( j = 0 ; j < SDIM ; j++ )
{ eval_all(bdry->coordf[j],param,pcount,&dummy,temp,v_id);
for ( i = 0 ; i < pcount ; i++ )
T[i][j] = temp[i];
}
for ( i = 0 ; i < pcount ; i++ )
for ( j = 0 ; j < pcount ; j++ )
B[i][j] = SDIM_dot(T[i],T[j]);
mat_inv(B,pcount);
if ( type == PARAMPROJ )
{ for ( i = 0 ; i < pcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ a[i][j] = 0.0;
for ( k = 0 ; k < pcount ; k++ )
a[i][j] += B[i][k]*T[k][j];
}
}
else if ( type == TANGPROJ )
{ for ( m = 0 ; m < SDIM ; m++ )
for ( j = 0 ; j < SDIM ; j++ )
{ a[m][j] = 0.0;
for ( i = 0 ; i < pcount ; i++ )
for ( k = 0 ; k < pcount ; k++ )
a[m][j] += T[i][m]*B[i][k]*T[k][j];
}
}
else if ( type == GRADPROJ )
{ for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < pcount ; j++ )
{ a[i][j] = 0.0;
for ( k = 0 ; k < pcount ; k++ )
a[i][j] += T[k][i]*B[k][j];
}
}
} /* end b_proj() */
/**********************************************************************
*
* Function: b_extrapolate()
*
* Purpose: Find projection of point on boundary, starting at
* given boundary location and projecting several
* times on tangent.
*/
void b_extrapolate(bdry,base_x,point_x,new_x,base_param,new_param,v_id)
struct boundary *bdry; /* boundary involved (in) */
REAL *base_x; /* coordinates of base point (in) */
REAL *point_x; /* coordinates of point to project (in) */
REAL *new_x; /* projected coordinates (out) */
REAL *base_param; /* base point parameters (in) */
REAL *new_param; /* projected parameters (out) */
vertex_id v_id; /* so can use vertex attributes */
{
int pcount;
REAL co[MAXCOORD];
int i,k;
REAL x[MAXCOORD],s[MAXCOORD];
MAT2D(a,MAXPARAM,MAXCOORD);
pcount = bdry->pcount;
for ( k = 0 ; k < SDIM ; k++ )
{ x[k] = base_x[k]; /* start at base point */
new_param[k] = base_param[k];
}
#ifdef OLDWAY
/* iterate projection on tangent till get close to desired point */
for ( i = 0 ; i < 5 ; i++ )
{
for ( k = 0 ; k < SDIM ; k++ )
s[k] = point_x[k] - x[k];
b_proj(bdry,new_param,a,PARAMPROJ,v_id);
matvec_mul(a,s,co,pcount,SDIM);
for ( k = 0 ; k < pcount ; k++ )
new_param[k] += co[k];
for ( k = 0 ; k < SDIM ; k++ )
x[k] = eval(bdry->coordf[k],new_param,NULLID,NULL);
}
#else
/* from Laszlo Csirmaz, being much more careful */
for ( i=0; i<5; i++)
{ REAL lambda, oldsq,newsq,newx; REAL pp[MAXPARAM];
int iter;
lambda=1.0; oldsq=0.0;
for(k=0;k 1e-10 )
{
b_proj(bdry,new_param,a,PARAMPROJ,v_id);
matvec_mul(a,s,co,pcount,SDIM); /* the correcting vector is in co */
for(iter=0;iter<10;iter++)
{
// the goal is x + lambda*(point_x - x)
// the distance is lambda*sqrt(oldsq);
for( k=0;kcoordf[k],pp,NULLID,NULL);
tmp = x[k]-s[k]; newx += tmp*tmp;
tmp += lambda*(point_x[k]-x[k]);
newsq+= tmp*tmp;
}
// is it close enough?
if( newsq <= 0.5*oldsq || (newsq <= oldsq+1e-10 &&
(newx <= 0.5*oldsq || newsq <= 1e-10 || newx <= 1e-10 ))) break;
lambda *= 0.5;
oldsq *= 0.25;
}
if(iter== 10 )
{
kb_error(9000,"Extrapolate does not converge in 10 steps: boundary is not smooth enough.\n",RECOVERABLE);
}
for(k=0;kattr & B_CONVEX) ) return;
tail = get_edge_tailv(e_id);
if ( bdry != get_boundary(tail) )
{ invert(e_id);
tail = get_edge_tailv(e_id);
if ( bdry != get_boundary(tail) ) return;
}
head = get_edge_headv(e_id);
/* now the calculation */
get_edge_side(e_id,s);
ss = SDIM_dot(s,s);
if ( bdry->pcount == 1 )
{ REAL t1[MAXCOORD],t2[MAXCOORD], ac,t1t1,t2t2,st1,st2,t1u1,t2u2,ar1,ar2,ep;
REAL *accel = &ac,*params,t1t2,val,su1,su2;
/* tail vertex */
params = get_param(tail);
su1 = t1t1 = st1 = t1u1 = 0.0;
for ( i = 0 ; i < SDIM ; i++ )
{
eval_second(bdry->coordf[i],params,bdry->pcount,&val,t1+i,&accel,tail);
t1t1 += t1[i]*t1[i];
st1 += s[i]*t1[i];
t1u1 += t1[i]*ac;
su1 += s[i]*ac;
}
ar1 = sqrt(ss*t1t1/st1/st1 - 1.0);
/* head vertex */
params = get_param(head);
su2 = t2t2 = st2 = t2u2 = t1t2 = 0.0;
for ( i = 0 ; i < SDIM ; i++ )
{
eval_second(bdry->coordf[i],params,bdry->pcount,&val,t2+i,&accel,tail);
t2t2 += t2[i]*t2[i];
t1t2 += t1[i]*t2[i];
st2 += s[i]*t2[i];
t2u2 += t2[i]*ac;
su2 += s[i]*ac;
}
ar2 = sqrt(ss*t2t2/st2/st2 - 1.0);
ep = -st1/6*(ar1+ar2);
ep += ss/12/ar1*((-st1*t1t1+ss*t1u1) - ss*t1t1*(-t1t1+su1)/st1)/st1/st1;
ep += ss/12/ar2*(-st1*t2t2 + ss*t2t2*t1t2/st2)/st2/st2;
f = get_force(tail);
for ( i = 0 ; i < SDIM ; i++ )
f[i] -= ep*t1[i]/t1t1;
ep = st2/6*(ar1+ar2);
ep += ss/12/ar2*((st2*t2t2+ss*t2u2) - ss*t2t2*(t2t2+su2)/st2)/st2/st2;
ep += ss/12/ar1*(st2*t1t1 - ss*t1t1*t1t2/st1)/st1/st1;
f = get_force(head);
for ( i = 0 ; i < SDIM ; i++ )
f[i] -= ep*t2[i]/t2t2;
}
else /* 2 or more parameters */
{ b_proj(bdry,get_param(tail),a,TANGPROJ,tail);
matvec_mul(a,s,q,SDIM,SDIM);
qq = SDIM_dot(q,q);
norm = web.spring_constant*(1 + (ss-qq)/3/qq)*sqrt(fabs(ss-qq)/qq)/2;
f = get_force(tail);
for ( i = 0 ; i < SDIM ; i++ )
f[i] += norm*q[i];
b_proj(bdry,get_param(head),a,TANGPROJ,head);
matvec_mul(a,s,q,SDIM,SDIM);
qq = SDIM_dot(q,q);
norm = web.spring_constant*(1 + (ss-qq)/3/qq)*sqrt(fabs(ss-qq)/qq)/2;
f = get_force(head);
for ( i = 0 ; i < SDIM ; i++ )
f[i] -= norm*q[i];
}
} /* end bdry_force */
/*****************************************************************
*
* Function: bdry_spring_energy()
*
* Purpose: Calculate energy of kludge boundary force.
*/
void bdry_spring_energy(e_id)
edge_id e_id;
{
REAL s[MAXCOORD],q[MAXCOORD];
struct boundary *bdry;
vertex_id tail,head;
REAL ss,qq,sprenergy;
MAT2D(a,3,3);
if ( get_eattr(e_id) & FIXED ) return;
if ( !(get_eattr(e_id) & BOUNDARY) ) return;
/* see if edge and tail are on same boundary */
bdry = get_edge_boundary(e_id);
if ( !bdry ) return;
if ( !(bdry->attr & B_CONVEX) ) return;
tail = get_edge_tailv(e_id);
head = get_edge_headv(e_id);
if ( bdry != get_boundary(tail) )
{
invert(e_id);
tail = get_edge_tailv(e_id);
head = get_edge_headv(e_id);
if ( bdry != get_boundary(tail) ) return;
}
/* now the calculation */
get_edge_side(e_id,s);
ss = SDIM_dot(s,s);
b_proj(bdry,get_param(tail),a,TANGPROJ,tail);
matvec_mul(a,s,q,SDIM,SDIM);
qq = SDIM_dot(q,q);
sprenergy = web.spring_constant*ss*sqrt((ss - qq)/qq)/12;
b_proj(bdry,get_param(head),a,TANGPROJ,head);
matvec_mul(a,s,q,SDIM,SDIM);
qq = SDIM_dot(q,q);
sprenergy += web.spring_constant*ss*sqrt((ss - qq)/qq)/12;
binary_tree_add(web.total_energy_addends,sprenergy);
web.spring_energy += sprenergy;
} /* end bdry_spring_energy */
/*****************************************************************
*
* Function: bdry_basis()
*
* Purpose: calculate basis of boundary tangent plane.
*/
int bdry_basis(v_id,basis)
vertex_id v_id;
REAL **basis; /* for return */
{
struct boundary *b = get_boundary(v_id);
int j,i;
REAL dummy; /* for eval_all function value */
REAL temp[MAXCOORD];
if ( !b ) return 0;
for ( j = 0 ; j < SDIM ; j++ )
{
eval_all(b->coordf[j],get_param(v_id),b->pcount,&dummy,temp,v_id);
for ( i = 0 ; i < b->pcount ; i++ )
basis[i][j] = temp[i];
}
return b->pcount;
} /* end bdry_basis() */
/*****************************************************************************
*
* VERTEX-VERTEX HITTING ON ONE-PARAMETER BOUNDARY
*
******************************************************************************/
#define BDRYHIT_PARTNER_NAME "bdryhit_partner"
/******************************************************************************
*
* function: detect_bdry_hits()
*
* purpose: detect when two vertices along a BOUNDARY_HITTING boundary
* collide and setting positions to average thereof.
*/
void detect_bdry_hits()
{ vertex_id v_id,vv_id;
struct boundary *bdry;
int i,exnum,partner;
REAL p1,pp1;
int eltype;
exnum = find_extra(BDRYHIT_PARTNER_NAME,&eltype);
if ( exnum < 0 )
return;
FOR_ALL_VERTICES(v_id)
{ if ( !(get_vattr(v_id) & BOUNDARY) ) continue;
bdry = get_boundary(v_id);
if ( !(bdry->attr & PARTNER_HITTING) ) continue;
partner = *VINT(v_id,exnum);
if ( partner == 0 ) continue;
vv_id = get_ordinal_id(VERTEX,abs(partner)-1);
if ( !valid_id(vv_id) ) continue;
if ( abs(*VINT(vv_id,exnum)) != loc_ordinal(v_id)+1 )
{ sprintf(errmsg,"Partner of %s is %d, but partner of %d is %d.\n",
ELNAME(v_id),partner,partner,abs(*VINT(vv_id,exnum)));
kb_error(3378,errmsg,RECOVERABLE);
}
p1 = get_param(v_id)[0];
pp1 = get_param(vv_id)[0];
if ( ((partner > 0) && (pp1 < p1 )) || ((partner < 0) && (pp1 > p1)) )
{ REAL *param = get_param(v_id);
REAL *x = get_coord(v_id);
param[0] = (p1+pp1)/2;
for ( i = 0 ; i < SDIM ; i++ )
x[i] = eval(bdry->coordf[i],param,v_id,NULL);
param = get_param(vv_id);
x = get_coord(vv_id);
param[0] = (p1+pp1)/2;
for ( i = 0 ; i < SDIM ; i++ )
x[i] = eval(bdry->coordf[i],param,vv_id,NULL);
set_attr(v_id,HIT_PARTNER);
set_attr(vv_id,HIT_PARTNER);
}
}
}
/******************************************************************************
*
* function: partner_hit_velocity_fix()
*
* purpose: For vertices hitting on a PARTNER_HITTING boundary
* set force on each to average.
*/
void partner_hit_velocity_fix()
{ vertex_id v_id,vv_id;
struct boundary *bdry;
int i,exnum,partner,eltype;
REAL *v,*vv;
exnum = find_extra(BDRYHIT_PARTNER_NAME,&eltype);
if ( exnum < 0 )
return;
FOR_ALL_VERTICES(v_id)
{ if ( !(get_vattr(v_id) & HIT_PARTNER) ) continue;
bdry = get_boundary(v_id);
if ( !(bdry->attr & PARTNER_HITTING) ) continue;
partner = *VINT(v_id,exnum);
if ( partner == 0 ) continue;
vv_id = get_ordinal_id(VERTEX,abs(partner)-1);
v = get_velocity(v_id);
vv = get_velocity(vv_id);
for ( i = 0 ; i < SDIM ; i++ )
{ REAL avev = (v[i]+vv[i])/2;
v[i] = vv[i] = avev;
}
}
}
/******************************************************************************
*
* function: partner_hit_volgrad_fix()
*
* purpose: For vertices hitting on a PARTNER_HITTING boundary
* set volgrad velocity on each to average.
*/
void partner_hit_volgrad_fix()
{ vertex_id v_id,vv_id;
struct boundary *bdry;
int i,exnum,partner,eltype;
exnum = find_extra(BDRYHIT_PARTNER_NAME,&eltype);
if ( exnum < 0 )
return;
FOR_ALL_VERTICES(v_id)
{ struct volgrad *vgptr,*vvgptr;
if ( !(get_vattr(v_id) & HIT_PARTNER) ) continue;
bdry = get_boundary(v_id);
if ( !(bdry->attr & PARTNER_HITTING) ) continue;
partner = *VINT(v_id,exnum);
if ( partner == 0 ) continue;
vv_id = get_ordinal_id(VERTEX,abs(partner)-1);
for ( vgptr = get_vertex_vgrad(v_id) ; vgptr ;
vgptr = vgptr->chain )
for ( vvgptr = get_vertex_vgrad(vv_id) ; vvgptr ;
vvgptr = vvgptr->chain )
if ( vgptr->fixnum == vvgptr->fixnum )
{ for ( i = 0 ; i < SDIM ; i++ )
{ REAL avev = (vgptr->velocity[i]+vvgptr->velocity[i])/2;
vgptr->velocity[i] = vvgptr->velocity[i] = avev;
}
}
}
}
/***************************************************************************
*
* function: partner_shift_grads()
*
* purpose: For vertices with partners, shift all grads to vertex with
* lower id.
*/
void partner_shift_grads(mode)
int mode; /* bits for CALC_FORCE and CALC_VOLGRADS */
{ vertex_id v_id,vv_id;
struct boundary *bdry;
int i,exnum,partner,eltype;
exnum = find_extra(BDRYHIT_PARTNER_NAME,&eltype);
if ( exnum < 0 )
return;
FOR_ALL_VERTICES(v_id)
{ struct volgrad *vgptr,*vvgptr,*prev,temp;
REAL *x,*xx;
if ( !(get_vattr(v_id) & HIT_PARTNER) ) continue;
bdry = get_boundary(v_id);
if ( !(bdry->attr & PARTNER_HITTING) ) continue;
partner = *VINT(v_id,exnum);
if ( partner == 0 ) continue;
if ( abs(partner) >= ordinal(v_id)+1 ) continue;
vv_id = get_ordinal_id(VERTEX,abs(partner)-1); /* destination */
if ( abs(*VINT(vv_id,exnum)) != ordinal(v_id)+1 )
{ sprintf(errmsg,"Partner of %d is %d, but partner of %d is %d.\n",
ordinal(v_id)+1,partner,partner,abs(*VINT(vv_id,exnum)));
kb_error(3383,errmsg,RECOVERABLE);
}
if ( mode & CALC_FORCE )
{ x = get_force(v_id);
xx = get_force(vv_id);
for ( i = 0 ; i < SDIM ; i++ )
{ xx[i] += x[i];
x[i] = 0.0;
}
}
if ( (mode & CALC_VOLGRADS) && vgradbase )
{ prev = NULL;
for ( vgptr = get_vertex_vgrad(v_id) ; vgptr ; prev = vgptr,
vgptr = vgptr->chain )
{ int found = 0;
for ( vvgptr = get_vertex_vgrad(vv_id) ; vvgptr ;
vvgptr = vvgptr->chain )
if ( vgptr->fixnum == vvgptr->fixnum )
{ for ( i = 0 ; i < SDIM ; i++ )
{ vvgptr->grad[i] += vgptr->grad[i];
vgptr->grad[i] = 0.0;
}
found = 1;
break;
}
if ( !found ) /* move whole structure over to vv_id */
{ vvgptr = get_vertex_vgrad(vv_id);
temp.chain = vgptr->chain;
set_vertex_vgrad(vv_id,vgptr);
if ( prev )
prev->chain = vgptr->chain;
else set_vertex_vgrad(v_id,vgptr->chain);
vgptr->chain = vvgptr;
vgptr = &temp;
}
}
}
}
}
/***************************************************************************
*
* function: partner_move()
*
* purpose: For vertices with partners, shift position to vertex with
* lower id.
*/
void partner_move()
{ vertex_id v_id,vv_id;
struct boundary *bdry;
int i,exnum,partner,eltype;
exnum = find_extra(BDRYHIT_PARTNER_NAME,&eltype);
if ( exnum < 0 )
return;
FOR_ALL_VERTICES(v_id)
{ REAL *x,*xx,*p,*pp;
if ( !(get_vattr(v_id) & HIT_PARTNER) ) continue;
bdry = get_boundary(v_id);
if ( !(bdry->attr & PARTNER_HITTING) ) continue;
partner = *VINT(v_id,exnum);
if ( partner == 0 ) continue;
if ( abs(partner) >= ordinal(v_id)+1 ) continue;
vv_id = get_ordinal_id(VERTEX,abs(partner)-1); /* destination */
if ( !valid_id(vv_id) ) continue;
if ( abs(*VINT(vv_id,exnum)) != ordinal(v_id)+1 )
{ sprintf(errmsg,"Partner of %d is %d, but partner of %d is %d.\n",
ordinal(v_id)+1,partner,partner,abs(*VINT(vv_id,exnum)));
kb_error(3006,errmsg,RECOVERABLE);
}
p = get_param(v_id);
pp = get_param(vv_id);
x = get_coord(v_id);
xx = get_coord(vv_id);
for ( i = 0 ; i < SDIM ; i++ )
x[i] = xx[i];
for ( i = 0 ; i < bdry->pcount ; i++ )
p[i] = pp[i];
}
}
evolver-2.30c.dfsg/src/gauss.c 0000644 0001753 0001753 00000120203 11410765113 016501 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: gauss.c
*
* Purpose: Does calculations needed for including gauss curvature
* integral named method. Linear model only.
* Implemented as total angle deficit of boundary vertices.
* Uses general quantity interface.
*/
#include "include.h"
void sqgauss_method_cleanup ARGS((void));
REAL levine_energy_all ARGS(( struct qinfo *, int ));
/*********************************************************************
*
* function: gauss_integral_init()
*
* purpose: Check illegalities, and sees if attributes defined for
* designating boundaries.
*
*/
#define GAUSS_BDRY_V_NAME "gauss_bdry_v"
#define GAUSS_BDRY_E_NAME "gauss_bdry_e"
int gauss_bdry_v_attr,gauss_bdry_e_attr;
void gauss_integral_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.dimension != 2 )
kb_error(1590,"gauss_integral method only for 2D facets.\n",RECOVERABLE);
if ( SDIM != 3 )
kb_error(1591,"gauss_integral method only for 3D space.\n",RECOVERABLE);
if ( web.modeltype != LINEAR )
kb_error(1592,"gauss_integral method only for LINEAR model.\n",RECOVERABLE);
gauss_bdry_v_attr = find_attribute(VERTEX,GAUSS_BDRY_V_NAME);
gauss_bdry_e_attr = find_attribute(EDGE,GAUSS_BDRY_E_NAME);
}
/********************************************************************
*
* function: gauss_int_energy()
*
* purpose: single facet contribution to total angle of boundary
* vertices.
*
*/
REAL gauss_int_energy(f_info)
struct qinfo *f_info;
{ REAL s1[MAXCOORD],s2[MAXCOORD];
facetedge_id fe;
vertex_id v_id;
int k;
REAL energy = 0.0;
REAL a;
fe = get_facet_fe(f_info->id);
for ( k = 0 ; k < FACET_VERTS ; k++, fe = get_next_edge(fe) )
{ edge_id e_id = get_fe_edge(fe);
if ( gauss_bdry_e_attr >= 0 )
{ if ( *(int*)get_extra(e_id,gauss_bdry_e_attr) )
energy -= M_PI; /* normalization */
} else
if ( get_eattr(e_id) & (BOUNDARY|FIXED) )
energy -= M_PI; /* normalization */
v_id = get_fe_tailv(fe);
if ( gauss_bdry_v_attr >= 0 )
{ if ( *(int*)get_extra(v_id,gauss_bdry_v_attr) == 0 )
continue;
}
else if ( !(get_vattr(v_id) & (BOUNDARY|FIXED) ) ) continue;
get_fe_side(fe,s1);
get_fe_side(get_prev_edge(fe),s2);
a = -SDIM_dot(s1,s2)/sqrt(SDIM_dot(s1,s1)*SDIM_dot(s2,s2));
energy += acos(a);
}
return energy;
}
/********************************************************************
*
* function: gauss_int_gradient()
*
* purpose: single facet contribution to gradient of total angle of
* boundary vertices.
*
*/
REAL gauss_int_gradient(f_info)
struct qinfo *f_info;
{ REAL s1[MAXCOORD],s2[MAXCOORD];
facetedge_id fe;
vertex_id v_id;
int j,k;
REAL energy = 0.0;
REAL ss1,ss2,ss12;
REAL a,b;
fe = get_facet_fe(f_info->id);
for ( k = 0 ; k < FACET_VERTS ; k++ )
memset((char*)(f_info->grad[k]),0,SDIM*sizeof(REAL));
for ( k = 0 ; k < FACET_VERTS ; k++, fe = get_next_edge(fe) )
{ edge_id e_id = get_fe_edge(fe);
if ( gauss_bdry_e_attr >= 0 )
{ if ( *(int*)get_extra(e_id,gauss_bdry_e_attr) )
energy -= M_PI; /* normalization */
} else
if ( get_eattr(e_id) & (BOUNDARY|FIXED) )
energy -= M_PI; /* normalization */
v_id = get_fe_tailv(fe);
if ( gauss_bdry_v_attr >= 0 )
{ if ( *(int*)get_extra(v_id,gauss_bdry_v_attr) == 0 )
continue;
}
else if ( !(get_vattr(v_id) & (BOUNDARY|FIXED) ) ) continue;
get_fe_side(fe,s1);
get_fe_side(get_prev_edge(fe),s2);
ss1 = SDIM_dot(s1,s1);
ss2 = SDIM_dot(s2,s2);
ss12 = SDIM_dot(s1,s2);
a = -ss12/sqrt(ss1*ss2);
energy += acos(a);
b = sqrt(1-a*a)*ss1*sqrt(ss1*ss2);
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[(k+1)%3][j] += (ss1*s2[j] - ss12*s1[j])/b;
b = sqrt(1-a*a)*ss2*sqrt(ss1*ss2);
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[(k+2)%3][j] += -(ss2*s1[j] - ss12*s2[j])/b;
}
return energy;
}
/********************************************************************
*
* Function: sqgauss_energy()
*
* Purpose: Does square gauss curvature energy calculation for vertices.
*
*/
void sqgauss_energy()
{
REAL modulus = globals(sqgauss_param)->value.real;
vertex_id v_id,v[3];
edge_id e_id;
facet_id f_id;
facetedge_id fe;
int fixcount;
int i;
REAL area;
REAL side[3][MAXCOORD];
REAL ss[3];
REAL st[3];
REAL angle;
REAL c;
REAL gc; /* gaussian curvarture */
struct gvert { REAL angle;
REAL area;
REAL star_area;
} *gverts,*gv;
gverts = (struct gvert*)temp_calloc(web.skel[VERTEX].max_ord+1,
sizeof(struct gvert));
/* accumulate angles around vertices */
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
fixcount = 0;
for ( i = 0; i < FACET_VERTS ; i++,fe=get_next_edge(fe) )
{ e_id = get_fe_edge(fe);
get_edge_side(e_id,side[i]);
v[i] = get_edge_tailv(e_id);
if ( get_vattr(v[i]) & (FIXED|BOUNDARY) ) fixcount++;
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
st[i] = SDIM_dot(side[i],side[(i+2)%3]);
}
area = 0.5*sqrt(ss[0]*ss[1]-st[1]*st[1]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ c = -st[i]/sqrt(ss[i]*ss[(i+2)%3]);
angle = acos(c);
gv = gverts + loc_ordinal(v[i]);
gv->angle += angle;
gv->area += area/3;
gv->star_area += area/(3-fixcount);
}
}
/* calc square gauss curvature at each vertex */
FOR_ALL_VERTICES(v_id)
{ struct gvert *vg = gverts + loc_ordinal(v_id);
if ( get_vattr(v_id) & (FIXED|BOUNDARY) ) continue;
gc = (wedge_angle(v_id) - vg->angle)/vg->area;
binary_tree_add(web.total_energy_addends,modulus*gc*gc*vg->star_area);
}
temp_free((char*)gverts);
}
/*************************************************************************
*
* function: wedge_angle()
*
* purpose: find topological angle around vertex:
* 2*pi for nonconstrained vertex
* pi for one constraint
* calculate angle between 2 constraints
*/
REAL wedge_angle(v_id)
vertex_id v_id;
{ int concount;
conmap_t *conmap = get_v_constraint_map(v_id);
REAL normal[2][MAXCOORD];
REAL c;
int j;
struct constraint *con;
REAL fval;
concount = conmap[0];
if ( concount == 0 ) return 2*M_PI;
if ( concount == 1 ) return M_PI;
/* two constraints, so find angle between */
if ( concount > 2 )
{ sprintf(errmsg,
"gauss_curvature_integral: More than two constraints on vertex %s.\n",
ELNAME(v_id));
kb_error(1593,errmsg,RECOVERABLE);
}
for ( j = 1, concount = 0 ; j <= (int)conmap[0] ; j++ )
{
con = get_constraint(conmap[j]);
eval_all(con->formula,get_coord(v_id),SDIM,&fval,normal[concount],v_id);
concount++;
}
c = SDIM_dot(normal[0],normal[1])
/sqrt(SDIM_dot(normal[0],normal[0]))
/sqrt(SDIM_dot(normal[1],normal[1]));
return M_PI - acos(c);
}
/********************************************************************
*
* Function: sqgauss_force()
*
* Purpose: Does square gauss curvature force calculation for vertices.
*
*/
void sqgauss_force()
{
REAL modulus = globals(sqgauss_param)->value.real;
vertex_id v_id,v[3];
edge_id e_id,e[3];
facet_id f_id;
facetedge_id fe;
int fixcount;
REAL side[3][MAXCOORD];
REAL ss[3];
REAL st[3];
int j,i;
REAL area,angle,c,c1,c2;
REAL *f;
REAL gc; /* gaussian curvarture */
struct gvert { REAL angle;
REAL angle_grad[MAXCOORD];
REAL area;
REAL area_grad[MAXCOORD];
REAL star_area;
REAL star_area_grad[MAXCOORD];
REAL gc; /* gaussian curvature */
} *gverts;
struct gedge { REAL area_grad[2][MAXCOORD];
REAL star_area_grad[2][MAXCOORD];
REAL angle_grad[2][MAXCOORD];
/* dhead/dtail, dtail/dhead */
} *gedges;
gverts = (struct gvert*)temp_calloc(web.skel[VERTEX].max_ord+1,
sizeof(struct gvert));
gedges = (struct gedge*)temp_calloc(web.skel[EDGE].max_ord+1,
sizeof(struct gedge));
/* accumulate angles around vertices */
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
fixcount = 0;
for ( i = 0; i < FACET_VERTS ; i++,fe=get_next_edge(fe) )
{ e[i] = get_fe_edge(fe);
get_edge_side(e[i],side[i]);
v[i] = get_edge_tailv(e[i]);
if ( get_vattr(v[i]) & (FIXED|BOUNDARY) ) fixcount++;
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
st[i] = SDIM_dot(side[i],side[(i+2)%3]);
}
area = 0.5*sqrt(ss[0]*ss[1]-st[1]*st[1]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ int i1 = (i+1)%3;
int i2 = (i+2)%3;
struct gedge *ge1,*ge2;
struct gvert *gv;
int jj1,jj2;
gv = gverts + loc_ordinal(v[i]);
ge1 = gedges + loc_ordinal(e[i]);
ge2 = gedges + loc_ordinal(e[i2]);
jj1 = inverted(e[i]) ? 1 : 0;
jj2 = inverted(e[i2]) ? 0 : 1;
c = -st[i]/sqrt(ss[i]*ss[i2]);
angle = acos(c);
gv->angle += angle;
c1 = (1+st[i]/ss[i])/area/2;
c2 = (1+st[i]/ss[i2])/area/2;
for ( j = 0 ; j < SDIM ; j++ )
gv->angle_grad[j] += c1*side[i][j] - c2*side[i2][j];
c1 = st[i]/ss[i]/area/2;
c2 = 1/area/2;
for ( j = 0 ; j < SDIM ; j++ )
ge1->angle_grad[jj1][j] -= c1*side[i][j] - c2*side[i2][j];
c1 = 1/area/2;
c2 = st[i]/ss[i2]/area/2;
for ( j = 0 ; j < SDIM ; j++ )
ge2->angle_grad[jj2][j] -= c1*side[i][j] - c2*side[i2][j];
gv->area += area/3;
gv->star_area += area/(3-fixcount);
c1 = ss[i1]/area/4;
c2 = st[i1]/area/4;
for ( j = 0 ; j < SDIM ; j++ )
{ c = c2*side[i1][j] - c1*side[i][j];
gv->area_grad[j] += c/3;
gv->star_area_grad[j] += c/(3-fixcount);
ge1->area_grad[jj1][j] += c/3;
ge2->area_grad[jj2][j] += c/3;
ge1->star_area_grad[jj1][j] += c/(3-fixcount);
ge2->star_area_grad[jj2][j] += c/(3-fixcount);
}
}
}
/* calc square gauss curvature at each vertex */
FOR_ALL_VERTICES(v_id)
{ struct gvert *gv = gverts + loc_ordinal(v_id);
if ( get_vattr(v_id) & (FIXED|BOUNDARY) ) continue;
gc = (wedge_angle(v_id) - gv->angle)/gv->area;
binary_tree_add(web.total_energy_addends,modulus*gc*gc*gv->star_area);
gv->gc = gc;
/* now self terms in derivative */
f = get_force(v_id);
for ( j = 0 ; j < SDIM ; j++ )
f[j] -= (2*gc*gv->star_area*(-gv->angle_grad[j]/gv->area
- gc*gv->area_grad[j]/gv->area)
+ gc*gc*gv->star_area_grad[j])*modulus;
}
/* now cross terms from edges */
FOR_ALL_EDGES(e_id)
{ struct gvert *gv1 = gverts + loc_ordinal(get_edge_tailv(e_id));
struct gvert *gv2 = gverts + loc_ordinal(get_edge_headv(e_id));
struct gedge *ge = gedges + loc_ordinal(e_id);
/* head energy as function of tail */
if ( !(get_vattr(get_edge_headv(e_id)) & (FIXED|BOUNDARY) ) )
{ f = get_force(get_edge_tailv(e_id));
for ( j = 0 ; j < SDIM ; j++ )
f[j] -= (2*gv2->gc*gv2->star_area*(-ge->angle_grad[0][j]/gv2->area
- gv2->gc*ge->area_grad[0][j]/gv2->area)
+ gv2->gc*gv2->gc*ge->star_area_grad[0][j])*modulus;
}
/* tail energy as function of head */
if ( !(get_vattr(get_edge_tailv(e_id)) & (FIXED|BOUNDARY) ) )
{ f = get_force(get_edge_headv(e_id));
for ( j = 0 ; j < SDIM ; j++ )
f[j] -= (2*gv1->gc*gv1->star_area*(-ge->angle_grad[1][j]/gv1->area
- gv1->gc*ge->area_grad[1][j]/gv1->area)
+ gv1->gc*gv1->gc*ge->star_area_grad[1][j])*modulus;
}
}
temp_free((char*)gverts);
temp_free((char*)gedges);
}
/********************************************************************
sqgauss integral as method
*********************************************************************/
static struct gvert { REAL angle;
REAL angle_grad[MAXCOORD];
REAL area;
REAL area_grad[MAXCOORD];
REAL star_area;
REAL star_area_grad[MAXCOORD];
REAL gc; /* gaussian curvature */
} *gverts,*gv;
static struct gedge { REAL area_grad[2][MAXCOORD];
REAL star_area_grad[2][MAXCOORD];
REAL angle_grad[2][MAXCOORD];
/* dhead/dtail, dtail/dhead */
} *gedges;
/*************************************************************************
*
* function: sqgauss_method_init()
*
* purpose: gather data for sqgauss method.
* Should really be replaced by local gathering.
*/
void sqgauss_method_init(mode,mi)
int mode;
struct method_instance *mi;
{
vertex_id v[3];
edge_id e_id,e[3];
facet_id f_id;
facetedge_id fe;
int fixcount;
REAL side[3][MAXCOORD];
REAL ss[3];
REAL st[3];
int j,i;
REAL area,angle,c,c1,c2;
if ( web.modeltype != LINEAR )
kb_error(2866,"Method sq_gauss_curvature only for LINEAR model.\n",
RECOVERABLE);
gverts = (struct gvert*)temp_calloc(web.skel[VERTEX].max_ord+1,
sizeof(struct gvert));
/* accumulate angles around vertices */
if ( mode == METHOD_VALUE )
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
fixcount = 0;
for ( i = 0; i < FACET_VERTS ; i++,fe=get_next_edge(fe) )
{ e_id = get_fe_edge(fe);
get_edge_side(e_id,side[i]);
v[i] = get_edge_tailv(e_id);
if ( get_vattr(v[i]) & (FIXED|BOUNDARY) ) fixcount++;
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
st[i] = SDIM_dot(side[i],side[(i+2)%3]);
}
area = 0.5*sqrt(ss[0]*ss[1]-st[1]*st[1]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ c = -st[i]/sqrt(ss[i]*ss[(i+2)%3]);
angle = acos(c);
gv = gverts + loc_ordinal(v[i]);
gv->angle += angle;
gv->area += area/3;
gv->star_area += area/(3-fixcount);
}
}
else if ( mode == METHOD_GRADIENT )
{
gedges = (struct gedge*)temp_calloc(web.skel[EDGE].max_ord+1,
sizeof(struct gedge));
/* accumulate angles around vertices */
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
fixcount = 0;
for ( i = 0; i < FACET_VERTS ; i++,fe=get_next_edge(fe) )
{ e[i] = get_fe_edge(fe);
get_edge_side(e[i],side[i]);
v[i] = get_edge_tailv(e[i]);
if ( get_vattr(v[i]) & (FIXED|BOUNDARY) ) fixcount++;
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
st[i] = SDIM_dot(side[i],side[(i+2)%3]);
}
area = 0.5*sqrt(ss[0]*ss[1]-st[1]*st[1]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ int i1 = (i+1)%3;
int i2 = (i+2)%3;
struct gedge *ge1,*ge2;
int jj1,j2;
gv = gverts + loc_ordinal(v[i]);
ge1 = gedges + loc_ordinal(e[i]);
ge2 = gedges + loc_ordinal(e[i2]);
jj1 = inverted(e[i]) ? 1 : 0;
j2 = inverted(e[i2]) ? 0 : 1;
c = -st[i]/sqrt(ss[i]*ss[i2]);
angle = acos(c);
gv->angle += angle;
c1 = (1+st[i]/ss[i])/area/2;
c2 = (1+st[i]/ss[i2])/area/2;
for ( j = 0 ; j < SDIM ; j++ )
gv->angle_grad[j] += c1*side[i][j] - c2*side[i2][j];
c1 = st[i]/ss[i]/area/2;
c2 = 1/area/2;
for ( j = 0 ; j < SDIM ; j++ )
ge1->angle_grad[jj1][j] -= c1*side[i][j] - c2*side[i2][j];
c1 = 1/area/2;
c2 = st[i]/ss[i2]/area/2;
for ( j = 0 ; j < SDIM ; j++ )
ge2->angle_grad[j2][j] -= c1*side[i][j] - c2*side[i2][j];
gv->area += area/3;
gv->star_area += area/(3-fixcount);
c1 = ss[i1]/area/4;
c2 = st[i1]/area/4;
for ( j = 0 ; j < SDIM ; j++ )
{ c = c2*side[i1][j] - c1*side[i][j];
gv->area_grad[j] += c/3;
gv->star_area_grad[j] += c/(3-fixcount);
ge1->area_grad[jj1][j] += c/3;
ge2->area_grad[j2][j] += c/3;
ge1->star_area_grad[jj1][j] += c/(3-fixcount);
ge2->star_area_grad[j2][j] += c/(3-fixcount);
}
}
}
}
}
/************************************************************************
*
* function: sqgauss_method_cleanup()
*
* purpose: free memory allocated in initialization.
*/
void sqgauss_method_cleanup()
{
temp_free((char*)gverts);
temp_free((char*)gedges);
}
/********************************************************************
*
* Function: sqgauss_method_value()
*
* Purpose: Does square gauss curvature energy calculation for vertices.
*
*/
REAL sqgauss_method_value(v_info)
struct qinfo *v_info;
{
REAL modulus = sqgauss_flag ? globals(sqgauss_param)->value.real : 0.0;
REAL gc; /* gaussian curvarture */
/* calc square gauss curvature at each vertex */
struct gvert *vg = gverts + loc_ordinal(v_info->id);
if ( get_vattr(v_info->id) & (FIXED|BOUNDARY) ) return 0.0;
gc = (wedge_angle(v_info->id) - vg->angle)/vg->area;
return modulus*gc*gc*vg->star_area;
}
/********************************************************************
*
* Function: sqgauss_method_grad()
*
* Purpose: Does square gauss curvature force calculation for vertices.
*
*/
REAL sqgauss_method_grad(v_info)
struct qinfo *v_info;
{
REAL modulus = sqgauss_flag ? globals(sqgauss_param)->value.real : 0.0;
vertex_id v_id;
edge_id e_id,start_e;
int j;
REAL gc; /* gaussian curvarture */
REAL energy = 0.0;
/* calc square gauss curvature at each vertex */
v_id = v_info->id;
gv = gverts + loc_ordinal(v_id);
if ( get_vattr(v_id) & (FIXED|BOUNDARY) ) return 0.0;
gc = (wedge_angle(v_id) - gv->angle)/gv->area;
energy += modulus*gc*gc*gv->star_area;
gv->gc = gc;
/* now self terms in derivative */
for ( j = 0 ; j < SDIM ; j++ )
v_info->grad[0][j] += (2*gc*gv->star_area*(-gv->angle_grad[j]/gv->area
- gc*gv->area_grad[j]/gv->area)
+ gc*gc*gv->star_area_grad[j])*modulus;
/* now cross terms from edges */
start_e = e_id = get_vertex_edge(v_id);
if ( !(get_vattr(v_id) & (FIXED|BOUNDARY) ) )
do
{
struct gvert *gv2 = gverts + loc_ordinal(get_edge_headv(e_id));
struct gedge *ge = gedges + loc_ordinal(e_id);
/* head energy as function of tail */
for ( j = 0 ; j < SDIM ; j++ )
v_info->grad[0][j] +=
(2*gv2->gc*gv2->star_area*(-ge->angle_grad[0][j]/gv2->area
- gv2->gc*ge->area_grad[0][j]/gv2->area)
+ gv2->gc*gv2->gc*ge->star_area_grad[0][j])*modulus;
e_id = get_next_tail_edge(e_id);
} while ( !equal_element(start_e,e_id) );
return energy;
}
/*****************************************************************************
Gaussian curvature at vertices (star model)
******************************************************************************/
void star_gauss_method_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2869,"Method gauss_curvature only for LINEAR model.\n",
RECOVERABLE);
}
REAL star_gauss_method_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{ REAL deficit = 2*M_PI;
int k,i,j;
int fudge = (v_info->flags & INCOMPLETE_STAR) ? 1 : 0;
if ( v_info->vcount <= 1 ) return 0.0;
for ( k = 1 ; k < v_info->vcount-fudge ; k++ )
{ REAL ss1,ss2,s1s2;
int kk = (!fudge && k==(v_info->vcount-1)) ? 1 : k+1;
REAL *s1 = v_info->sides[0][k-1],*s2 = v_info->sides[0][kk-1];
REAL denom;
ss1 = SDIM_dot(s1,s1);
ss2 = SDIM_dot(s2,s2);
s1s2 = SDIM_dot(s1,s2);
deficit -= acos(s1s2/sqrt(ss1*ss2));
if ( mode == METHOD_VALUE )
continue;
denom = sqrt(ss1*ss2 - s1s2*s1s2);
for ( i = 0 ; i < SDIM ; i++ )
{ REAL ddefds1,ddefds2;
ddefds1 = (s2[i] - s1s2/ss1*s1[i])/denom;
ddefds2 = (s1[i] - s1s2/ss2*s2[i])/denom;
v_info->grad[k][i] += ddefds1;
v_info->grad[0][i] -= ddefds1;
v_info->grad[kk][i] += ddefds2;
v_info->grad[0][i] -= ddefds2;
if ( mode == METHOD_GRADIENT )
continue;
for ( j = 0 ; j < SDIM ; j++ )
{ REAL dddefds1ds1,dddefds1ds2,dddefds2ds1,dddefds2ds2;
dddefds1ds1 = (-s2[j]/ss1*s1[i] + s1s2/ss1/ss1*2*s1[j]*s1[i]
- (i==j ? s1s2/ss1 : 0))/denom
- ddefds1/denom*0.5/denom*(2*ss2*s1[j] - 2*s1s2*s2[j]);
dddefds1ds2 = ((i==j ? 1.0 : 0.0) - s1[j]/ss1*s1[i])/denom
- ddefds1/denom*0.5/denom*(2*ss1*s2[j] - 2*s1s2*s1[j]);
dddefds2ds1 = ((i==j ? 1.0 : 0.0) - s2[j]/ss2*s2[i])/denom
- ddefds2/denom*0.5/denom*(2*ss2*s1[j] - 2*s1s2*s2[j]);
dddefds2ds2 = (-s1[j]/ss2*s2[i] + s1s2/ss2/ss2*2*s2[j]*s2[i]
- (i==j ? s1s2/ss2 : 0))/denom
- ddefds2/denom*0.5/denom*(2*ss1*s2[j] - 2*s1s2*s1[j]);
v_info->hess[k][k][i][j] += dddefds1ds1;
v_info->hess[0][k][i][j] -= dddefds1ds1;
v_info->hess[k][0][i][j] -= dddefds1ds1;
v_info->hess[0][0][i][j] += dddefds1ds1;
v_info->hess[k][kk][i][j] += dddefds1ds2;
v_info->hess[0][kk][i][j] -= dddefds1ds2;
v_info->hess[k][0][i][j] -= dddefds1ds2;
v_info->hess[0][0][i][j] += dddefds1ds2;
v_info->hess[kk][k][i][j] += dddefds2ds1;
v_info->hess[0][k][i][j] -= dddefds2ds1;
v_info->hess[kk][0][i][j] -= dddefds2ds1;
v_info->hess[0][0][i][j] += dddefds2ds1;
v_info->hess[kk][kk][i][j] += dddefds2ds2;
v_info->hess[0][kk][i][j] -= dddefds2ds2;
v_info->hess[kk][0][i][j] -= dddefds2ds2;
v_info->hess[0][0][i][j] += dddefds2ds2;
}
}
}
return deficit;
}
REAL star_gauss_method_value(v_info)
struct qinfo *v_info;
{ return star_gauss_method_all(v_info,METHOD_VALUE);
}
REAL star_gauss_method_grad(v_info)
struct qinfo *v_info;
{ return star_gauss_method_all(v_info,METHOD_GRADIENT);
}
REAL star_gauss_method_hess(v_info)
struct qinfo *v_info;
{ return star_gauss_method_all(v_info,METHOD_HESSIAN);
}
/*****************************************************************************
Square Gaussian curvature integral at vertices (star model)
******************************************************************************/
void star_sqgauss_method_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2867,"Method sq_gauss_curvature only for LINEAR model.\n",
RECOVERABLE);
}
REAL star_sqgauss_method_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, etc. */
{ REAL deficit = 2*M_PI;
REAL area = 0.0;
int k,kk,i,j;
REAL **dadv=NULL,**ddefdv=NULL; /* gradient storage */
int pairs,final_edge;
if ( v_info->vcount <= 1 ) return 0.0;
pairs = (v_info->vcount - 1);
if ( pairs <= 0 ) return 0.0;
if ( v_info->flags & INCOMPLETE_STAR )
{ pairs--;
final_edge = pairs;
}
else
final_edge = 0;
if ( mode == METHOD_HESSIAN )
{ dadv = temp_dmatrix(0,v_info->vcount,0,SDIM-1);
ddefdv = temp_dmatrix(0,v_info->vcount,0,SDIM-1);
}
for ( k = 1 ; k < v_info->vcount ; k++ )
{ REAL ss1,ss2,s1s2;
int kk = (k==(v_info->vcount-1)) ? 0 : k;
ss1 = SDIM_dot(v_info->sides[0][k-1],v_info->sides[0][k-1]);
ss2 = SDIM_dot(v_info->sides[0][kk],v_info->sides[0][kk]);
s1s2 = SDIM_dot(v_info->sides[0][k-1],v_info->sides[0][kk]);
deficit -= acos(s1s2/sqrt(ss1*ss2));
area += sqrt(ss1*ss2 - s1s2*s1s2)/6;
}
if ( mode == METHOD_VALUE )
return deficit*deficit/area;
/* now individual vertex gradients */
for ( k = 1 ; k < v_info->vcount ; k++ )
{ REAL ss1,ss2,s1s2;
int kk = (k==(v_info->vcount-1)) ? 1 : k+1;
REAL *s1 = v_info->sides[0][k-1],*s2 = v_info->sides[0][kk-1];
REAL denom;
ss1 = SDIM_dot(s1,s1);
ss2 = SDIM_dot(s2,s2);
s1s2 = SDIM_dot(s1,s2);
denom = sqrt(ss1*ss2 - s1s2*s1s2);
for ( i = 0 ; i < SDIM ; i++ )
{ REAL ddefds1,ddefds2,dads1,dads2,dsqds1,dsqds2;
int j;
ddefds1 = (s2[i] - s1s2/ss1*s1[i])/denom;
ddefds2 = (s1[i] - s1s2/ss2*s2[i])/denom;
dads1 = (s1[i]*ss2 - s1s2*s2[i])/denom/6;
dads2 = (s2[i]*ss1 - s1s2*s1[i])/denom/6;
dsqds1 = 2*deficit*ddefds1/area - deficit*deficit/area/area*dads1;
dsqds2 = 2*deficit*ddefds2/area - deficit*deficit/area/area*dads2;
v_info->grad[k][i] += dsqds1;
v_info->grad[0][i] -= dsqds1;
v_info->grad[kk][i] += dsqds2;
v_info->grad[0][i] -= dsqds2;
if ( mode == METHOD_GRADIENT )
continue;
/* record gradients for later */
if ( dadv )
{
ddefdv[k][i] += ddefds1;
ddefdv[kk][i] += ddefds2;
dadv[k][i] += dads1;
dadv[kk][i] += dads2;
}
/* add in pure second partial terms */
for ( j = 0 ; j < SDIM ; j++ )
{ REAL dddefds1ds1,dddefds1ds2,dddefds2ds1,dddefds2ds2;
REAL ddads1ds1,ddads1ds2,ddads2ds1,ddads2ds2;
REAL ddenomds1j,ddenomds2j;
REAL ddsqds1ds1,ddsqds1ds2,ddsqds2ds1,ddsqds2ds2;
/* denom = sqrt(ss1*ss2 - s1s2*s1s2); */
ddenomds1j = 1.0/denom*(s1[j]*ss2 - s1s2*s2[j]);
ddenomds2j = 1.0/denom*(s2[j]*ss1 - s1s2*s1[j]);
ddads1ds1 = ((i==j ? 1:0)*ss2 - s2[j]*s2[i])/denom/6
- (s1[i]*ss2 - s1s2*s2[i])/denom/6/denom*ddenomds1j;
ddads1ds2 = (s1[i]*2*s2[j] - s1[j]*s2[i] - s1s2*(i==j?1.0:0.))/denom/6
- (s1[i]*ss2 - s1s2*s2[i])/denom/6/denom*ddenomds2j;
ddads2ds1 = (s2[i]*2*s1[j] - s2[j]*s1[i] - s1s2*(i==j?1:0))/denom/6
- (s2[i]*ss1 - s1s2*s1[i])/denom/6/denom*ddenomds1j;
ddads2ds2 = ((i==j?1.0:0.0)*ss1 - s1[j]*s1[i])/denom/6
- (s2[i]*ss1 - s1s2*s1[i])/denom/6/denom*ddenomds2j;
dddefds1ds1 = (-s2[j]/ss1*s1[i] + s1s2/ss1/ss1*2*s1[j]*s1[i]
- (i==j ? s1s2/ss1 : 0))/denom - ddefds1/denom*ddenomds1j;
dddefds1ds2 = ((i==j ? 1.0 : 0.0) - s1[j]/ss1*s1[i])/denom
- ddefds1/denom*ddenomds2j;
dddefds2ds1 = ((i==j ? 1.0 : 0.0) - s2[j]/ss2*s2[i])/denom
- ddefds2/denom*ddenomds1j;
dddefds2ds2 = (-s1[j]/ss2*s2[i] + s1s2/ss2/ss2*2*s2[j]*s2[i]
- (i==j ? s1s2/ss2 : 0))/denom - ddefds2/denom*ddenomds2j;
ddsqds1ds1 = 2*deficit*dddefds1ds1/area
- deficit*deficit/area/area*ddads1ds1;
ddsqds1ds2 = 2*deficit*dddefds1ds2/area
- deficit*deficit/area/area*ddads1ds2;
ddsqds2ds1 = 2*deficit*dddefds2ds1/area
- deficit*deficit/area/area*ddads2ds1;
ddsqds2ds2 = 2*deficit*dddefds2ds2/area
- deficit*deficit/area/area*ddads2ds2;
v_info->hess[k][k][i][j] += ddsqds1ds1;
v_info->hess[0][k][i][j] -= ddsqds1ds1;
v_info->hess[k][0][i][j] -= ddsqds1ds1;
v_info->hess[0][0][i][j] += ddsqds1ds1;
v_info->hess[k][kk][i][j] += ddsqds1ds2;
v_info->hess[0][kk][i][j] -= ddsqds1ds2;
v_info->hess[k][0][i][j] -= ddsqds1ds2;
v_info->hess[0][0][i][j] += ddsqds1ds2;
v_info->hess[kk][k][i][j] += ddsqds2ds1;
v_info->hess[0][k][i][j] -= ddsqds2ds1;
v_info->hess[kk][0][i][j] -= ddsqds2ds1;
v_info->hess[0][0][i][j] += ddsqds2ds1;
v_info->hess[kk][kk][i][j] += ddsqds2ds2;
v_info->hess[0][kk][i][j] -= ddsqds2ds2;
v_info->hess[kk][0][i][j] -= ddsqds2ds2;
v_info->hess[0][0][i][j] += ddsqds2ds2;
}
}
}
if ( mode == METHOD_HESSIAN )
{ /* add in product of gradient terms */
for ( k = 1 ; k < v_info->vcount ; k++ )
for ( kk = 1 ; kk < v_info->vcount ; kk++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL term;
term = 2/area*ddefdv[k][i]*ddefdv[kk][j]
- 2*deficit/area/area*dadv[k][i]*ddefdv[kk][j]
- 2*deficit/area/area*ddefdv[k][i]*dadv[kk][j]
+ 2*deficit*deficit/area/area/area*dadv[k][i]*dadv[kk][j];
v_info->hess[k][kk][i][j] += term;
v_info->hess[0][kk][i][j] -= term;
v_info->hess[k][0][i][j] -= term;
v_info->hess[0][0][i][j] += term;
}
free_temp_matrix(dadv);
free_temp_matrix(ddefdv);
}
return deficit*deficit/area;
}
REAL star_sqgauss_method_value(v_info)
struct qinfo *v_info;
{ return star_sqgauss_method_all(v_info,METHOD_VALUE);
}
REAL star_sqgauss_method_grad(v_info)
struct qinfo *v_info;
{ return star_sqgauss_method_all(v_info,METHOD_GRADIENT);
}
REAL star_sqgauss_method_hess(v_info)
struct qinfo *v_info;
{ return star_sqgauss_method_all(v_info,METHOD_HESSIAN);
}
/**************************************************************************
levine_energy
A curvature-dependent energy requested by Dov Levine,
levine@techunix.technion.ac.il
Depends on two variables, levine_a and levine_t, to be set by user.
E = Integral ( K1*K2*t/a + 1/4/a*(K1 - K2)*log((1-K2*t)/(1-K1*t)) dA
where K1 and K2 are the principal curvatures.
****************************************************************************/
static REAL levine_a=1.0,levine_t=1.0,levine_c=1.0;
void levine_energy_init(mode,meth)
int mode;
struct method_instance *meth;
{ int k;
/* find the two variables */
k = lookup_global("levine_a");
if ( k >= 0 )
levine_a = globals(k)->value.real;
else levine_a = 1.0;
k = lookup_global("levine_t");
if ( k >= 0 )
levine_t = globals(k)->value.real;
else levine_t = 1.0;
k = lookup_global("levine_c"); /* coeff of log part, for test */
if ( k >= 0 )
levine_c = globals(k)->value.real;
else levine_c = 1.0;
}
REAL levine_energy_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{ REAL deficit = 2*M_PI;
REAL area = 0.0;
REAL coeff = levine_c*levine_t/levine_a;
int variety; /* PLAIN_SQ, EFF_SQ, NORMAL_SQ */
int pairs;
int i,j,k;
REAL energy,ff,fn,g;
REAL dAdv[MAXCOORD], *a, *d, *s1s1, *s1s2, *s2s2;
REAL vnorm[MAXCOORD];
REAL **dAdv1,**dAdv2,***dvnorm1,***dvnorm2,**ds2;
REAL ***ddAdv1dv1,***ddAdv2dv1,***ddAdv1dv2,***ddAdv2dv2;
REAL ***ddss12,***ddss21,***ddss22;
REAL **dfndv1,**dfndv2,**dffdv1,**dffdv2,**dnndv1,**dnndv2;
REAL ***dfdv1,***dfdv2;
REAL *s1,*s2;
REAL **s = v_info->sides[0];
REAL temp[MAXCOORD];
#define MAXV 10
REAL aa[MAXV*5];
MAT2D(ds1,12*MAXV,MAXCOORD);
MAT3D(ddss11,16*MAXV,MAXCOORD,MAXCOORD);
REAL hh0; /* curvature adjusted for h-h0 */
REAL gc,root,kappa1,kappa2;
REAL dgc[MAXV][MAXCOORD];
REAL dhh0[MAXV][MAXCOORD];
REAL darea[MAXV][MAXCOORD];
REAL ddef[MAXV][MAXCOORD];
variety = NORMAL_SQ;
if ( v_info->vcount <= 1 ) return 0.0;
/* gaussian curvature */
for ( k = 1 ; k < v_info->vcount ; k++ )
{ REAL ss1,ss2,s1s2;
int kk = (k==(v_info->vcount-1)) ? 0 : k;
ss1 = SDIM_dot(v_info->sides[0][k-1],v_info->sides[0][k-1]);
ss2 = SDIM_dot(v_info->sides[0][kk],v_info->sides[0][kk]);
s1s2 = SDIM_dot(v_info->sides[0][k-1],v_info->sides[0][kk]);
deficit -= acos(s1s2/sqrt(ss1*ss2));
area += sqrt(ss1*ss2 - s1s2*s1s2)/6;
}
gc = deficit/area;
/* mean curvature */
pairs = (v_info->vcount - 1);
if ( pairs <= 0 ) return 0.0;
if ( v_info->vcount > MAXV )
{ a = (REAL*)mycalloc(5*pairs,sizeof(REAL));
ds1 = dmatrix(0,12*v_info->vcount,0,SDIM-1);
} else
{ memset((char*)aa,0,sizeof(REAL)*5*pairs);
a = aa;
memset((char*)ds1[0],0,sizeof(REAL)*12*v_info->vcount*MAXCOORD);
}
d = a+pairs; s1s1 = d + pairs; s1s2 = s1s1 + pairs; s2s2 = s1s2 + pairs;
ds2 = ds1 + pairs; dAdv1 = ds2 + pairs; dAdv2 = dAdv1 + pairs;
dfndv1 = dAdv2 + pairs; dfndv2 = dfndv1 + pairs; dffdv1 = dfndv2 + pairs;
dffdv2 = dffdv1 + pairs; dnndv1 = dffdv2 + pairs; dnndv2 = dnndv1 + pairs;
/* basic dot products */
/* area = 0.0; */
for ( j = 0 ; j < SDIM ; j++ ) dAdv[j] = vnorm[j] = 0.0;
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?0:k+1];
s1s1[k] = SDIM_dot(s1,s1);
s1s2[k] = SDIM_dot(s1,s2);
s2s2[k] = SDIM_dot(s2,s2);
d[k] = s1s1[k]*s2s2[k] - s1s2[k]*s1s2[k];
a[k] = 0.5*sqrt(d[k]);
for ( j = 0 ; j < SDIM ; j++ )
{ ds1[k][j] = 2*(s2s2[k]*s1[j] - s1s2[k]*s2[j]);
ds2[k][j] = 2*(s1s1[k]*s2[j] - s1s2[k]*s1[j]);
dAdv1[k][j] = 0.125/a[k]*ds1[k][j];
dAdv2[k][j] = 0.125/a[k]*ds2[k][j];
dAdv[j] -= dAdv1[k][j] + dAdv2[k][j];
}
if ( variety != PLAIN_SQ )
{ cross_prod(s1,s2,temp);
for ( j = 0 ; j < SDIM ; j++ )
vnorm[j] += 0.5*temp[j]/3;
}
}
/* energy */
ff = SDIM_dot(dAdv,dAdv);
fn = SDIM_dot(dAdv,vnorm);
if ( fn == 0.0 )
{ ff = 0.0; fn = 1e-6; }
hh0 = ff/fn/2; /* mean curvature, so divide by 2 */
if ( hh0*hh0 < gc )
root = 0.0;
else
root = sqrt(hh0*hh0 - gc);
kappa1 = hh0 + root;
kappa2 = hh0 - root;
#define APPROX_LEVINE_XX
#ifdef APPROX_LEVINE
/* express in terms of hh0 and gc without sqrt to keep smooth */
energy = coeff*deficit
+ 4*(hh0*hh0 - gc)/4/levine_a*levine_t*(1 + 2*hh0*levine_t)*area;
#else
energy = coeff*deficit
+ (2*root)/4/levine_a*
log((1-kappa2*levine_t)/(1-kappa1*levine_t))*area;
#endif
if ( !is_finite(energy) )
kb_error(2586,"Levine energy infinite.\n",WARNING);
if ( mode == METHOD_VALUE )
return energy;
/* now individual vertex gradients */
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dgc[k][i] = dhh0[k][i] = darea[k][i] = ddef[k][i] = 0.0;
}
/* gaussian part */
for ( k = 1 ; k < v_info->vcount ; k++ )
{ REAL ss1,ss2,s1s2;
int kk = (k==(v_info->vcount-1)) ? 0 : k;
REAL *s1 = v_info->sides[0][k-1],*s2 = v_info->sides[0][kk];
REAL denom;
ss1 = SDIM_dot(s1,s1);
ss2 = SDIM_dot(s2,s2);
s1s2 = SDIM_dot(s1,s2);
denom = sqrt(ss1*ss2 - s1s2*s1s2);
for ( i = 0 ; i < SDIM ; i++ )
{ REAL ddefds1,ddefds2,dads1,dads2;
ddefds1 = (s2[i] - s1s2/ss1*s1[i])/denom;
ddefds2 = (s1[i] - s1s2/ss2*s2[i])/denom;
dads1 = (s1[i]*ss2 - s1s2*s2[i])/denom/6;
dads2 = (s2[i]*ss1 - s1s2*s1[i])/denom/6;
dgc[k][i] += ddefds1/area - deficit/area/area*dads1;
dgc[0][i] -= ddefds1/area - deficit/area/area*dads1;
dgc[kk?k+1:1][i] += ddefds2/area - deficit/area/area*dads2;
dgc[0][i] -= ddefds2/area - deficit/area/area*dads2;
ddef[k][i] += ddefds1;
ddef[0][i] -= ddefds1;
ddef[kk?k+1:1][i] += ddefds2;
ddef[0][i] -= ddefds2;
darea[k][i] += dads1;
darea[0][i] -= dads1;
darea[kk?k+1:1][i] += dads2;
darea[0][i] -= dads2;
}
}
/* other part */
if ( v_info->vcount > MAXV )
ddss11 = dmatrix3(16*pairs,SDIM,SDIM);
else memset((char*)ddss11[0][0],0,sizeof(REAL)*16*pairs*MAXCOORD*MAXCOORD);
ddss12 = ddss11 + pairs; ddss21 = ddss12 + pairs; ddss22 = ddss21 + pairs;
ddAdv1dv1 = ddss22 + pairs; ddAdv1dv2 = ddAdv1dv1 + pairs;
ddAdv2dv1 = ddAdv1dv2 + pairs; ddAdv2dv2 = ddAdv2dv1 + pairs;
dvnorm1 = ddAdv2dv2 + pairs; dvnorm2 = dvnorm1 + pairs;
dfdv1 = dvnorm2 + pairs; dfdv2 = dfdv1 + pairs;
/* first, some more common terms */
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?0:k+1];
for ( i = 0 ; i < SDIM ; i++ )
{ ddss11[k][i][i] = 2*s2s2[k];
ddss12[k][i][i] = -2*s1s2[k];
ddss21[k][i][i] = -2*s1s2[k];
ddss22[k][i][i] = 2*s1s1[k];
for ( j = 0 ; j < SDIM ; j++ )
{ ddss11[k][i][j] -= 2*s2[i]*s2[j];
ddss12[k][i][j] += 4*s1[i]*s2[j] - 2*s2[i]*s1[j];
ddss21[k][i][j] += 4*s2[i]*s1[j] - 2*s1[i]*s2[j];
ddss22[k][i][j] -= 2*s1[i]*s1[j];
ddAdv1dv1[k][i][j] = -0.125/a[k]/a[k]*dAdv1[k][i]*ds1[k][j]
+ 0.125/a[k]*ddss11[k][i][j];
ddAdv1dv2[k][i][j] = -0.125/a[k]/a[k]*dAdv1[k][i]*ds2[k][j]
+ 0.125/a[k]*ddss12[k][i][j];
dfdv1[k][i][j] = -ddAdv1dv1[k][i][j] - ddAdv1dv2[k][i][j];
ddAdv2dv1[k][i][j] = -0.125/a[k]/a[k]*dAdv2[k][i]*ds1[k][j]
+ 0.125/a[k]*ddss21[k][i][j];
ddAdv2dv2[k][i][j] = -0.125/a[k]/a[k]*dAdv2[k][i]*ds2[k][j]
+ 0.125/a[k]*ddss22[k][i][j];
dfdv2[k][i][j] = -ddAdv2dv1[k][i][j] - ddAdv2dv2[k][i][j];
}
dffdv1[k][i] = 2*SDIM_dot(dfdv1[k][i],dAdv);
dffdv2[k][i] = 2*SDIM_dot(dfdv2[k][i],dAdv);
}
if ( variety == PLAIN_SQ ) continue;
dvnorm1[k][0][1] = -0.5*s2[2]/3;
dvnorm1[k][0][2] = 0.5*s2[1]/3;
dvnorm1[k][1][0] = 0.5*s2[2]/3;
dvnorm1[k][1][2] = -0.5*s2[0]/3;
dvnorm1[k][2][0] = -0.5*s2[1]/3;
dvnorm1[k][2][1] = 0.5*s2[0]/3;
dvnorm2[k][0][1] = 0.5*s1[2]/3;
dvnorm2[k][0][2] = -0.5*s1[1]/3;
dvnorm2[k][1][0] = -0.5*s1[2]/3;
dvnorm2[k][1][2] = 0.5*s1[0]/3;
dvnorm2[k][2][0] = 0.5*s1[1]/3;
dvnorm2[k][2][1] = -0.5*s1[0]/3;
for ( i = 0 ; i < SDIM ; i++ )
{ dfndv1[k][i] = SDIM_dot(dfdv1[k][i],vnorm);
dfndv1[k][i] += SDIM_dot(dAdv,dvnorm1[k][i]);
dfndv2[k][i] = SDIM_dot(dfdv2[k][i],vnorm);
dfndv2[k][i] += SDIM_dot(dAdv,dvnorm2[k][i]);
dnndv1[k][i] = 2*SDIM_dot(vnorm,dvnorm1[k][i]);
dnndv2[k][i] = 2*SDIM_dot(vnorm,dvnorm2[k][i]);
}
}
/* now, the actual gradients */
if ( fn != 0.0 )
for ( k = 0 ; k < pairs ; k++ )
{
for ( i = 0 ; i < SDIM ; i++ )
{
g = dffdv1[k][i]/fn - ff/fn/fn*dfndv1[k][i];
dhh0[k+1][i] += g/2;
dhh0[0][i] -= g/2;
g = dffdv2[k][i]/fn - ff/fn/fn*dfndv2[k][i];
dhh0[(k+1==pairs)?1:k+2][i] += g/2;
dhh0[0][i] -= g/2;
}
}
#ifdef APPROX_LEVINE
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ REAL droot = root==0.0 ? 0.0 : 0.5/root*(2*hh0*dhh0[k][i] - dgc[k][i]);
REAL dkappa1 = dhh0[k][i] + droot;
REAL dkappa2 = dhh0[k][i] - droot;
v_info->grad[k][i] += coeff*ddef[k][i]
+ (2*hh0*dhh0[k][i]-dgc[k][i])/levine_a*levine_t*(1+2*hh0*levine_t)*area
+ (hh0*hh0 - gc)/levine_a*levine_t*(2*dhh0[k][i]*levine_t)*area
+ (hh0*hh0 - gc)/levine_a*levine_t*(1 + 2*hh0*levine_t)*darea[k][i];
}
#else
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ REAL droot = root==0.0 ? 0.0 : 0.5/root*(2*hh0*dhh0[k][i] - dgc[k][i]);
REAL dkappa1 = dhh0[k][i] + droot;
REAL dkappa2 = dhh0[k][i] - droot;
v_info->grad[k][i] += coeff*ddef[k][i]
+ (
droot/2/levine_a*
(log(1-kappa2*levine_t)-log(1-kappa1*levine_t))*area
+ root/2/levine_a*
(1/(1-kappa2*levine_t)*(-dkappa2*levine_t)
-1/(1-kappa1*levine_t)*(-dkappa1*levine_t))*area
+ root/2/levine_a*
(log(1-kappa2*levine_t)-log(1-kappa1*levine_t))*darea[k][i]);
}
#endif
if ( mode == METHOD_GRADIENT )
return energy;
/* No hessian yet */
return energy;
}
REAL levine_energy_value(v_info)
struct qinfo *v_info;
{ return levine_energy_all(v_info,METHOD_VALUE);
}
REAL levine_energy_grad(v_info)
struct qinfo *v_info;
{ return levine_energy_all(v_info,METHOD_GRADIENT);
}
evolver-2.30c.dfsg/src/nulgraph.c 0000644 0001753 0001753 00000001736 11410765113 017210 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/* Null graphics module for evolver */
#include "include.h"
/* callable null functions of the right types */
void null_start ARGS((void)) {}
void null_edge(struct graphdata * g,edge_id id) {}
void null_facet(struct graphdata * g,facet_id id) {}
void display_null(struct tsort * t) {}
void graph_new_surface() {}
void display()
{
if ( init_graphics == NULL )
kb_error(1252,"No screen display available. This Evolver compiled with nulgraph.c.\n",WARNING);
ENTER_GRAPH_MUTEX
init_graphics = null_function;
finish_graphics = null_function;
graph_edge = null_edge;
graph_start = null_start;
graph_facet = null_facet;
graph_end = null_function;
display_facet = display_null;
graphgen();
LEAVE_GRAPH_MUTEX
}
evolver-2.30c.dfsg/src/tmain.c 0000644 0001753 0001753 00000136001 11410765113 016472 0 ustar hazelsct hazelsct
/*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
int crit_count; /* debugging */
/**********************************************************
*
* File: tmain.c
*
* Contents: main() for Surface Evolver
*/
#if defined(WIN32) && !defined(WINVER)
#define _WIN32_WINNT 0x0500
#define _WIN32_WINDOWS 0x0410
#define WINVER 0x0400
#endif
#include "include.h"
int just_lex_flag = 0; /* for -l option */
/***********************************************************************/
/* System-specific thread stuff is all in this file. */
#ifdef WINTHREADS
/* MS Windows multithreading */
DWORD WINAPI winthread_worker( void * arg );
CRITICAL_SECTION thread_cs; /* main thread critical section */
CRITICAL_SECTION element_cs; /* per element critical section */
CRITICAL_SECTION web_cs; /* web structure critical section */
LPCRITICAL_SECTION element_mutex_ptr = &element_cs; /* for use in other files */
LPCRITICAL_SECTION web_mutex_ptr = &web_cs; /* for use in other files */
HANDLE workthread_wakeup; /* worker thread wake-up event */
HANDLE mainthread_wakeup; /* resume main thread event */
HANDLE barrier_event; /* for synchronizing worker threads */
volatile LONG barrier_count;
HANDLE *threadlist; /* thread handles */
DWORD thread_data_key;
#endif
#ifdef PTHREADS
/* portable Unix multithreading */
#include
/*#include */
pthread_mutex_t thread_mutex; /* main thread critical section */
pthread_mutex_t element_mutex; /* element modify critical section */
pthread_mutex_t web_mutex; /* web modify critical section */
void *element_mutex_ptr = (void*)&element_mutex; /* for use in other files */
void *web_mutex_ptr = (void*)&web_mutex; /* for use in other files */
pthread_cond_t workthread_wakeup; /* worker thread wake-up event */
pthread_cond_t mainthread_wakeup; /* resume main thread event */
pthread_t *threadlist; /* thread ids */
void * pthread_worker ( void *);
pthread_key_t thread_data_key;
int task_serial_number; /* global */
#endif
int spincount = 0; /* times to try spinlock before sleeping */
/* End of thread stuff. */
/***********************************************************************/
/* Separate thread for periodically printing state; useful when deadlocked */
int web_locks;
int thread_locks;
int element_locks;
int web_unlocks;
int thread_unlocks;
int element_unlocks;
void * reporter_thread ARGS((void * ));
void * reporter_thread(void * arg)
{ puts("Reporter thread running.");
for (;;)
{
#ifdef WIN32
Sleep(10000);
#else
sleep(10);
#endif
printf("Reporter: global_id %08LX\n",global_id);
printf("web_locks %d element_locks %d thread_locks %d\n",
web_locks,element_locks,thread_locks);
printf("web_unlocks %d element_unlocks %d thread_unlocks %d\n",
web_unlocks,element_unlocks,thread_unlocks);
#ifdef XXXX
if ( pthread_mutex_trylock(&thread_mutex) == EBUSY )
puts("thread_mutex locked");
else
{ pthread_mutex_unlock(&thread_mutex);
puts("thread_mutex unlocked");
}
if ( pthread_mutex_trylock(&web_mutex) == EBUSY )
puts("web_mutex locked");
else
{ pthread_mutex_unlock(&web_mutex);
puts("web_mutex unlocked");
}
if ( pthread_mutex_trylock(&element_mutex) == EBUSY )
puts("element_mutex locked");
else
{ pthread_mutex_unlock(&element_mutex);
puts("element_mutex unlocked");
}
#endif
}
}
int tty_flag; /* to do tty interface instead of menus */
#if defined(MOTIF) || defined(MAC_APP) || defined(WIN32S) || defined(MAC_CW)
#define main old_main
#endif
#ifdef SHARED_MEMORY
void m_set_idlist()
{ proc_ids[GET_THREAD_ID] = getpid(); }
#endif
#if defined(MPI_EVOLVER)
#define main old_main
#endif
int main ARGS2((argc,argv),
int argc,
char *argv[])
{ int pause_flag=0; /* whether to pause after banner message */
msgmax = 2000;
if ( !msg ) msg = my_list_calloc(1,msgmax,ETERNAL_BLOCK);
set_ctypes();
outfd = stdout;
sprintf(msg,"Surface Evolver %s\n\n",VERSION);
outstring(msg);
#ifdef LONGDOUBLE
sprintf(msg,"Compiled for %d byte long double.\n\n",sizeof(REAL));
outstring(msg);
#endif
#ifdef MPI_EVOLVER
MPI_Barrier(MPI_COMM_WORLD); /* wait for everybody to print */
#endif
if ( sizeof(element_id) > sizeof(REAL) )
kb_error(3102,"Bad datatype sizes: element_id is %d bytes, but REAL is %d.\n",
UNRECOVERABLE);
#ifdef _HISTORY_H_
/* readline history initialization */
using_history();
#endif
#ifdef SGI_MULTI
procs_requested = 1; /* default at John's request. m_get_numprocs(); */
#endif
#ifdef WIN32
/* Mutex for use between graph thread and main thread. */
/* Nameless to prevent interference between separate processes. */
graphmutex = CreateMutex(NULL,0,NULL);
mem_mutex = CreateMutex(NULL,0,NULL);
#if defined(PROF_EVALS) || defined(PROFILING)
SetThreadAffinityMask(GetCurrentThread(),1);
#endif
#ifdef MPI_EVOLVER
mpi_mutex = CreateMutex(NULL,0,NULL);
#endif
#elif defined(PTHREADS)
pthread_mutex_init(&graphmutex,NULL);
pthread_mutex_init(&mem_mutex,NULL);
#ifdef MPI_EVOLVER
pthread_mutex_init(&mpi_mutex,NULL);
#endif
#endif
print_express(NULL,0); /* just to initialize string allocation */
/* find machine resolution */
{ REAL eps,one = 1.0;
for ( eps = 1.0 ; one + eps != one ; eps /= 2.0 ) ;
machine_eps = 2.0*eps;
}
find_cpu_speed();
initialize_perm_globals(); /* put some internal variable names in
permanent symbol table */
/* parse command line options */
if ( argc > 0 )
{
argv++; argc--;
while ( argc && (argv[0] != NULL) && (argv[0][0] == '-') )
{ switch ( argv[0][1] )
{
case 'E': err_tok_gen_flag = 1;
break;
case 'a': auto_convert_flag = (argv[0][2]=='-') ? 0 : 1; break;
case 'q': option_q = (argv[0][2]=='-') ? 0 : 1; break;
case 'Q': quiet_load_flag = 1; break;
case 'e': echo_flag = 1; break;
case 'Z': pause_flag = 1; break; /* chance to attach debugger */
#ifdef MPI_EVOLVER
case 'z': mpi_debug = 1; break;
#endif
case 't': tty_flag = 1;
break;
case 'u': tty_flag = 1;
break;
case 'f' : /* commands from file */
cmdfilename = argv[0]+2;
if ( cmdfilename[0] == 0 ) /* probably a space inserted */
{ cmdfilename = *++argv; argc--; }
break;
case 'd' : /* parser debug */
yydebug = 1;
break;
case 'i' : match_id_flag = 1; break;
case 'I' : sparse_ibase_flag = 1; break;
case 'p' : procs_requested = atoi(argv[0]+2);
#if defined(SGI_MULTI) || defined (THREADS)
if ( procs_requested < 1 )
{ kb_error(1321,
"-p with nonpositive number. Threads set to 1.\n",
WARNING);
procs_requested = 1;
}
if ( procs_requested > MAXPROCS )
{ sprintf(errmsg,
"This Evolver only compiled for a maximum of %d threads.\n",MAXPROCS);
kb_error(2551,errmsg,WARNING);
sprintf(errmsg,
"Threads set to %d. Recompile with -DMAXPROCS=%d if you want more.\n",
MAXPROCS,procs_requested);
erroutstring(errmsg);
procs_requested = MAXPROCS;
}
#ifdef THREADS
threadflag = 1;
#endif
#else
kb_error(1322,"-p option not effective. This Evolver not compiled for multithreading.\n", WARNING);
#endif
break;
case 'x' : exit_after_error = 1; break;
case 'w' : exit_after_warning = exit_after_error = 1; break;
case 'y' : break_after_warning = 1; break;
case 'm' : memdebug = 1; break;
case 'l' : just_lex_flag = 1; break;
default:
sprintf(msg,"Illegal option: %s\n",argv[0]); outstring(msg);
case 'h' :
outstring("Legal options: \n");
outstring(" -ffilename take commands from file\n");
outstring(" -i use id numbers as in datafile\n");
outstring(" -q convert to named quantities\n");
outstring(" -a auto convert to named quantities when needed\n");
outstring(" -x exit after error\n");
outstring(" -w exit after warning\n");
outstring(" -y break after warning\n");
outstring(" -d parser debugging on\n");
outstring(" -m memory debugging on\n");
#ifdef SGI_MULTI
outstring(" -pn use n processes \n");
#endif
#if defined(THREADS)
outstring(" -pn use n worker threads \n");
#endif
outstring(" -h print this help\n");
break;
}
argv++; argc--;
}
}
if ( pause_flag )
{ prompt("Hit ENTER to continue.\n",msg,sizeof(msg));
}
#ifdef SGI_MULTI
sprintf(msg,"Using %d processes on %d processors.\n\n",
procs_requested,m_get_numprocs());
outstring(msg);
m_set_procs(procs_requested);
if ( m_get_numprocs() > 1 )
{ int n;
/* set up list of locks available for critical sections */
usconfig(CONF_INITSIZE,200*_MAXLOCKS);
usconfig(CONF_ARENATYPE,US_SHAREDONLY);
usconfig(CONF_INITUSERS,4+m_get_numprocs());
lock_arena = usinit(lock_arena_name);
if ( lock_arena == NULL ) { perror(lock_arena_name); exit(2); }
for ( n = 0 ; n < _MAXLOCKS ; n++ )
{ locklist[n] = usnewlock(lock_arena);
if ( locklist[n] == NULL )
{ fprintf(stderr,"lock allocation failure on lock %d.\n",n);
perror("usnewlock");
exit(2);
}
}
m_fork(m_set_idlist);
m_park_procs();
mpflag = M_INACTIVE;
}
#endif
nprocs = procs_requested;
#ifdef WINTHREADS
/* Set up worker threads for MS-Windows multiprocessor machines */
thread_data_key = TlsAlloc();
TlsSetValue(thread_data_key,(void*)&default_thread_data); // for main thread
if ( threadflag )
{ int i;
int retval;
SYSTEM_INFO si;
GetSystemInfo(&si);
workthread_wakeup = CreateEvent(NULL,TRUE,FALSE,NULL);
mainthread_wakeup = CreateEvent(NULL,TRUE,TRUE,NULL);
barrier_event = CreateEvent(NULL,TRUE,TRUE,NULL);
#if _WIN32_WINNT >= 0x0500
{ retval = InitializeCriticalSectionAndSpinCount(&thread_cs,spincount);
retval = InitializeCriticalSectionAndSpinCount(&element_cs,spincount);
retval = InitializeCriticalSectionAndSpinCount(&web_cs,spincount);
}
#else
{ InitializeCriticalSection(&thread_cs);
InitializeCriticalSection(&element_cs);
InitializeCriticalSection(&web_cs);
}
#endif
threadlist = (HANDLE*)my_list_calloc(procs_requested,sizeof(HANDLE),
ETERNAL_BLOCK);
thread_data_ptrs = (struct thread_data**)my_list_calloc(procs_requested,
sizeof(struct thread_data*),ETERNAL_BLOCK);
busythreads = procs_requested;
barrier_count = procs_requested;
ResetEvent(barrier_event);
for ( i = 0 ; i < procs_requested ; i++ )
{ DWORD tid; /* dummy for thread id */
thread_data_ptrs[i] =
(struct thread_data *)my_list_calloc(1,sizeof(struct thread_data),
ETERNAL_BLOCK);
thread_data_ptrs[i]->worker_id = i;
threadlist[i] = CreateThread(NULL,0,winthread_worker,
thread_data_ptrs[i],0,&tid);
if ( threadlist[i] == NULL )
{ FormatMessage(
FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */
(LPTSTR) &errmsg, ERRMSGSIZE, NULL );
erroutstring("Cannot create worker threads.\n");
kb_error(2190,errmsg,UNRECOVERABLE);
}
}
WaitForSingleObject(mainthread_wakeup,INFINITE);
sprintf(msg,"Created %d worker threads on %d processor machine.\n",
procs_requested,si.dwNumberOfProcessors);
if ( si.dwNumberOfProcessors == 1 )
spincount = 1; /* spin worthless on 1 cpu */
else spincount = 4000;
outstring(msg);
}
#endif
#ifdef PTHREADS
/* Set up worker threads for Unix multiprocessor machines with pthreads */
pthread_key_create(&thread_data_key,NULL);
pthread_setspecific(thread_data_key,(void*)&default_thread_data); // for main thread
if ( threadflag )
{ int i;
pthread_cond_init(&mainthread_wakeup,NULL);
pthread_cond_init(&workthread_wakeup,NULL);
pthread_mutex_init(&thread_mutex, NULL);
pthread_mutex_init(&element_mutex, NULL);
threadlist = (pthread_t *)my_list_calloc(procs_requested+10,sizeof(int),
ETERNAL_BLOCK);
thread_data_ptrs = (struct thread_data**)my_list_calloc(procs_requested,
sizeof(struct thread_data *),ETERNAL_BLOCK);
busythreads = procs_requested; /* countdown barrier */
pthread_mutex_lock(&thread_mutex);
for ( i = 0 ; i < procs_requested ; i++ )
{ int ret; /* dummy for thread id */
thread_data_ptrs[i] = (struct thread_data *)my_list_calloc(1,
sizeof(struct thread_data),ETERNAL_BLOCK);
thread_data_ptrs[i]->worker_id = i;
ret = pthread_create(threadlist+i,NULL,pthread_worker,
(void*)(thread_data_ptrs[i]));
if ( ret != 0 )
{
kb_error(2191,"Cannot create worker threads.\n",UNRECOVERABLE);
}
}
/* wait for workers to begin waiting; */
pthread_cond_wait(&mainthread_wakeup,&thread_mutex);
pthread_mutex_unlock(&thread_mutex);
sprintf(msg,"Created %d worker threads.\n", procs_requested);
outstring(msg);
}
#endif
/* If not doing multiple processes then have a thread data
structure so we don't have to write different code
for threading and nonthreading various places */
if ( thread_data_ptrs == NULL )
{ thread_data_ptrs = &default_thread_data_ptr;
thread_data_ptrs[0] = &default_thread_data;
#ifdef WINTHREADS
/* set per-thread data */
TlsSetValue(thread_data_key,(void*)&default_thread_data);
#endif
#ifdef PTHREADS
/* set per-thread data */
pthread_setspecific(thread_data_key,(void*)&default_thread_data);
#endif
}
signal(SIGINT,catcher); /* to catch user interrupt */
#ifdef SIGUSR1
signal(SIGUSR1,catcher); /* to catch user interrupt */
#endif
#ifdef SIGALRM
signal(SIGALRM,catcher); /* to catch alarm clock */
#endif
#ifdef SIGTERM
signal(SIGTERM,catcher); /* to catch user interrupt, dump and kill */
#endif
#ifdef SIGHUP
signal(SIGHUP,catcher); /* to catch user interrupt, dump and kill */
#endif
#ifdef SIGPIPE
signal(SIGPIPE,catcher); /* to catch broken pipe */
#endif
ENTER_GRAPH_MUTEX;
scoeff_init();
vcoeff_init();
reset_web(); /* in case no datafile on command line */
init_view();
LEAVE_GRAPH_MUTEX;
if ( argc && argv && argv[0] && argv[1] )
kb_error(1323,"Extra command line arguments ignored.\n",WARNING);
/* command sources stack */
push_commandfd(stdin,"stdin");
subshell_depth = 0;
if ( cmdfilename ) /* trap back to here if error and skip cmdfilename */
{ if ( !setjmp(jumpbuf[subshell_depth]) )
push_commandfd(NULL,cmdfilename);
}
#ifdef __cplusplus
char *to_load = (argc > 0) ? argv[0] : NULL;
for ( ;; )
{
try
{
startup(to_load);
datafile_flag = 0;
/* use C++ exception mechanism instead of setjmp/longjmp */
for (;;)
{
try
{
exec_commands(NULL,"Enter command: "); /* command read/execute loop */
}
catch ( int k )
{
}
}
}
catch ( loadexcep k ) /* corresponds to loadjumpbuf */
{ /* LOAD command returns here */
if ( list && (list != permlist))
{ myfree((char*)list); list = NULL; }/* plug memory leak */
to_load = loadfilename[0] ? loadfilename : NULL;
}
catch ( int j ) /* corresponds to jumpbuf */
{ to_load = NULL;
}
}
#else
if ( setjmp(loadjumpbuf) )
{ /* LOAD command returns here */
if ( list && (list != permlist))
{ myfree((char*)list); list = NULL; }/* plug memory leak */
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
mpi_loadfile();
#endif
startup(loadfilename);
}
else
{ if ( setjmp(jumpbuf[subshell_depth]) ) /* return here after datafile errors */
{
startup(NULL);
}
else
{ if ( argc > 0 )
startup(argv[0]);
else
{
#ifdef MPI_EVOLVER
if ( this_task != MASTER_TASK )
return 0; /* let master task ask for datafile */
#endif
startup(NULL);
}
}
}
datafile_flag = 0;
#endif
#ifdef MPI_EVOLVER
// MPI_Barrier(MPI_COMM_WORLD);
if ( this_task > 0 )
return 0; /* return to mpi main() */
calc_energy(); /* initial energy */
#endif
subshell_depth = 0;
#ifdef __cplusplus
#else
/* return here after commandfile errors */
while ( setjmp(jumpbuf[subshell_depth]) != 0 );
exec_commands(NULL,"Enter command: "); /* command read and execute loop */
#endif
my_exit(0);
return 0; /* success return code */
}
#ifdef __cplusplus
void loadstub()
{ struct loadexcep something;
throw something;
}
#endif
/********************************************************************
*
* function: my_exit()
*
* purpose: graceful exit from program
*/
void my_exit ARGS1((code),
int code)
{
if ( OOGL_flag ) End_OOGL();
#ifdef SIGTERM
signal(SIGTERM,SIG_DFL);
#endif
#ifdef SGI_MULTI
if ( nprocs > 1)
{ m_rele_procs();
m_kill_procs(); /* kill any parallel threads */
}
#endif
#if defined(MPI_EVOLVER)
mpi_my_exit();
#endif
#ifdef USE_READLINE /* CSL */
save_readline_history();
#endif
exit(code);
}
/********************************************************************
*
* function: exec_commands()
*
* purpose: reads and executes commands from input.
* pops command file stack whenever end of file.
*/
int exec_commands ARGS2((basefd,promptstring),
FILE *basefd, /* stop when get back to this input source */
char *promptstring) /* prompt to use */
{ /* main event loop of program */
while ( commandfd && (commandfd != basefd))
{
char response[200];
datafile_flag = 0; /* in case of error bailout sometimes */
if ( !subshell_depth )
{
temp_free_all(); /* stray memory blocks */
free_discards(DISCARDS_ALL); /* from previous cycle */
memset(response,0,sizeof(response));
}
if ( prompt(promptstring,response,sizeof(response)) == EOF )
pop_commandfd();
else
if ( old_menu(response) == END_COMMANDS )
return END_COMMANDS;
}
return 0;
}
#ifdef MAC_OS_X
/********************************************************************
*
* function: mac_exec_commands()
*
* purpose: wrapper for exec_commands so Mac main thread (which is
* the draw thread) can call with one argument.
*/
struct thread_data mac_exec_thread_data;
void *mac_exec_commands ARGS1((arg),
FILE *arg)
{
#ifdef __cplusplus
char *to_load = NULL;
int flag; /* so doesn't prompt user for input file first time, if have */
pthread_setspecific(thread_data_key,(void*)&mac_exec_thread_data);
flag = !datafilename[0];
for ( ;; )
{
if ( flag )
startup(to_load);
flag = 1;
try
{
/* use C++ exception mechanism instead of setjmp/longjmp */
for (;;)
{
try
{
chdir(curdir);
exec_commands(NULL,"Enter command: "); /* command read/execute loop */
}
catch ( int k )
{
}
}
}
catch ( loadexcep k ) /* corresponds to loadjmpbuf */
{ /* LOAD command returns here */
if ( list && (list != permlist))
{ myfree((char*)list); list = NULL; }/* plug memory leak */
to_load = loadfilename[0] ? loadfilename : NULL;
}
catch ( int j ) /* corresponds to jumpbuf */
{ to_load = NULL;
}
}
#else
pthread_setspecific(thread_data_key,(void*)&mac_exec_thread_data);
if ( setjmp(loadjumpbuf) )
{ /* LOAD command returns here */
if ( list && (list != permlist))
{ myfree((char*)list); list = NULL; }/* plug memory leak */
startup(loadfilename);
}
else
{ if ( setjmp(jumpbuf[subshell_depth]) ) /* return here after datafile errors */
{
exec_commands(NULL,"Enter command: "); /* command read/execute loop */
// startup(NULL);
}
else
{ if ( do_show_flag == 1 )
do_show();
chdir(curdir); /* so command thread gets proper directory */
exec_commands(NULL,"Enter command: "); /* command read/execute loop */
// startup(NULL);
}
}
datafile_flag = 0;
#endif
#ifdef MPI_EVOLVER
MPI_Barrier(MPI_COMM_WORLD);
if ( this_task > 0 )
return 0; /* return to mpi main() */
calc_energy(); /* initial energy */
#endif
#ifdef __cplusplus
#else
while ( setjmp(jumpbuf[subshell_depth]) != 0 ); /* return here after commandfile errors */
exec_commands(NULL,"Enter command: "); /* command read and execute loop */
#endif
return NULL;
}
#endif
/********************************************************************
*
* function: exec_file()
*
* purpose: reads and executes commands from a file.
* to be used by read "filename" command.
* can be used in the middle of executing a command.
*/
void exec_file ARGS2((fd,name),
FILE *fd, /* file, if already opened, like stdin */
char *name) /* file name, if not already opened */
{ int old_read_depth = read_depth;
push_commandfd(fd,name);
do /* main event loop of program */
{
char response[200];
temp_free_all(); /* stray memory blocks */
free_discards(DISCARDS_SOME); /* from previous cycle */
memset(response,0,sizeof(response));
if ( prompt("Enter command: ",response,sizeof(response)) == EOF )
pop_commandfd();
else
old_menu(response);
}
while ( read_depth > old_read_depth );
}
/****************************************************************
*
* Function: startup()
*
* Purpose: Start new datafile.
*
*****************************************************************/
void startup ARGS1((file_name),
char *file_name) /* NULL if need to ask for name */
{
char *name = file_name;
char response[100];
FILE *newfd;
/* be sure graphics thread is ok before loading new file */
ENTER_GRAPH_MUTEX;
LEAVE_GRAPH_MUTEX;
datafile_flag = 0;
/* close leftover input files */
for ( ; read_depth > (cmdfilename ? 2 : 1) ; read_depth-- )
fclose(cmdfile_stack[read_depth-1].fd);
file_retry:
if ( name == NULL )
{ char *c;
#ifdef MPI_EVOLVER
if ( this_task != MASTER_TASK )
return; /* wait for master to get new name */
#endif
prompt("Enter new datafile name (none to continue, q to quit): ",
response,sizeof(response));
c = strchr(response,'\n');
if ( c ) *c = 0;
c = strchr(response,' ');
if ( c ) *c = 0;
if ( (strcmp(response,"q") == 0) || (strcmp(response,"quit")==0)
|| (strcmp(response,"bye")==0) || (strcmp(response,"exit")==0))
my_exit(0);
else if ( !response[0] ) return; /* continue same */
name = response;
#ifdef MPI_EVOLVER
strcpy(loadfilename,name);
mpi_loadfile();
#endif
}
newfd = path_open(name,SETDATAFILENAME);
if (newfd == NULL)
{ if ( name[0] )
{
sprintf(msg,"Cannot open datafile %s.\n",name);
erroutstring(msg);
if ( exit_after_error ) my_exit(1);
name = NULL;
while ( read_depth > (cmdfilename ? 2 : 1) ) pop_commandfd();
goto file_retry;
}
return; /* continue with old */
}
#ifdef WIN32
#ifdef MPI_EVOLVER
sprintf(msg,"Surface Evolver MPI - %s",name);
#else
sprintf(msg,"Surface Evolver - %s",name);
#endif
SetConsoleTitle(msg);
#endif
ENTER_GRAPH_MUTEX;
reset_web();
init_view();
if (memdebug) memory_report();
push_commandfd(newfd,name); /* start #include stack */
#ifdef __WIN32__
if ( heapcheck() < 0 )
kb_error(1324,"Internal error: Corrupt heap.\n",UNRECOVERABLE);
#endif
datafile_flag = 1; /* so parser knows */
datafile_input_flag = 1; /* so lex input knows */
cmdptr = 0;
initialize();
LEAVE_GRAPH_MUTEX;
datafile_flag = 0;
if ( read_depth > 0 )
cmdfile_stack[read_depth-1].line = line_no;
if ( datafile_view_flag )
{ int i,j;
REAL sum;
for ( sum = 0.0, i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ ) sum += fabs(view[i][j]);
overall_size = 3/sum;
dont_resize_flag = 1;
}
else
{
resize();
}
graph_new_surface(); /* tell graphics we have new one */
if ( parse_errors )
{ while ( (read_depth > 1) ) pop_commandfd();
kb_error(1325,"Invalid datafile. Surface may not be in a consistent state.\n",RECOVERABLE);
}
run_checks();
update_display();
#ifndef MPI_EVOLVER
calc_content(Q_ENERGY|Q_FIXED|Q_INFO|Q_RENORMALIZE);
if ( web.torus_flag ) fix_volconst();
calc_pressure();
calc_energy(); /* just to get initial total area */
target_length = web.total_area; /* for square curvature string model */
if ( OOGL_flag ) ask_wrap_display();
#endif
}
#ifdef THREADS
/****************************************************************************
*****************************************************************************
Multi-threading for multi-processing with shared memory.
****************************************************************************/
void thread_stage_setup ARGS((void));
/*****************************************************************************
*
* function: task_caller()
*
* purpose: provide common place for various type worker threads to
* call the desired task.
*/
void task_caller ARGS1((thread_tasknum),
int thread_tasknum)
{
struct thread_data *data = GET_THREAD_DATA;
__int32 task_caller_elapsed_time[2];
__int32 now[2];
task_caller_elapsed_time[0] = 0;
task_caller_elapsed_time[1] = 0;
data->task_state = 1;
PROF_NOW(now);
#ifdef _MSC_VER
data->stagestart[0] = *(__int64*)now;
#endif
PROF_START(task_caller)
switch ( thread_tasknum )
{
case TH_PROJECT_ALL_TEST: thread_project_all(TEST_MOVE); break;
case TH_PROJECT_ALL_ACTUAL: thread_project_all(ACTUAL_MOVE); break;
case TH_CALC_FACET_ENERGY:
data->total_energy = data->total_area = 0.0;
thread_calc_facet_energy(); break;
case TH_CALC_FACET_FORCES: thread_calc_facet_forces(); break;
case TH_MULTI_CALC_QUANT: multi_calc_quants(m_type); break;
case TH_MULTI_QUANT_GRADS: m_calc_quant_grads(m_type); break;
case TH_FIX_GRADS: m_fix_grads(); break;
case TH_MULTI_QUANT_HESS: m_calc_quant_hess(m_type,m_mode,m_rhs); break;
case TH_MOVE_VERTICES: thread_move_vertices(); break;
default: sprintf(errmsg,"Invalid thread task: %d\n",thread_tasknum);
kb_error(2192,errmsg,UNRECOVERABLE);
}
PROF_FINISH(task_caller)
#ifdef ZZZZZ
if(verbose_flag)
{ char *taskname;
switch ( thread_tasknum )
{
case TH_PROJECT_ALL_TEST: taskname="thread_project_all"; break;
case TH_PROJECT_ALL_ACTUAL: taskname="thread_project_all"; break;
case TH_CALC_FACET_ENERGY:
taskname="thread_calc_facet_energy"; break;
case TH_CALC_FACET_FORCES: taskname="thread_calc_facet_forces"; break;
case TH_MULTI_CALC_QUANT: taskname="multi_calc_quants"; break;
case TH_MULTI_QUANT_GRADS: taskname="m_calc_quant_grads"; break;
case TH_FIX_GRADS: taskname="m_fix_grads"; break;
case TH_MULTI_QUANT_HESS: taskname="m_calc_quant_hess"; break;
default: taskname="default";
}
printf("%30s",taskname);
PROF_PRINT(task_caller)
}
#endif
data->task_state = 2;
}
#endif
#ifdef WINTHREADS
/*****************************************************************************
*
* function: winthread_worker()
*
* purpose: Main winthread worker function. Waits for wakeup call and
* then executes task.
*
*/
DWORD WINAPI winthread_worker ( void * arg )
{ struct thread_data *data = (struct thread_data *)arg;
/* set per-thread data */
TlsSetValue(thread_data_key,(void*)data);
/* Set affinity mask. Actually seems to hurt. */
/*
SetThreadAffinityMask(threadlist[data->worker_id],1<worker_id);
*/
/* Loop waiting for wakeup calls. Use single event rather than event */
/* for each type of task since MAXIMUM_WAIT_OBJECTS is 64. */
for (;;)
{
InterlockedDecrement(&busythreads);
if ( busythreads == 0 )
{
ResetEvent(workthread_wakeup);
SetEvent(barrier_event);
}
WaitForSingleObject(barrier_event,INFINITE);
InterlockedDecrement(&barrier_count);
if ( barrier_count == 0 )
SetEvent(mainthread_wakeup);
WaitForSingleObject(workthread_wakeup,INFINITE);
task_caller(thread_task);
}
}
#endif
#ifdef PTHREADS
/*****************************************************************************
*
* function: pthread_worker()
*
* purpose: Main pthreads worker function. Waits for wakeup call and
* then executes task.
* arg is thread data area.
*/
void *pthread_worker( void * arg )
{ struct thread_data *data = (struct thread_data *)arg;
/* set per-thread data */
pthread_setspecific(thread_data_key,(void*)data);
for (;;)
{
/* barrier song and dance to let main thread know workers are waiting */
pthread_mutex_lock(&thread_mutex);
busythreads--;
if ( busythreads == 0 )
pthread_cond_signal(&mainthread_wakeup);
pthread_cond_wait(&workthread_wakeup,&thread_mutex);
pthread_mutex_unlock(&thread_mutex);
#ifdef PTHREAD_LOG
{ /* log thread event */
rdtsc(data->events[data->eventcount].time_low,
data->events[data->eventcount].time_high);
data->events[data->eventcount].type = thread_task;
data->eventcount++;
}
#endif
task_caller(thread_task);
#ifdef PTHREAD_LOG
{ /* log thread event */
rdtsc(data->events[data->eventcount].time_low,
data->events[data->eventcount].time_high);
data->events[data->eventcount].type = -thread_task;
data->eventcount++;
}
#endif
}
return NULL;
} /* end pthread_worker() */
#endif
#ifdef THREADS
/**************************************************************************
*
* function: pcomp()
*
* purpose: comparison function for sorting partition coordinates.
*/
struct pcoord { REAL p_coord; vertex_id v_id; };
int pcomp ARGS((struct pcoord*,struct pcoord*));
int pcomp ARGS2((a,b),
struct pcoord *a, struct pcoord *b)
{
if ( a->p_coord < b->p_coord ) return -1;
if ( a->p_coord > b->p_coord ) return 1;
return 0;
}
/**************************************************************************
*
* function: thread_stage_setup()
*
* purpose: Initialize element lists for thread stages.
*/
void thread_stage_setup()
{ int i,pcount,pspot,perstage;
vertex_id v_id;
edge_id e_id;
facet_id f_id;
int proc,stage;
struct pcoord *pcoords;
struct thread_stages_data *th;
int one = 1;
max_thread_stages = 2; /* simple 1-D partitioning */
/* Make sure vertex partitioning coord exists */
v_partition_coord_attr = find_attribute(VERTEX,"v_partition_coord");
if ( v_partition_coord_attr < 0 )
{ v_partition_coord_attr = add_attribute(VERTEX,"v_partition_coord",
REAL_TYPE,0,&one,0,NULL);
}
/* default for now: use x coordinate as partition coordinate */
FOR_ALL_VERTICES(v_id)
{ *((REAL*)(get_extra(v_id,v_partition_coord_attr))) = get_coord(v_id)[0];
}
v_partition_stage_attr = find_attribute(VERTEX,"v_partition_stage");
if ( v_partition_stage_attr < 0 )
{ v_partition_stage_attr = add_attribute(VERTEX,"v_partition_stage",
INTEGER_TYPE,0,&one,0,NULL);
}
v_partition_proc_attr = find_attribute(VERTEX,"v_partition_proc");
if ( v_partition_proc_attr < 0 )
{ v_partition_proc_attr = add_attribute(VERTEX,"v_partition_proc",
INTEGER_TYPE,0,&one,0,NULL);
}
e_partition_stage_attr = find_attribute(EDGE,"e_partition_stage");
if ( e_partition_stage_attr < 0 )
{ e_partition_stage_attr = add_attribute(EDGE,"e_partition_stage",
INTEGER_TYPE,0,&one,0,NULL);
}
e_partition_proc_attr = find_attribute(EDGE,"e_partition_proc");
if ( e_partition_proc_attr < 0 )
{ e_partition_proc_attr = add_attribute(EDGE,"e_partition_proc",
INTEGER_TYPE,0,&one,0,NULL);
}
f_partition_stage_attr = find_attribute(FACET,"f_partition_stage");
if ( f_partition_stage_attr < 0 )
{ f_partition_stage_attr = add_attribute(FACET,"f_partition_stage",
INTEGER_TYPE,0,&one,0,NULL);
}
f_partition_proc_attr = find_attribute(FACET,"f_partition_proc");
if ( f_partition_proc_attr < 0 )
{ f_partition_proc_attr = add_attribute(FACET,"f_partition_proc",
INTEGER_TYPE,0,&one,0,NULL);
}
/* Find percentiles, for load balancing */
pcoords = (struct pcoord*)temp_calloc(web.skel[VERTEX].count,
sizeof(struct pcoord));
pcount = 0;
FOR_ALL_VERTICES(v_id)
{ pcoords[pcount].p_coord = *((REAL*)(get_extra(v_id,v_partition_coord_attr)));
pcoords[pcount].v_id = v_id;
pcount++;
}
qsort((char*)pcoords,pcount,sizeof(struct pcoord),FCAST pcomp);
pspot = 0;
perstage = pcount/(nprocs*max_thread_stages) + 1;
for ( proc = 0 ; proc < nprocs ; proc++ )
{
for ( stage = 0 ; stage < max_thread_stages ; stage++ )
{
for ( i = 0 ; (i < perstage) && (pspot < pcount) ; i++,pspot++ )
{ *((int *)(get_extra(pcoords[pspot].v_id,v_partition_proc_attr))) = proc;
*((int *)(get_extra(pcoords[pspot].v_id,v_partition_stage_attr))) = stage;
}
}
}
temp_free((char*)pcoords);
if ( thread_stages == NULL )
thread_stages = (struct thread_stages_data*)mycalloc(nprocs,
sizeof(struct thread_stages_data));
/* set up all element's stage lists */
for ( proc = 0 ; proc < nprocs ; proc++ )
for ( stage = 0 ; stage < max_thread_stages ; stage++ )
thread_stages[proc].counts[VERTEX][stage] = 0;
thread_stages[0].counts[VERTEX][max_thread_stages] = 0;
FOR_ALL_VERTICES(v_id)
{ proc = *(int*)get_extra(v_id,v_partition_proc_attr);
stage = *(int*)get_extra(v_id,v_partition_stage_attr);
th = thread_stages+proc;
if ( th->counts[VERTEX][stage] >= th->allocated[VERTEX][stage] )
{ int newalloc = th->allocated[VERTEX][stage] + 10
+ 2*web.skel[VERTEX].count/(nprocs*max_thread_stages);
th->blocks[VERTEX][stage] = (element_id *)kb_realloc(
(char*)(th->blocks[VERTEX][stage]),newalloc*sizeof(element_id));
th->allocated[VERTEX][stage] = newalloc;
}
th->blocks[VERTEX][stage][th->counts[VERTEX][stage]++] = v_id;
}
for ( proc = 0 ; proc < nprocs ; proc++ )
for ( stage = 0 ; stage < max_thread_stages ; stage++ )
thread_stages[proc].counts[EDGE][stage] = 0;
thread_stages[0].counts[EDGE][max_thread_stages] = 0;
FOR_ALL_EDGES(e_id)
{ vertex_id head = get_edge_headv(e_id);
vertex_id tail = get_edge_tailv(e_id);
int hproc = *(int*)get_extra(head,v_partition_proc_attr);
int tproc = *(int*)get_extra(tail,v_partition_proc_attr);
int hstage = *(int*)get_extra(head,v_partition_stage_attr);
int tstage = *(int*)get_extra(tail,v_partition_stage_attr);
int hband = hstage + max_thread_stages*hproc;
int tband = tstage + max_thread_stages*tproc;
if ( abs(hband-tband) <= 1 )
{ if ( hband < tband ) { proc = hproc; stage = hstage; }
else { proc = tproc; stage = tstage;}
}
else if ( web.symmetry_flag && (hband == 0) &&
(tband == nprocs*max_thread_stages-1 ) )
{ proc = tproc; stage = tstage;}
else if ( web.symmetry_flag && (tband == 0) &&
(hband == nprocs*max_thread_stages-1 ) )
{ proc = hproc; stage = hstage;}
else /* big element */
{ proc = 0; stage = max_thread_stages; }
th = thread_stages+proc;
if ( th->counts[EDGE][stage] >= th->allocated[EDGE][stage] )
{ int newalloc = th->allocated[EDGE][stage] + 10
+ 2*web.skel[EDGE].count/(nprocs*max_thread_stages);
th->blocks[EDGE][stage] = (element_id *)kb_realloc(
(char*)(th->blocks[EDGE][stage]),newalloc*sizeof(element_id));
th->allocated[EDGE][stage] = newalloc;
}
th->blocks[EDGE][stage][th->counts[EDGE][stage]++] = e_id;
*((int *)(get_extra(e_id,e_partition_proc_attr))) = proc;
*((int *)(get_extra(e_id,e_partition_stage_attr))) = stage;
}
for ( proc = 0 ; proc < nprocs ; proc++ )
for ( stage = 0 ; stage < max_thread_stages ; stage++ )
thread_stages[proc].counts[FACET][stage] = 0;
thread_stages[0].counts[FACET][max_thread_stages] = 0;
FOR_ALL_FACETS(f_id)
{ facetedge_id fe = get_facet_fe(f_id);
int topband = -1;
int lowband = 1000000;
int vproc,vstage,vband;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ v_id = get_fe_headv(fe);
vproc = *(int*)get_extra(v_id,v_partition_proc_attr);
vstage = *(int*)get_extra(v_id,v_partition_stage_attr);
vband = vstage + max_thread_stages*vproc;
if ( vband < lowband ) lowband = vband;
if ( vband > topband ) topband = vband;
fe = get_next_edge(fe);
}
if ( topband-lowband <= 1 )
{ proc = lowband/max_thread_stages;
stage = lowband % max_thread_stages;
}
else if ( web.symmetry_flag && (lowband == 0) &&
(topband == nprocs*max_thread_stages-1 ) )
{ proc = topband/max_thread_stages;
stage = topband % max_thread_stages;
}
else /* big element */
{ proc = 0; stage = max_thread_stages; }
th = thread_stages+proc;
if ( th->counts[FACET][stage] >= th->allocated[FACET][stage] )
{ int newalloc = th->allocated[FACET][stage] + 10
+ 2*web.skel[FACET].count/(nprocs*max_thread_stages);
th->blocks[FACET][stage] = (element_id *)kb_realloc(
(char*)(th->blocks[FACET][stage]),newalloc*sizeof(element_id));
th->allocated[FACET][stage] = newalloc;
}
th->blocks[FACET][stage][th->counts[FACET][stage]++] = f_id;
*((int *)(get_extra(f_id,f_partition_proc_attr))) = proc;
*((int *)(get_extra(f_id,f_partition_stage_attr))) = stage;
}
partition_timestamp = global_timestamp;
} /* end thread_stage_setup */
#endif
#ifdef WINTHREADS
/**************************************************************************
*
* function: thread_launch()
*
* purpose: Send signal to launch worker threads, after initializing
* global iteration variable.
*/
void thread_launch(int task, int element_type)
{ int i,j,proc;
__int32 now[2];
PROF_NOW(now);
thread_launch_start = *(__int64*)now;
global_id = web.skel[element_type].used; /* in case no threads */
if ( partition_timestamp < top_timestamp )
thread_stage_setup();
for ( proc = 0 ; proc < nprocs ; proc++ )
thread_stages[proc].stage = thread_stages[proc].spot = 0;
thread_task = task;
ResetEvent(mainthread_wakeup); /* just to be sure */
busythreads = procs_requested;
ResetEvent(barrier_event);
barrier_count = procs_requested;
SetEvent(workthread_wakeup);
WaitForSingleObject(mainthread_wakeup,INFINITE);
/* Cleanup and amalgamation of data */
switch ( task )
{ case TH_CALC_FACET_ENERGY:
for ( i = 0 ; i < nprocs ; i++ )
{ web.total_energy += thread_data_ptrs[i]->total_energy;
web.total_area += thread_data_ptrs[i]->total_area;
}
break;
}
PROF_NOW(now);
thread_launch_end = *(__int64*)now;
if ( verbose_flag )
{
/* print detailed clock timing */
printf("thread_launch_start %12I64X\n",thread_launch_start-thread_launch_start);
for (i = 0 ; i <= max_thread_stages ; i++ )
printf("task 0 stage %d start: %12I64X end: %12I64X\n",i,
thread_data_ptrs[0]->stagestart[i]-thread_launch_start,
thread_data_ptrs[0]->stageend[i]-thread_launch_start);
for ( j = 1; j < nprocs ; j++ )
{ for (i = 0 ; i < max_thread_stages ; i++ )
printf("task 1 stage %d start: %12I64X end: %12I64X\n",i,
thread_data_ptrs[j]->stagestart[i]-thread_launch_start,
thread_data_ptrs[j]->stageend[i]-thread_launch_start);
}
printf("thread_launch_end %12I64X\n",thread_launch_end-thread_launch_start);
}
}
#endif
#ifdef PTHREADS
/**************************************************************************
*
* function: thread_launch()
*
* purpose: Send signal to launch worker threads, after initializing
* global iteration variable.
* Note: Have to be very careful with timing, since wake up happens only
* if thread is actually waiting when signal made; signal ignored if
* made before wait starts.
*/
void thread_launch(int task, int element_type)
{ int i,proc;
global_id = web.skel[element_type].used;
for ( i = 0 ; i < nprocs ; i++ )
{ /* make sure we are starting with an actual element */
while ( valid_id(global_id) && !valid_element(global_id) )
global_id = elptr(global_id)->forechain;
thread_data_ptrs[i]->iteration_id = global_id;
if ( valid_id(global_id) )
global_id = elptr(global_id)->forechain;
}
if ( partition_timestamp < top_timestamp )
thread_stage_setup();
for ( proc = 0 ; proc < nprocs ; proc++ )
thread_stages[proc].stage = thread_stages[proc].spot = 0;
thread_task = task;
pthread_mutex_lock(&thread_mutex); /* wait for last thread to wait */
busythreads = procs_requested;
pthread_cond_broadcast(&workthread_wakeup);
/* wait for workers to begin waiting; */
pthread_cond_wait(&mainthread_wakeup,&thread_mutex);
pthread_mutex_unlock(&thread_mutex);
#ifdef PTHREAD_LOG
{ /* log thread event */
rdtsc(main_events[main_eventcount].time_low,
main_events[main_eventcount].time_high);
main_events[main_eventcount].type = 0;
main_eventcount++;
}
#endif
/* Cleanup and amalgamation of data */
switch ( task )
{ case TH_CALC_FACET_ENERGY:
for ( i = 0 ; i < nprocs ; i++ )
{ web.total_energy += thread_data_ptrs[i]->total_energy;
web.total_area += thread_data_ptrs[i]->total_area;
}
break;
}
}
#endif
#ifndef THREADS
void thread_launch(int task, int element_type)
{ sprintf(errmsg,"Internal error. Function thread_launch called in non-threaded Evolver. Task %d, type %d.\n",task,element_type);
kb_error(2193,errmsg,RECOVERABLE);
}
#endif
#ifdef THREADS
/**************************************************************************
*
* function: thread_next_element()
*
* purpose: Get next element on task list for a calling thread.
* Assumes global_id initialized to first element of
* appropriate element list. Goes until end of list, not
* sentinel, so to be used for functions that don't modify
* the element list.
*
* Performance note: with two processors, get twice as many thread_locks
* as thread_unlocks!! Get about half as many web_locks as web_unlocks.
*/
element_id thread_next_element()
{ element_id id;
int proc,nextproc;
int eltype;
struct thread_stages_data *th;
struct thread_data *data;
__int32 now[2]; /* for timing */
/* First, in case multithreading not being used */
if ( threadflag == 0 )
{
while ( valid_id(global_id) & !valid_element(global_id) )
global_id = elptr(global_id)->forechain;
if ( !valid_id(global_id) ) return NULLID;
id = global_id;
global_id = elptr(id)->forechain;
return id;
}
data = GET_THREAD_DATA;
proc = data->worker_id;
th = thread_stages + proc;
eltype = id_type(global_id);
for (;;) /* loop just for case when starting new stage */
{
if ( th->spot < th->counts[eltype][th->stage] )
{ id = th->blocks[eltype][th->stage][th->spot++];
break;
}
else
{ th->stage++; /* signify done */
#ifdef _MSC_VER
PROF_NOW(now);
data->stageend[th->stage-1] = *(__int64*)now;
#endif
th->spot = 0;
if ( th->stage == ((proc==0) ? max_thread_stages+1 : max_thread_stages) )
{ id = NULLID;
break;
}
else /* look for next stage */
{ if ( th->stage < max_thread_stages )
{ nextproc = (proc == nprocs - 1) ? 0 : proc+1;
while ( thread_stages[nextproc].stage < th->stage ) ; /* wait */
}
else /* proc 0 to do big elements */
{ for ( nextproc = 1 ; nextproc < nprocs ; nextproc++ )
while ( thread_stages[nextproc].stage < th->stage ) ; /* wait */
}
#ifdef _MSC_VER
PROF_NOW(now);
data->stagestart[th->stage] = *(__int64*)now;
#endif
}
}
}
return id;
}
#endif
/***************************************************************************
*
*/
#ifdef WINTHREADS
/* Indirection to lock functions to avoid including windows.h everywhere */
int mylock_element(element_id id)
{ if ( TryEnterCriticalSection(element_mutex_ptr)==0 )
{EnterCriticalSection(element_mutex_ptr);
element_locks++;
}
else element_unlocks++;
return 0; /* so can be used in conditionals */
}
int myunlock_element(element_id id)
{ LeaveCriticalSection(element_mutex_ptr);
return 0;
}
int mylock_web(void)
{ if ( TryEnterCriticalSection(web_mutex_ptr)==0 )
{EnterCriticalSection(web_mutex_ptr);
web_locks++;
}
else web_unlocks++;
return 0;
}
int myunlock_web(void)
{ LeaveCriticalSection(web_mutex_ptr);
return 0;
}
struct thread_data *win_get_thread_data(DWORD key)
{ return (struct thread_data *)TlsGetValue(key);
}
#endif
#ifdef PTHREADS
int mylock_element(element_id id)
{
/* Using lock field in element structure. */
/* using lock count semantics, i.e. lock=1 is locked. */
/* Note we have to save ebx, since caller assumes saved. */
#ifdef TIMING
__asm__ (
" pushl %ebx\n"
" pushl 8(%ebp)\n"
" call elptr\n"
" addl $4,%esp\n"
" movl %eax,%ebx\n"
" addl $16,%ebx\n"
".L8889j: \n"
" movl $1,%eax\n"
"LOCK cmpxchgl %eax,0(%ebx)\n"
" jz .L8889j \n"
" popl %ebx\n"
);
#endif
return 0;
}
#endif
/**************************************************************************
*
* function: find_cpu_speed()
*
* purpose: tries to find out current CPU speed for profiling reports.
*/
void find_cpu_speed()
{
#if defined(_MSC_VER) && defined(PROFILING)
{ /* use high-performance counter to estimate frequency */
LARGE_INTEGER freq,start,finish;
__int32 profstart[2],profnow[2];
QueryPerformanceFrequency(&freq);
PROF_NOW(profstart);
PROF_NOW(profnow);
QueryPerformanceCounter(&start);
do {
if ( *(__int64*)profnow - *(__int64*)profstart <= 0 )
{ /* something wrong; maybe hibernated in middle of loop! */
return;
}
PROF_NOW(profnow);
}
while ( *(__int64*)profnow - *(__int64*)profstart < 100000000 );
QueryPerformanceCounter(&finish);
cpu_speed = (*(__int64*)profnow-*(__int64*)profstart)/
((finish.QuadPart-start.QuadPart)/(double)freq.QuadPart);
}
#else
cpu_speed = 3e9; /* rough guess */
#endif
}
evolver-2.30c.dfsg/src/filmq.c 0000644 0001753 0001753 00000067505 11410765113 016506 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************************
*
* file: filmq.c
*
* contents: Functions for calculating energy, volume,
* and their gradients for the QUADRATIC
* SOAPFILM model. Also utility functions
* for quadratic interpolation and Gaussian
* integration.
*/
/************************************************************************
*
* Functions to calculate area, volume, and energy according to
* the tessellation model.
*
* Quadratic patch version, using n-point facet cubature of integral_order.
*/
#include "include.h"
/* volume coefficients, used only for quadratic volume */
REAL vcoeff[FACET_CTRL][FACET_CTRL][FACET_CTRL];
/* interpolation polynomial second partials */
REAL poly2partial[FACET_CTRL][2][2] = { { {1.0, 1.0}, {1.0, 1.0} },
{{-2.0, -1.0}, {-1.0, 0.0} },{ {1.0,0.0},{0.0,0.0} },
{ {0.0,1.0},{1.0,0.0} }, { {0.0,0.0},{0.0,1.0} },
{ {0.0,-1.0},{-1.0,2.0} } };
/************************************************************************
*
* Calculates all forces on control points due to facet and
* accumulates them at each control point.
* Quadratic version.
*/
void facet_force_q(f_id)
facet_id f_id;
{
vertex_id v_id[FACET_CTRL];
MAT2D(x,FACET_CTRL,MAXCOORD);
REAL normal[MAXCOORD];
int i,j,k,n;
REAL norm,summer[2][MAXCOORD];
facetedge_id fe_id;
REAL density = get_facet_density(f_id);
REAL area = 0.0;
REAL gdensity = 0.0;
REAL z;
body_id b_id;
REAL forces[FACET_CTRL][MAXCOORD]; /* total forces from this facet */
REAL *forceptr[FACET_CTRL]; /* pointers to forces */
WRAPTYPE wraps[FACET_CTRL];
MAT2D(tang,MAXCOORD,MAXCOORD);
memset((char*)forces,0,sizeof(forces)); /* set to 0 */
/* get control points */
fe_id = get_facet_fe(f_id);
for ( i = 0, j = 0 ; i < FACET_EDGES ; i++ )
{ v_id[j++] = get_fe_tailv(fe_id);
v_id[j++] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
for ( j = 0 ; j < FACET_CTRL ; j++ )
forceptr[j] = forces[j];
get_facet_verts(f_id,x,wraps);
if ( web.metric_flag )
{ simplex_force_metric(v_id,x,density,forceptr);
goto cumforces; /* assume no gravity */
}
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{ b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
gdensity += get_body_density(b_id)*web.grav_const;
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
gdensity -= get_body_density(b_id)*web.grav_const;
}
for ( i = 0 ; i < gauss2D_num ; i++ ) /* integration point number */
{ /* calculate tangents and normals */
mat_mult(gpolypartial[i],x,tang,web.dimension,ctrl_num,SDIM);
cross_prod(tang[0],tang[1],normal);
norm = sqrt(SDIM_dot(normal,normal));
for ( n = 0 ; n < 2 ; n++ ) /* parameter number */
cross_prod(normal,tang[n],summer[n]);
area += density*gauss2Dwt[i]/2*norm;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
forces[k][j] -= density*gauss2Dwt[i]/2/norm*
(gpolypartial[i][1][k]*summer[0][j]
- gpolypartial[i][0][k]*summer[1][j]);
/* add gravitational force */
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{ z = 0.0;
for ( j = 0 ; j < FACET_CTRL ; j++ )
z += gpoly[i][j]*x[j][2];
for ( j = 0 ; j < FACET_CTRL ; j++ )
{ forces[j][0] -= 0.5*z*z*gauss2Dwt[i]/2*gdensity
*(gpolypartial[i][0][j]*tang[1][1] -
tang[0][1]*gpolypartial[i][1][j]);
forces[j][1] -= 0.5*z*z*gauss2Dwt[i]/2*gdensity
*(tang[0][0]*gpolypartial[i][1][j] -
gpolypartial[i][0][j]*tang[1][0]);
forces[j][2] -= z*gpoly[i][j]*gauss2Dwt[i]/2*gdensity
*(tang[0][0]*tang[1][1] - tang[0][1]*tang[1][0]);
}
}
}
cumforces:
/* add to totals, unwrapping if necessary */
for ( i = 0 ; i < FACET_CTRL ; i++ ) /* vertex loop */
{ REAL *f;
REAL wforce[MAXCOORD]; /* unwrapped forces */
f= get_force(v_id[i]);
if ( web.symmetry_flag )
{ (*sym_form_pullback)(get_coord(v_id[i]),wforce,forces[i],wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
f[j] += wforce[j];
}
else
for ( j = 0 ; j < SDIM ; j++ )
f[j] += forces[i][j];
}
set_facet_area(f_id,area);
} /* end facet_force_q() */
/*********************************************************************
*
* Function: facet_energy_q()
*
* Purpose: Returns energy due to facet. Quadratic version.
*/
void facet_energy_q(f_id,mode)
facet_id f_id;
int mode; /* AREA_ONLY or ALL_ENERGY */
{
REAL energy = 0.0;
body_id b_id;
MAT2D(x,FACET_CTRL,MAXCOORD);
vertex_id v_id[FACET_CTRL];
REAL normal[MAXCOORD];
int i,j;
REAL norm;
facetedge_id fe_id;
REAL u = 0.0; /* gravitational integral */
REAL z;
WRAPTYPE wraps[FACET_CTRL];
MAT2D(tang,MAXCOORD,MAXCOORD);
/* get control points */
get_facet_verts(f_id,x,wraps);
if ( web.metric_flag )
{ energy = simplex_energy_metric(v_id,x);
goto skip_from_metric;
}
for ( i = 0 ; i < gauss2D_num ; i++ ) /* integration point number */
{
/* calculate tangents and normals */
mat_mult(gpolypartial[i],x,tang,web.dimension,ctrl_num,SDIM);
cross_prod(tang[0],tang[1],normal);
norm = sqrt(SDIM_dot(normal,normal));
energy += gauss2Dwt[i]*norm/2;
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{ z = 0.0;
for ( j = 0 ; j < FACET_CTRL ; j++ )
z += gpoly[i][j]*x[j][2];
u += 0.5*z*z*gauss2Dwt[i]/2*(tang[0][0]*tang[1][1] -
tang[0][1]*tang[1][0]);
}
}
skip_from_metric:
set_facet_area(f_id,energy);
if ( mode == AREA_ONLY ) return;
binary_tree_add(web.total_area_addends,energy);
/* apportion area to vertices and midpoints to scale motion */
/* Note apportionment ratios depend on equivalent test */
/* function used to get curvature; here linear used */
{ fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++, fe_id = get_next_edge(fe_id) )
{ vertex_id vv_id;
edge_id e_id = get_fe_edge(fe_id);
vv_id = get_edge_headv(e_id);
add_vertex_star(vv_id,energy);
vv_id = get_edge_midv(e_id);
add_vertex_star(vv_id,energy);
}
}
/* calculate surface energy */
energy *= get_facet_density(f_id);
/* add gravitational energy, vector potential z*z/2*k */
if ( web.gravflag && !(get_fattr(f_id) & NONCONTENT) )
{ b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
energy += u*get_body_density(b_id)*web.grav_const;
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
energy -= u*get_body_density(b_id)*web.grav_const;
}
web.total_energy = web.total_energy + energy;
} /* end facet_energy_q() */
/**********************************************************************
*
* Function: facet_volume_q()
*
* Purpose: Find triangle's contribution to volumes of neighboring bodies.
*/
void facet_volume_q(f_id)
facet_id f_id;
{
body_id b_id0,b_id1;
REAL vol = 0.0;
REAL *x[FACET_CTRL];
vertex_id v_id[FACET_CTRL];
int i,j,k;
facetedge_id fe_id;
if ( get_fattr(f_id) & NONCONTENT ) return;
b_id0 = get_facet_body(f_id);
b_id1 = get_facet_body(facet_inverse(f_id));
if ( !valid_id(b_id0) && !valid_id(b_id1) ) return;
if ( web.symmetric_content && !everything_quantities_flag )
kb_error(1038,
"Do convert_to_quantities for symmetric content for quadratic model.\n",
RECOVERABLE);
/* get control points */
fe_id = get_facet_fe(f_id);
for ( i = 0, j = 0 ; i < FACET_EDGES ; i++ )
{ v_id[j++] = get_fe_tailv(fe_id);
v_id[j++] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
for ( j = 0 ; j < FACET_CTRL ; j++ )
x[j] = get_coord(v_id[j]);
/* volume, integral of z dx dy */
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
vol += vcoeff[i][j][k]*x[i][2]*(x[j][0]*x[k][1]-x[j][1]*x[k][0]);
/* add to body volumes */
if ( valid_id(b_id0) )
add_body_volume(b_id0,vol);
if ( valid_id(b_id1) )
add_body_volume(b_id1,-vol);
} /* end facet_volume_q() */
/****************************************************************
*
* Function: film_grad_q()
*
* Purpose: Calculate volume gradients in SOAPFILM quadratic
* model.
*/
void film_grad_q()
{
body_id bi_id; /* identifier for body i */
body_id bj_id; /* identifier for body j */
facetedge_id fe_id;
facet_id f_id;
REAL g[MAXCOORD];
vertex_id v_id[FACET_CTRL];
REAL *x[FACET_CTRL];
volgrad *vgptr;
int i,j,k,n;
FOR_ALL_FACETS(f_id)
{ if ( get_fattr(f_id) & NONCONTENT ) continue;
bi_id = get_facet_body(f_id);
bj_id = get_facet_body(facet_inverse(f_id));
/* get control points */
fe_id = get_facet_fe(f_id);
for ( i = 0, j = 0 ; i < FACET_EDGES ; i++ )
{ v_id[j++] = get_fe_tailv(fe_id);
v_id[j++] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
for ( j = 0 ; j < FACET_CTRL ; j++ )
x[j] = get_coord(v_id[j]);
for ( i = 0 ; i < FACET_CTRL ; i++ )
{ g[0] = g[1] = g[2] = 0.0;
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ g[0] += vcoeff[k][i][j]*x[j][1]*x[k][2]
- vcoeff[j][k][i]*x[j][2]*x[k][1];
g[1] += vcoeff[j][k][i]*x[j][2]*x[k][0]
- vcoeff[k][i][j]*x[j][0]*x[k][2];
g[2] += vcoeff[i][j][k]*(x[j][0]*x[k][1] - x[j][1]*x[k][0]);
}
if ( valid_id(bi_id) && (get_battr(bi_id) & (PRESSURE|FIXEDVOL)) )
{ vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v_id[i]);
vgptr->bb_id = bi_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] += g[n];
}
if ( valid_id(bj_id) && (get_battr(bj_id) & (FIXEDVOL|PRESSURE)) )
{ vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v_id[i]);
vgptr->bb_id = bj_id;
for ( n = 0 ; n < SDIM ; n++ )
vgptr->grad[n] -= g[n];
}
}
}
} /* end film_grad_q() */
/*************************************************************************
*
* Function: triangle_integral()
*
* Purpose: Used by vcoeff_init() to calculate volume coefficients.
*
*/
REAL triangle_integral ARGS(( REAL(*)(REAL,REAL)));
REAL triangle_integral(f) /* on side 2 triangle, 5th degree */
#ifdef NOPROTO
REAL (*f)();
#else
REAL (*f)(REAL,REAL);
#endif
{
int i;
REAL sum = 0.0;
for ( i = 0 ; i < 7 ; i++ )
sum += gauss2Dwt5[i]*(*f)(2*gauss2Dpt5[i][0],2*gauss2Dpt5[i][1]);
return 2*sum;
}
/* Interpolation polynomials for 6 point interpolation on triangle.
Triangle is: u > 0, v > 0, u + v < 2.
Point indexing (counterclockwise):
4
5 3
0 1 2
*/
/**********************************************************************
*
* Function: intpoly6()
*
* Purpose: interpolation polynomial evaluation
*/
REAL intpoly6(k,u,v)
int k; /* polynomial number */
REAL u,v; /* evaluation point */
{
switch ( k )
{
case 0: return (1 - (u + v))*(2 - (u + v))/2.0;
case 1: return u*(2 - (u + v));
case 2: return u*(u - 1)/2.0;
case 3: return u*v;
case 4: return v*(v - 1)/2.0;
case 5: return v*(2 - (u + v));
}
/* bad index */
return 0.0;
}
/************************************************************************
*
* Function: inpoly6part()
*
* Purpose: partials of interpolation polynomials
*/
REAL intpoly6part(k,i,u,v)
int k; /* which polynomial (control point index) */
int i; /* partial number: 0 for u, 1 for v */
REAL u,v; /* evaluation point */
{
if ( i == 0 )
switch ( k )
{
case 0: return u + v - 1.5;
case 1: return 2 - 2*u - v;
case 2: return u - 0.5;
case 3: return v;
case 4: return 0.0;
case 5: return -v;
}
else if ( i == 1 )
switch ( k )
{
case 0: return u + v - 1.5;
case 1: return -u;
case 2: return 0.0;
case 3: return u;
case 4: return v - 0.5;
case 5: return 2 - u - 2*v;
}
/* bad index */
return 0.0;
}
/**********************************************************************
*
* Function: vcoeff_init()
*
* Purpose: initializing coefficients for quadratic volume calculations.
*/
/* integrand function */
static int al,be,ga;
REAL vintzf(u,v)
REAL u,v;
{
return
intpoly6(al,u,v)*intpoly6part(be,0,u,v)*intpoly6part(ga,1,u,v);
}
void vcoeff_init()
{
REAL t;
for ( al = 0 ; al < FACET_CTRL ; al++ )
for ( be = 0; be < FACET_CTRL ; be++ )
for ( ga = 0 ; ga < FACET_CTRL ; ga++ )
{ t = triangle_integral(vintzf);
/* round to nearest 90th */
t = (int)(t*90.001)/90.0;
vcoeff[al][be][ga] = t;
}
}
/*********************************************************************
**********************************************************************
Quadratic film quantities
**********************************************************************
**********************************************************************/
/*********************************************************************
Film area quantity
Uses Gaussian integration. Not known to be upper bound on area.
**********************************************************************/
/*********************************************************************
*
* Function: q_facet_tension_q()
*
* Purpose: Returns energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_q(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m;
REAL det;
REAL st,ss,tt;
REAL **tang;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
value += gauss2Dwt[m]*sqrt(det);
}
value /= 2; /* triangle factor */
if ( quantities_only_flag )
{ set_facet_area(f_info->id,value);
#ifdef SHARED_MEMORY
if ( nprocs > 1 )
proc_total_area[GET_THREAD_ID] += value;
else
#endif
binary_tree_add(web.total_area_addends,value);
}
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
value *= get_facet_density(f_info->id);
return value;
} /* end q_facet_tension_q() */
/*********************************************************************
*
* Function: q_facet_tension_grad_q()
*
* Returns gradient and energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_q_grad(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m,j,k;
REAL det,norm;
REAL st,ss,tt;
REAL density,fudge;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
density = get_facet_density(f_info->id);
else density = 1.0;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ REAL **tang = f_info->sides[m];
/* calculate tangents and det */
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
norm = sqrt(det);
value += gauss2Dwt[m]*norm/2;
/* gradients */
fudge = density*gauss2Dwt[m]/norm/2;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] += fudge*
( tang[0][j]*gpolypartial[m][0][k]*tt
- tang[0][j]*gpolypartial[m][1][k]*st
- tang[1][j]*gpolypartial[m][0][k]*st
+ tang[1][j]*gpolypartial[m][1][k]*ss);
}
return density*value;
} /* end q_facet_tnesion_grad_q() */
/*********************************************************************
*
* Function: q_facet_tension_q_hess()
*
* Purpose: Returns hessian, gradient and energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_q_hess(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m,j,jj,k,kk,p,q;
REAL det,norm;
REAL st,ss,tt;
REAL tr[FACET_CTRL][MAXCOORD]; /* traces */
MAT2D(at,2,2);
MAT2D(ainv,2,2);
MAT4D(aa,FACET_CTRL,MAXCOORD,2,2);
REAL density,fudge;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
density = get_facet_density(f_info->id);
else density = 1.0;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ REAL **tang = f_info->sides[m];
/* calculate tangents and det */
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
if ( det <= 0.0 ) continue;
norm = sqrt(det);
value += gauss2Dwt[m]*norm/2;
ainv[0][0] = tt/det;
ainv[0][1] = ainv[1][0] = -st/det;
ainv[1][1] = ss/det;
/* gradients */
fudge = density*gauss2Dwt[m]*norm/4;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
{ for ( p = 0 ; p < 2 ; p++ )
for ( q = 0 ; q < 2; q++ )
at[p][q] = tang[p][j]*gpolypartial[m][q][k] +
tang[q][j]*gpolypartial[m][p][k];
mat_mult(at,ainv,aa[k][j],2,2,2);
tr[k][j] = aa[k][j][0][0] + aa[k][j][1][1];
f_info->grad[k][j] += fudge*tr[k][j];
}
/* hessians */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
f_info->hess[k][kk][j][jj] += fudge*
( 0.5*tr[k][j]*tr[kk][jj]
- (aa[k][j][0][0]*aa[kk][jj][0][0] +
aa[k][j][0][1]*aa[kk][jj][1][0] +
aa[k][j][1][0]*aa[kk][jj][0][1] +
aa[k][j][1][1]*aa[kk][jj][1][1])
+ ( (j==jj)?
2*(gpolypartial[m][0][k]*gpolypartial[m][0][kk]*ainv[0][0]
+ gpolypartial[m][0][k]*gpolypartial[m][1][kk]*ainv[0][1]
+ gpolypartial[m][1][k]*gpolypartial[m][0][kk]*ainv[1][0]
+ gpolypartial[m][1][k]*gpolypartial[m][1][kk]*ainv[1][1])
: 0.0)
);
} /* end gauss pt loop */
return density*value;
} /* end q_facet_tension_q_hess() */
/*********************************************************************
Upper bound on facet quadratic area
Good way is to do sqrt(gaussian int of det) which gives upper
bound by Cauchy-Schwarz inequality for 7-pt integration, since
det is order 4 polynomial.
***********************************************************************/
/*********************************************************************
*
* Returns energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_uq(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m;
REAL det;
REAL st,ss,tt;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
value += gauss2Dwt[m]*det;
}
value = sqrt(value)/2;
if ( quantities_only_flag )
{ set_facet_area(f_info->id,value);
#ifdef SHARED_MEMORY
if ( nprocs > 1 )
proc_total_area[GET_THREAD_ID] += value;
else
#endif
binary_tree_add(web.total_area_addends,value);
}
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
value *= get_facet_density(f_info->id);
return value;
}
/*********************************************************************
*
* Returns gradient and energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_uq_grad(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m,j,k;
REAL det;
REAL norm;
REAL st,ss,tt;
REAL detgrad[FACET_CTRL][MAXCOORD];
REAL density = 1.0;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
density = get_facet_density(f_info->id);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
detgrad[k][j] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ REAL **tang = f_info->sides[m];
/* calculate tangents and det */
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
value += gauss2Dwt[m]*det;
/* gradients */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
detgrad[k][j] += gauss2Dwt[m]*
( tang[0][j]*gpolypartial[m][0][k]*tt
- tang[0][j]*gpolypartial[m][1][k]*st
- tang[1][j]*gpolypartial[m][0][k]*st
+ tang[1][j]*gpolypartial[m][1][k]*ss);
}
norm = density/sqrt(value*4);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = norm*detgrad[k][j];
return density*sqrt(value)/2;
}
/*********************************************************************
*
* Returns hessian, gradient and energy due to facet.
* Quadratic version.
*/
REAL q_facet_tension_uq_hess(f_info)
struct qinfo *f_info;
{
REAL value = 0.0;
int m,j,jj,k,kk,r,q;
REAL det,norm;
REAL st,ss,tt;
MAT2D(at,2,2);
MAT2D(ainv,2,2);
MAT4D(aa,FACET_CTRL,MAXCOORD,2,2);
REAL detgrad[FACET_CTRL][MAXCOORD];
REAL dethess[FACET_CTRL][FACET_CTRL][MAXCOORD][MAXCOORD];
REAL density = 1.0;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
density = get_facet_density(f_info->id);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
detgrad[k][j] = 0.0;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
dethess[k][kk][j][jj] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ ) /* integration point number */
{ REAL **p = gpolypartial[m];
REAL **tang = f_info->sides[m];
/* calculate tangents and det */
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
value += gauss2Dwt[m]*det;
ainv[0][0] = tt/det;
ainv[0][1] = ainv[1][0] = -st/det;
ainv[1][1] = ss/det;
/* gradients */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
{ for ( r = 0 ; r < 2 ; r++ )
for ( q = 0 ; q < 2; q++ )
at[r][q] = tang[r][j]*gpolypartial[m][q][k] +
tang[q][j]*gpolypartial[m][r][k];
mat_mult(at,ainv,aa[k][j],2,2,2);
detgrad[k][j] += gauss2Dwt[m]
*(p[0][k]*tang[0][j]*tt + ss*p[1][k]*tang[1][j]
- st*(p[0][k]*tang[1][j] + tang[0][j]*p[1][k]));
}
/* hessians */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ dethess[k][kk][j][jj] += gauss2Dwt[m]*
( 4*p[0][k]*tang[0][j]*tang[1][jj]*p[1][kk]
+ 4*tang[0][jj]*p[0][kk]*p[1][k]*tang[1][j]
- 2*(p[0][kk]*tang[1][jj]+tang[0][jj]*p[1][kk])
*(p[0][k]*tang[1][j]+tang[0][j]*p[1][k]));
if ( j == jj )
dethess[k][kk][j][jj] += gauss2Dwt[m]*
( 2*p[0][k]*p[0][kk]*tt + 2*ss*p[1][k]*p[1][kk]
- 2*st*(p[0][k]*p[1][kk] + p[0][kk]*p[1][k]) );
}
} /* end gauss pt loop */
/* gradients */
norm = density/sqrt(value*4);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = norm*detgrad[k][j];
/* hessians */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
f_info->hess[k][kk][j][jj] = norm*
(0.5*dethess[k][kk][j][jj] - detgrad[k][j]*detgrad[kk][jj]/value);
return density*sqrt(value)/2;
}
/**********************************************************************
Quadratic volume quantity
**********************************************************************/
/**********************************************************************
*
* function: q_facet_volume_q()
*
* purpose: value of volume integral on quadratic facet
*/
REAL q_facet_volume_q(f_info)
struct qinfo *f_info;
{
REAL vol = 0.0;
int m,i;
/* volume, integral of z dx dy */
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL **t = f_info->sides[m];
REAL z;
for ( z = 0., i = 0 ; i < FACET_CTRL ; i++ )
z += gpoly[m][i]*f_info->x[i][2];
vol += gauss2Dwt[m]*z*(t[0][0]*t[1][1]-t[0][1]*t[1][0]);
}
return vol/2;
} /* end q_facet_volume_q() */
/**********************************************************************
*
* function: q_facet_volume_q_grad()
*
* purpose: value and gradient of volume integral on quadratic facet
*/
REAL q_facet_volume_q_grad(f_info)
struct qinfo *f_info;
{
REAL vol = 0.0;
int i,j,k;
REAL **x = f_info->x;
REAL v;
/* volume, integral of z dx dy */
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ v = vcoeff[i][j][k];
if ( v == 0.0 ) continue;
vol += v*x[i][2]*(x[j][0]*x[k][1]-x[j][1]*x[k][0]);
}
/* gradients */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = 0.0;
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ v = vcoeff[i][j][k];
if ( v == 0.0 ) continue;
f_info->grad[i][2] += v*(x[j][0]*x[k][1]-x[j][1]*x[k][0]);
f_info->grad[j][0] += v*x[i][2]*x[k][1];
f_info->grad[k][1] += v*x[i][2]*x[j][0];
f_info->grad[j][1] -= v*x[i][2]*x[k][0];
f_info->grad[k][0] -= v*x[i][2]*x[j][1];
}
return vol;
} /* end q_facet_volume_grad_q() */
/**********************************************************************
*
* function: q_facet_volume_q_hess()
*
* purpose: hessian, value, and gradof volume integral on quadratic facet
*/
REAL q_facet_volume_q_hess(f_info)
struct qinfo *f_info;
{
REAL vol = 0.0;
int i,j,k;
REAL v;
REAL **x;
REAL ****h;
x = f_info->x;
/* volume, integral of z dx dy */
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
vol += vcoeff[i][j][k]*x[i][2]*(x[j][0]*x[k][1]-x[j][1]*x[k][0]);
/* gradients */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = 0.0;
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ v = vcoeff[i][j][k];
f_info->grad[i][2] += v*(x[j][0]*x[k][1]-x[j][1]*x[k][0]);
f_info->grad[j][0] += v*x[i][2]*x[k][1];
f_info->grad[k][1] += v*x[i][2]*x[j][0];
f_info->grad[j][1] -= v*x[i][2]*x[k][0];
f_info->grad[k][0] -= v*x[i][2]*x[j][1];
}
/* hessian */
h = f_info->hess;
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ v = vcoeff[i][j][k];
h[i][j][2][0] += v*x[k][1];
h[j][i][0][2] += v*x[k][1];
h[i][k][2][1] += v*x[j][0];
h[k][i][1][2] += v*x[j][0];
h[j][k][0][1] += v*x[i][2];
h[k][j][1][0] += v*x[i][2];
h[i][j][2][1] -= v*x[k][0];
h[j][i][1][2] -= v*x[k][0];
h[i][k][2][0] -= v*x[j][1];
h[k][i][0][2] -= v*x[j][1];
h[j][k][1][0] -= v*x[i][2];
h[k][j][0][1] -= v*x[i][2];
}
return vol;
} /* end q_facet_volume_q_hess() */
evolver-2.30c.dfsg/src/psgraph.c 0000644 0001753 0001753 00000065437 11410765113 017044 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: psgraph.c
*
* Purpose: PostScript output.
*/
/*******************************************************************
*
* Notes on usage.
*
* The depth sort is slowed down by having long unrefined edges.
* Example: 245760 facets only: 102 sec (starfish31.fe)
* with long bare edges: 2151 sec
* refined bare edges: 175 sec
*/
#include "include.h"
static FILE *fd;
int gridflag;
int ps_colorflag;
int crossingflag;
char ps_file_name[1000];
int ps_widthattr;
/* for redrawing edges on top of subsequent facets */
int edgeredrawflag; /* for extra drawing of edges on top of facets */
int *edgeredrawhead;
int edgeredrawcount;
int edgeredrawmax;
struct erl {double x[2]; /* edge vector */
float v[2]; /* vertex position */
int color;
int next;
int etype;
};
struct erl *edgeredrawlist;
/*****************************************************************
*
* Function: ps_init()
*
* Purpose: Get file name from user, write file header.
*/
void ps_init()
{ char response[100];
int xlo,xhi,ylo,yhi; /* int according to PostScript manual */
REAL extra;
time_t t;
REAL xsize,ysize,scale; /* for clipping box */
int dummy;
int n;
if ( (web.representation != STRING) && (gridflag < 0) )
{
prompt("Show grid lines? ",response,sizeof(response));
gridflag = (toupper(response[0]) == 'Y');
edgeredrawflag = !gridflag; /* default */
if (toupper(response[1]) == 'Y') edgeredrawflag = 1;
if (toupper(response[1]) == 'N') edgeredrawflag = 0;
}
if ( ps_colorflag < 0 )
{ prompt("Do colors? ",response,sizeof(response));
ps_colorflag = (toupper(response[0]) == 'Y');
}
if ( (web.representation == STRING) && (SDIM > 2) && (crossingflag < 0) )
{
prompt("Do crossings? ",response,sizeof(response));
crossingflag = (toupper(response[0]) == 'Y');
}
if ( labelflag < 0 )
{ prompt("Do labels? (i for ids, o for originals) ",response,sizeof(response));
switch ( toupper(response[0]) )
{ case 'I' :
case 'Y' : labelflag = LABEL_ID; break;
case 'O' : labelflag = LABEL_ORIG; break;
default : labelflag = NOLABELS;
}
}
if ( strlen(ps_file_name) == 0 )
{
prompt("Enter file name (.ps will be added): ",ps_file_name,sizeof(ps_file_name));
}
if ( (strcmp(ps_file_name+strlen(ps_file_name)-3,".ps")!=0) &&
(strcmp(ps_file_name+strlen(ps_file_name)-4,".eps")!=0) )
strcat(ps_file_name,".ps");
fd = fopen(ps_file_name,"w");
if ( fd == NULL )
{ sprintf(errmsg,"Cannot open %s.\n",ps_file_name);
ps_file_name[0] = 0;
kb_error(1649,errmsg,RECOVERABLE);
}
edgeredrawcount = 1;
edgeredrawhead = (int*)temp_calloc(web.skel[VERTEX].max_ord+5,sizeof(int));
edgeredrawmax = web.skel[EDGE].count;
edgeredrawlist = (struct erl *)temp_calloc(edgeredrawmax,sizeof(struct erl));
ps_widthattr = find_extra(PS_WIDTHNAME,&dummy);
fputs("%!PS-Adobe-3.0 EPSF-3.0\n",fd);
/* bounding box, with a little extra for line widths and labels */
extra = (labelflag>0) ? .066 : .002;
xsize = maxclipx - minclipx; ysize = maxclipy - minclipy;
if ( xsize/ysize > 8/10.5 ) scale = 8*72/xsize;
else scale = 10.5*72/ysize;
if ( full_bounding_box_flag )
{ xlo = 0;
ylo = 0;
xhi = (int)(xsize*scale);
yhi = (int)(ysize*scale);
}
else /* as defined by surface */
{ xlo = (int)floor((bbox_minx - extra - minclipx)*scale);
if ( xlo < 0 ) xlo = 0;
xhi = (int)ceil((bbox_maxx + extra - minclipx)*scale);
if ( xhi > xsize*scale ) xhi = (int)(xsize*scale);
ylo = (int)floor((bbox_miny - extra - minclipy)*scale);
if ( ylo < 0 ) ylo = 0;
yhi = (int)ceil((bbox_maxy + extra - minclipy )*scale);
if ( yhi > ysize*scale ) yhi = (int)(ysize*scale);
}
fprintf(fd,"%%%%BoundingBox: %d %d %d %d\n",xlo,ylo,xhi,yhi);
fprintf(fd,"%%%%Title: (%s)\n",ps_file_name);
fprintf(fd,"%%%%Creator: Surface Evolver\n");
time(&t);
fprintf(fd,"%%%%CreationDate: %s\n",asctime(localtime(&t)));
fprintf(fd,"%%%%EndComments\n");
fprintf(fd,"%% Image is in %g\" x %g\" box aligned lower left on paper.\n",
(DOUBLE)(xhi-xlo)/72.,(DOUBLE)(yhi-ylo)/72.);
fputs("% Change relsize to alter relative size of labels and linewidths.\n",fd);
fprintf(fd,"/relsize %f def\n",ps_labelsize);
fprintf(fd,"%f %f scale\n",(DOUBLE)scale,(DOUBLE)scale);
fprintf(fd,"%f %f translate\n",(DOUBLE)(-minclipx),(DOUBLE)(-minclipy));
fprintf(fd,"newpath %f %f moveto %f %f lineto %f %f \n",
(DOUBLE)minclipx,(DOUBLE)minclipy,(DOUBLE)maxclipx,(DOUBLE)minclipy,
(DOUBLE)maxclipx,(DOUBLE)maxclipy);
fprintf(fd," lineto %f %f lineto closepath clip\n",
(DOUBLE)minclipx,(DOUBLE)maxclipy);
fputs("1 setlinecap 1 setlinejoin\n",fd);
if ( ps_colorflag )
{ fputs("/fa { newpath setrgbcolor moveto lineto\n",fd);
fputs(" lineto closepath fill } def % filled facet without edges\n\n",fd);
fputs("/fb {setrgbcolor 6 copy newpath moveto lineto\n",fd);
fputs(" lineto closepath fill 6 2 roll 6 copy} def % filled facet with edges\n\n",fd);
fputs("/fc {setrgbcolor .001 relsize mul setlinewidth 6 2 roll 6 copy} def % outline only\n\n",fd);
fputs("/edge {relsize mul setlinewidth setrgbcolor newpath moveto lineto stroke} def\n",fd);
fputs("/arcedge {relsize mul setlinewidth setrgbcolor newpath moveto arc stroke} def\n",fd);
}
else
{ fputs("/fa { newpath setgray moveto lineto\n",fd);
fputs(" lineto closepath fill } def % filled facet without edges \n\n",fd);
fputs("/fb {setgray 6 copy newpath moveto lineto\n",fd);
fputs(" lineto closepath fill 6 2 roll 6 copy} def % filled facet with edges\n\n",fd);
fputs("/fc {setgray 0 setgray .001 relsize mul setlinewidth 6 2 roll 6 copy} def % outline only\n\n",fd);
fputs("/edge {relsize mul setlinewidth 0 setgray newpath moveto lineto stroke} def\n",fd);
fputs("/arcedge {relsize mul setlinewidth 0 setgray newpath moveto arc stroke} def\n",fd);
}
if ( labelflag>0 )
{
fputs("/vorad .022 relsize mul def\n",fd);
fputs("/arrowrad vorad def\n",fd);
if ( ps_colorflag )
fputs("/edge { relsize mul setlinewidth setrgbcolor 4 copy newpath",fd);
else
fputs("/edge { relsize mul setlinewidth 0 setgray 4 copy newpath",fd);
fputs(" moveto lineto stroke\n",fd);
fputs(" /y2 exch def /x2 exch def /y1 exch def /x1 exch def\n",fd);
fputs(" /dy y2 y1 sub def /dx x2 x1 sub def\n",fd);
fputs(" /mag dx dx mul dy dy mul add sqrt def\n",fd);
fputs(" mag 0 ne { \n",fd);
fputs(" /xu dx mag div def /yu dy mag div def\n",fd);
fputs(" /angle xu yu neg atan def\n",fd);
fputs(" newpath x2 xu vorad mul sub y2 yu vorad mul sub moveto\n",fd);
fputs(" x2 xu vorad mul sub arrowrad yu mul add\n",fd);
fputs(" y2 yu vorad mul sub arrowrad xu mul sub\n",fd);
fputs(" arrowrad angle angle 45 add arc\n",fd);
fputs(" stroke\n",fd);
fputs(" newpath x2 xu vorad mul sub y2 yu vorad mul sub moveto\n",fd);
fputs(" x2 xu vorad mul sub arrowrad yu mul sub\n",fd);
fputs(" y2 yu vorad mul sub arrowrad xu mul add\n",fd);
fputs(" arrowrad angle 180 sub angle 225 sub arcn\n",fd);
fputs(" stroke\n",fd);
fputs(" } if \n",fd);
fputs(" } def\n",fd);
fputs("/Helvetica findfont .03 scalefont setfont\n",fd);
for ( n = 1 ; n <= 5 ; n++ )
{ fprintf(fd,"/vertex%d { gsave translate relsize relsize scale\n",n);
fprintf(fd," newpath 0 setgray 0 0 .022 0 360 arc fill\n");
fprintf(fd," newpath 1 setgray 0 0 .020 0 360 arc fill\n");
if ( n > 2 )
fprintf(fd," 2 %d div 2 %d div scale\n",n,n);
fprintf(fd," %6.4f -.01 moveto 0 setgray show grestore } def\n",
.004-.01*n);
fprintf(fd,"/edgenum%d { gsave translate relsize relsize scale\n",n);
fprintf(fd," newpath %5.3f -.016 moveto\n",-(.008+.004*n));
fprintf(fd," 0 setgray %5.3f 0 rlineto 0 .032 rlineto %6.3f 0\n",
0.022+.013*n,-(0.022+0.013*n));
fprintf(fd," rlineto fill newpath %5.3f -.014 moveto\n",-(.0078+.004*n));
fprintf(fd," 1 setgray %5.3f 0 rlineto 0 .03 rlineto %6.3f 0\n",
0.020+.013*n,-(0.020+.013*n));
fprintf(fd,
" rlineto fill 0 setgray %6.3f -.01 moveto show grestore } def\n",
0.001-0.006*n);
fprintf(fd,"/facenum%d { gsave translate relsize relsize scale\n",n);
fputs(" newpath 1 setgray -.02 -.015 moveto\n",fd);
fprintf(fd," %5.3f 0 rlineto 0 .03 rlineto %5.3f 0 rlineto fill 0 setgray \n",(n+1)*0.025,-(n+1)*0.025);
fputs(" newpath -.019 -.01 moveto show grestore } def \n",fd);
}
}
fprintf(fd,"/ew {%7.5f edge} def %% normal string edge width\n",
ps_stringwidth);
fprintf(fd,"/fw {%7.5f edge} def %% fixed edge width\n",
ps_fixededgewidth);
fprintf(fd,"/tw {%7.5f edge} def %% triple edge width\n",ps_tripleedgewidth);
fprintf(fd,"/ww {%7.5f edge} def %% edges on walls\n",ps_conedgewidth);
fprintf(fd,"/bw {%7.5f edge} def %% bare edge width\n",ps_bareedgewidth);
fprintf(fd,"/gw {%7.5f edge} def %% grid edge width\n",ps_gridedgewidth);
fprintf(fd,"/no {pop pop pop pop} def %% no edge \n");
if (crossingflag > 0) /* redefine edge and gw */
{
if ( ps_colorflag )
fputs("/edge { 8 copy .002 add relsize mul setlinewidth 0 setlinecap 1 setgray pop pop pop\n",fd);
else
fputs("/edge { 5 copy .002 add relsize mul setlinewidth 0 setlinecap 1 setgray\n",fd);
fputs(" newpath moveto lineto stroke setlinewidth 2 setlinecap\n",fd);
if ( ps_colorflag )
fputs(" setrgbcolor newpath moveto lineto stroke} def\n",fd);
else
fputs(" 0 setgray newpath moveto lineto stroke} def\n",fd);
fputs("/gw {0.002 edge} def\n",fd);
}
}
/************************************************************
*
* Function: ps_edge()
*
* Purpose: Graphs one edge, already transformed.
*/
void ps_edge(t)
struct tsort *t;
{ int i;
if ( t->color == CLEAR ) return;
if ( t->flag & EDGE_ARC )
{ REAL w1[MAXCOORD],w2[MAXCOORD],mag1,mag2,w1w2,center[2],radius;
REAL angle1,angle2,det;
for (i = 0 ; i < SDIM ; i++ )
{ w1[i] = t->x[1][i] - t->x[0][i];
w2[i] = t->x[2][i] - t->x[0][i];
}
det = w1[0]*w2[1] - w1[1]*w2[0];
mag1 = SDIM_dot(w1,w1); mag2 = SDIM_dot(w2,w2);
w1w2 = w1[0]*w2[0] + w1[1]*w2[1];
if ( 4000*det*det <= mag1*mag1*mag2 + mag1*mag2*mag2 - 2*mag1*w1w2*mag2 )
{ /* practically straight line */
for ( i = 0 ; i < SDIM ; i++ )
t->x[1][i] = t->x[2][i];
fprintf(fd," %7.4f %7.4f ",(DOUBLE)t->x[0][0],(DOUBLE)t->x[0][1]);
fprintf(fd," %7.4f %7.4f ",(DOUBLE)t->x[1][0],(DOUBLE)t->x[1][1]);
t->flag &= ~EDGE_ARC;
}
else
{ /* circle */
center[0] = t->x[0][0] + 0.5*(w2[1]*mag1 - w1[1]*mag2)/det;
center[1] = t->x[0][1] + 0.5*(-w2[0]*mag1 + w1[0]*mag2)/det;
radius = sqrt((mag1*mag1*mag2+mag1*mag2*mag2-2*mag1*w1w2*mag2)/4/det/det);
angle1 = 180/M_PI*atan2(t->x[0][1]-center[1],t->x[0][0]-center[0]);
angle2 = 180/M_PI*atan2(t->x[2][1]-center[1],t->x[2][0]-center[0]);
if ( det > 0 )
{ fprintf(fd," %7.4f %7.4f %7.4f %7.4f %7.4f %7.4f %7.4f ",
center[0],center[1],
radius,angle1,angle2,(DOUBLE)t->x[0][0],(DOUBLE)t->x[0][1]);
} else
{ fprintf(fd," %7.4f %7.4f %7.4f %7.4f %7.4f %7.4f %7.4f ",
center[0],center[1],
radius,angle2,angle1,(DOUBLE)t->x[2][0],(DOUBLE)t->x[2][1]);
}
}
}
/*
else if ( t->flag & SPHERE_ARC )
{
}
*/
else
{
fprintf(fd," %7.4f %7.4f ",(DOUBLE)t->x[0][0],(DOUBLE)t->x[0][1]);
fprintf(fd," %7.4f %7.4f ",(DOUBLE)t->x[1][0],(DOUBLE)t->x[1][1]);
}
/* orientation for arrow label */
if ( labelflag && (t->etype[0] & LABEL_REVERSED) )
fprintf(fd," 4 2 roll ");
/* color, if wanted */
if ( ps_colorflag > 0 )
for ( i = 0 ; i < 3 ; i++ )
fprintf(fd," %5.3f",(DOUBLE)rgb_colors[t->color][i]);
/* width of edge */
if ( t->flag & EDGE_ARC )
{ if ( ps_widthattr >= 0 )
fprintf(fd," %5.3f arcedge ",*EREAL(t->f_id,ps_widthattr));
else fprintf(fd," %5.3f arcedge\n",ps_stringwidth);
}
else
{
if ( ps_widthattr >= 0 )
fprintf(fd," %5.3f edge ",*EREAL(t->f_id,ps_widthattr));
else if ( web.representation == STRING ) fprintf(fd," ew\n");
else if ( t->etype[0] & BARE_EDGE ) fprintf(fd," bw\n");
else if ( t->etype[0] & FIXED_EDGE ) fprintf(fd," fw\n");
else if ( t->etype[0] & CONSTRAINT_EDGE ) fprintf(fd," ww\n");
else if ( t->etype[0] & BOUNDARY_EDGE ) fprintf(fd," ww\n");
else if ( t->etype[0] & SINGLE_EDGE ) fprintf(fd," ww\n");
else if ( t->etype[0] & TRIPLE_EDGE ) fprintf(fd," tw\n");
else fprintf(fd," gw\n"); /* regular grid interior edge */
}
if ( labelflag>0 )
{ char *hv=NULL,*tv=NULL,*en=NULL;
switch ( labelflag )
{ case LABEL_ID:
{ hv = ELNAME(get_edge_headv(t->f_id));
tv = ELNAME1(get_edge_tailv(t->f_id));
en = ELNAME2(t->f_id);
break;
}
case LABEL_ORIG:
{
hv = ELNAME(get_original(get_edge_headv(t->f_id)));
tv = ELNAME1(get_original(get_edge_tailv(t->f_id)));
en = ELNAME2(get_original(t->f_id));
break;
}
}
if ( strlen(tv) > 5 ) tv[5] = 0;
if ( strlen(hv) > 5 ) hv[5] = 0;
if ( strlen(en) > 5 ) en[5] = 0; /* max 5 chars in labels */
if ( (t->flag & LABEL_TAIL) && (strlen(tv) > 0) )
fprintf(fd," (%s) %f %f vertex%1d\n",tv,
(DOUBLE)t->x[0][0],(DOUBLE)t->x[0][1],strlen(tv));
if ( (t->flag & LABEL_HEAD) && (strlen(hv) > 0) )
fprintf(fd," (%s) %f %f vertex%1d\n",hv,
(DOUBLE)t->x[1][0],(DOUBLE)t->x[1][1],strlen(hv));
if ( (t->flag & LABEL_EDGE) && (strlen(en) > 0) )
{ if ( inverted(t->f_id) )
fprintf(fd," (%s) %f %f edgenum%1d\n",en,
(DOUBLE)((3*t->x[0][0]+2*t->x[1][0])/5),
(DOUBLE)(3*t->x[0][1]+2*t->x[1][1])/5,strlen(en));
else
fprintf(fd," (%s) %f %f edgenum%1d\n",en,
(DOUBLE)((2*t->x[0][0]+3*t->x[1][0])/5),
(DOUBLE)(2*t->x[0][1]+3*t->x[1][1])/5,strlen(en));
}
}
}
/***************************************************************************
*
* Function: ps_facet()
*
* Purpose: Graphs one facet, already transformed.
*/
void ps_facet(t)
struct tsort *t;
{ int i,j;
char line[200];
char *ptr = line;
int do_flag = 0; /* whether to actually print this line */
/* paint facet */
/* if ( (t->color != CLEAR) && (t->color != UNSHOWN) ) */
{ REAL gray;
REAL denom;
denom = sqrt(dotf(t->normal,t->normal,3));
if ( denom == 0.0 ) return;
sprintf(ptr," %7.4f %7.4f",(DOUBLE)t->x[0][0],(DOUBLE)t->x[0][1]);
ptr+=strlen(ptr);
sprintf(ptr," %7.4f %7.4f",(DOUBLE)t->x[1][0],(DOUBLE)t->x[1][1]);
ptr+=strlen(ptr);
sprintf(ptr," %7.4f %7.4f",(DOUBLE)t->x[2][0],(DOUBLE)t->x[2][1]);
ptr+=strlen(ptr);
if ( shading_flag )
gray = gray_level(t->normal);
else gray = 1.0;
if ( ps_colorflag > 0 )
{ int c = t->color;
if ( facet_rgb_color_attr > 0 )
sprintf(ptr," %5.3f %5.3f %5.3f ",((c>>24)&0xFF)/255.*gray,
((c>>16)&0xFF)/255.*gray, ((c>>8)&0xFF)/255.*gray);
else
for ( i = 0 ; i < 3 ; i++ )
{ sprintf(ptr," %5.3f",
(DOUBLE)(rgb_colors[t->color>=0?t->color:0][i]*gray));
ptr+=strlen(ptr);
}
}
else
{ sprintf(ptr," %f ",(DOUBLE)gray); ptr += strlen(ptr); }
}
if ( web.hide_flag && (t->color != CLEAR) && (t->color != UNSHOWN) )
{ strcat(ptr," fb "); do_flag = 1; }
else
strcat(ptr," fc ");
/* designated edges */
for ( i = 0 ; i < FACET_VERTS ; i++ )
if ( (t->ecolor[i] == CLEAR) ||
(((gridflag<=0) || (t->color==UNSHOWN)) &&
((t->etype[i]&EBITS) == INVISIBLE_EDGE) )
|| ((t->etype[i]&EBITS) & SPLITTING_EDGE) )
strcat(ptr," no");
else
{ int ii;
do_flag = 1;
/* see if need to reverse edge for arrow labelling */
if ( labelflag && (t->etype[i] & LABEL_REVERSED) )
strcat(line," 4 2 roll ");
if ( ps_colorflag > 0 )
{ int c = t->ecolor[i]>=0 ? t->ecolor[i] : 0;
strcat(ptr,"\n "); ptr += strlen(ptr);
if ( edge_rgb_color_attr > 0 )
sprintf(ptr," %5.3f %5.3f %5.3f ",((c>>24)&0xFF)/255.,
((c>>16)&0xFF)/255., ((c>>8)&0xFF)/255.);
else for ( j = 0 ; j < 3 ; j++ )
{ sprintf(ptr," %5.3f",(DOUBLE)rgb_colors[c][j]);
ptr += strlen(ptr);
}
}
/* width of edge, in descending order of thickness */
ii = (i==2)?0:(i+1);
if ( (t->x[ii][0]-t->x[i][0])*(t->x[ii][0]-t->x[i][0]) +
(t->x[ii][1]-t->x[i][1])*(t->x[ii][1]-t->x[i][1]) < 1e-10 )
strcat(line," no");
else if ( (ps_widthattr >= 0) && valid_id(t->f_id) )
{ facetedge_id fe = get_facet_fe(t->f_id);
for ( j = 0 ; j < i ; j++ ) fe = get_next_edge(fe);
sprintf(line+strlen(line)," %7.5f edge ",
*EREAL(get_fe_edge(fe),ps_widthattr));
}
else if ( t->etype[i] & BARE_EDGE ) strcat(line," bw");
else if ( t->etype[i] & FIXED_EDGE ) strcat(line," fw");
else if ( t->etype[i] & CONSTRAINT_EDGE ) strcat(line," ww");
else if ( t->etype[i] & BOUNDARY_EDGE ) strcat(line," ww");
else if ( t->etype[i] & SINGLE_EDGE ) strcat(line," ww");
else if ( t->etype[i] & TRIPLE_EDGE ) strcat(line," tw");
else strcat(line," gw"); /* regular grid interior edge */
}
strcat(line,"\n");
if ( do_flag ) fputs(line,fd);
/* draw previous edge fragments */
if ( edgeredrawflag )
{
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vertex_id v_id = t->v_id[i];
if ( valid_id(v_id) )
{ int erlp = edgeredrawhead[loc_ordinal(v_id)];
for ( ; erlp != 0 ; erlp = edgeredrawlist[erlp].next )
{ struct erl *ep = edgeredrawlist + erlp;
if ( fabs(t->x[i][0]-ep->v[0])+fabs(t->x[i][1]-ep->v[1]) > .00001 )
continue;
if ( ep->x[0]*ep->x[0] + ep->x[1]*ep->x[1] < (labelflag?0.01:1e-10) )
continue;
if ( ps_colorflag > 0 )
{ int c = ep->color;
if ( edge_rgb_color_attr > 0 )
sprintf(line,"%10.6f %10.6f %10.6f %10.6f %5.3f %5.3f %5.3f ",
t->x[i][0],t->x[i][1],t->x[i][0]+ep->x[0],t->x[i][1]+ep->x[1],
((c>>24)&0xFF)/255., ((c>>16)&0xFF)/255., ((c>>8)&0xFF)/255.);
else
sprintf(line,"%10.6f %10.6f %10.6f %10.6f %5.3f %5.3f %5.3f ",
t->x[i][0],t->x[i][1],t->x[i][0]+ep->x[0],t->x[i][1]+ep->x[1],
(DOUBLE)rgb_colors[c][0],(DOUBLE)rgb_colors[c][1],
(DOUBLE)rgb_colors[c][2]);
}
else
sprintf(line,"%10.6f %10.6f %10.6f %10.6f ", t->x[i][0],
t->x[i][1],t->x[i][0]+ep->x[0],t->x[i][1]+ep->x[1]);
/* see if need to reverse edge for arrow labelling */
if ( labelflag && (ep->etype & LABEL_REVERSED) )
strcat(line," 4 2 roll ");
if ( ep->etype & BARE_EDGE ) strcat(line," bw");
else if ( ep->etype & FIXED_EDGE ) strcat(line," fw");
else if ( ep->etype & CONSTRAINT_EDGE ) strcat(line," ww");
else if ( ep->etype & BOUNDARY_EDGE ) strcat(line," ww");
else if ( ep->etype & SINGLE_EDGE ) strcat(line," ww");
else if ( ep->etype & TRIPLE_EDGE ) strcat(line," tw");
else strcat(line," gw"); /* regular grid interior edge */
fputs(line,fd);
fputs("\n",fd);
}
}
}
}
/* save edge end fragments for later redrawing on top of later facets
for smoother edge line */
if ( edgeredrawflag )
{
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vertex_id v_id;
double len,fudge;
int ii = i >= FACET_VERTS-1 ? 0 : i+1;
if ( (t->ecolor[i] == CLEAR) ||
(((gridflag<=0) || (t->color==UNSHOWN)) &&
((t->etype[i]&EBITS) == INVISIBLE_EDGE) )
|| ((t->etype[i]&EBITS) & SPLITTING_EDGE) )
continue;
len = sqrt((t->x[ii][0]-t->x[i][0])*(t->x[ii][0]-t->x[i][0]) +
(t->x[ii][1]-t->x[i][1])*(t->x[ii][1]-t->x[i][1]));
fudge = (len > .005) ? .005/len : 1.0; /* max length .005 */
if ( edgeredrawcount > edgeredrawmax-2 )
{ edgeredrawlist = (struct erl *)temp_realloc((char*)edgeredrawlist,
2*edgeredrawmax*sizeof(struct erl));
edgeredrawmax *= 2;
}
v_id = t->v_id[i];
if ( valid_id(v_id) )
{ int didflag = 0,erlp;
for ( erlp = edgeredrawhead[loc_ordinal(v_id)] ; erlp ;
erlp = edgeredrawlist[erlp].next )
{ struct erl *ep = edgeredrawlist + erlp;
if ( fabs(t->x[i][0]-ep->v[0])+fabs(t->x[i][1]-ep->v[1])
+ fabs(ep->x[0]-fudge*(t->x[ii][0]-t->x[i][0]))
+ fabs(ep->x[1]-fudge*(t->x[ii][1]-t->x[i][1])) < .0001 )
{ didflag = 1; break; }
}
if ( didflag == 0 )
{
edgeredrawlist[edgeredrawcount].x[0] = fudge*(t->x[ii][0]-t->x[i][0]);
edgeredrawlist[edgeredrawcount].x[1] = fudge*(t->x[ii][1]-t->x[i][1]);
edgeredrawlist[edgeredrawcount].v[0] = t->x[i][0];
edgeredrawlist[edgeredrawcount].v[1] = t->x[i][1];
edgeredrawlist[edgeredrawcount].next = edgeredrawhead[loc_ordinal(v_id)];
edgeredrawlist[edgeredrawcount].etype = t->etype[i];
edgeredrawlist[edgeredrawcount].color = t->ecolor[i];
edgeredrawhead[loc_ordinal(v_id)] = edgeredrawcount;
edgeredrawcount++;
}
}
v_id = t->v_id[ii];
if ( valid_id(v_id) )
{ int didflag = 0,erlp;
for ( erlp = edgeredrawhead[loc_ordinal(v_id)] ; erlp ;
erlp = edgeredrawlist[erlp].next )
{ struct erl *ep = edgeredrawlist + erlp;
if ( fabs(t->x[ii][0]-ep->v[0])+fabs(t->x[ii][1]-ep->v[1])
+ fabs(ep->x[0]-fudge*(t->x[i][0]-t->x[ii][0]))
+ fabs(ep->x[1]-fudge*(t->x[i][1]-t->x[ii][1])) < .0001 )
{ didflag = 1; break; }
}
if ( didflag == 0 )
{
edgeredrawlist[edgeredrawcount].x[0] = fudge*(t->x[i][0]-t->x[ii][0]);
edgeredrawlist[edgeredrawcount].x[1] = fudge*(t->x[i][1]-t->x[ii][1]);
edgeredrawlist[edgeredrawcount].v[0] = t->x[ii][0];
edgeredrawlist[edgeredrawcount].v[1] = t->x[ii][1];
edgeredrawlist[edgeredrawcount].next = edgeredrawhead[loc_ordinal(v_id)];
edgeredrawlist[edgeredrawcount].etype = t->etype[i];
edgeredrawlist[edgeredrawcount].color = t->ecolor[i];
edgeredrawhead[loc_ordinal(v_id)] = edgeredrawcount;
edgeredrawcount++;
}
}
}
}
if ( labelflag>0 )
{ facetedge_id fe;
char * fn=NULL;
switch ( labelflag )
{ case LABEL_ID:
fn = ELNAME(t->f_id);
break;
case LABEL_ORIG:
fn = ELNAME(get_original(t->f_id));
break;
}
if ( fn ) fn[5] = 0;
if ( (t->color != CLEAR) && (t->color != UNSHOWN) && (t->flag&LABEL_FACET) )
if ( strlen(fn) > 0 )
fprintf(fd," (%c%s) %f %f facenum%d\n",
(t->flag&FLIPPED_FACET)?'+':'-',fn,
(DOUBLE)(t->x[0][0]+t->x[1][0]+t->x[2][0])/3,
(DOUBLE)(t->x[0][1]+t->x[1][1]+t->x[2][1])/3,strlen(fn));
fe = get_facet_fe(t->f_id);
if ( valid_id(fe) )
for ( i = 0 ; i < FACET_EDGES ; i++ , fe = get_next_edge(fe) )
{ edge_id e_id = get_fe_edge(fe);
char *tv=NULL,*hv=NULL;
char *en=NULL;
REAL a;
int ii,jj,kk;
if ( t->flag & FLIPPED_FACET )
{ kk = 2 - i; ii = (3-i)%3 ; jj = (5-i)%3; }
else { kk = i; ii = i; jj = (i+1)%3; }
if (t->ecolor[kk] == CLEAR) continue;
if ( (gridflag<0) && (((t->etype[kk]&EBITS) == INVISIBLE_EDGE)
|| (t->etype[kk] & SPLITTING_EDGE)))
continue;
switch ( labelflag )
{ case LABEL_ID:
{ tv = ELNAME(get_edge_tailv(e_id));
hv = ELNAME1(get_edge_headv(e_id));
en = ELNAME2(e_id);
break;
}
case LABEL_ORIG:
{
tv = ELNAME(get_original(get_edge_tailv(e_id)));
hv = ELNAME1(get_original(get_edge_headv(e_id)));
en = ELNAME2(get_original(e_id));
break;
}
}
if ( strlen(tv) > 5 ) tv[5] = 0;
if ( strlen(hv) > 5 ) hv[5] = 0;
if ( strlen(en) > 5 ) en[5] = 0; /* max 5 chars in labels */
if ( tv && (strlen(tv) > 0) )
fprintf(fd,"(%s) %f %f vertex%1d\n",tv,(DOUBLE)t->x[ii][0],
(DOUBLE)t->x[ii][1],strlen(tv));
if ( hv && (strlen(hv) > 0) )
fprintf(fd,"(%s) %f %f vertex%1d\n",hv,(DOUBLE)t->x[jj][0],
(DOUBLE)t->x[jj][1],strlen(hv));
a = .35;
if ( en && (strlen(en) > 0) )
{
if ( inverted(e_id) )
fprintf(fd," (%s) %f %f edgenum%1d\n",en,
(DOUBLE)((1-a)*t->x[ii][0]+a*t->x[jj][0]),
(DOUBLE)((1-a)*t->x[ii][1]+a*t->x[jj][1]),strlen(en));
else
fprintf(fd," (%s) %f %f edgenum%1d\n",en,
(DOUBLE)(a*t->x[ii][0]+(1-a)*t->x[jj][0]),
(DOUBLE)(a*t->x[ii][1]+(1-a)*t->x[jj][1]),strlen(en));
}
}
}
}
/*************************************************************
*
* Function: ps_finish()
*
* Purpose: End PostScript output.
*/
void ps_finish()
{ int i;
/* do text */
fputs("\n/Helvetica findfont .10 scalefont setfont\n",fd);
fputs("0 setgray\n",fd);
for ( i = 0 ; i < MAXTEXTS ; i++ )
{
REAL xspot = -1.4+2.8*text_chunks[i].start_x;
REAL yspot = -1.4+2.8*text_chunks[i].start_y;
if ( text_chunks[i].text )
{ char *c;
fprintf(fd,"%f %f moveto (",xspot,yspot);
for ( c = text_chunks[i].text ; *c ; c++ )
{ if ( *c == '\n' )
{ fprintf(fd,") show\n");
yspot -= .10;
fprintf(fd,"%f %f moveto (",xspot,yspot);
}
else
fprintf(fd,"%c",*c);
}
fprintf(fd,") show\n");
}
}
fputs("\nshowpage\n\n",fd);
fputs("%%EOF\n",fd);
fclose(fd);
ps_file_name[0] = 0;
temp_free((char*)edgeredrawhead);
temp_free((char*)edgeredrawlist);
}
evolver-2.30c.dfsg/src/command.yac 0000644 0001753 0001753 00000452326 11410765113 017345 0 ustar hazelsct hazelsct
/*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* File: command.yac
* YACC specification for expression and command parser for evolver.
* Does algebraic form of expressions and builds parse tree
* Accepts longest complete expression, so coordinates can
* be listed as expressions on same line
*/
/* Notes:
vcommand denotes commands that can be recognized as such from their
first token; only such commands can be assigned to procedure
variables.
backquotes used to surround commands at start of comma-separated
expression list.
On semicolons: Semicolons are command separators and optional
command terminators. Note that 'command' by itself does
not have a terminating semicolon. Semicolons are therefore
associated with the outermost part of a nested command, so
don't work inside if-then. Blocks in { } are commands in
order to work inside structured commands, so need semicolon
separator afterwards.
*/
%{
#include "include.h"
#include "lex.h"
#define YYSTYPE yystype
#define gettxt(a,b) (b)
#define yylex kb_yylex
int assignbacktrack ARGS((void));
#ifndef __GNUC__
#ifdef YYBISON
/* for Bison */
#ifndef __yy_memcpy
static void __yy_memcpy ARGS((char *, char *, int ));
#endif
#endif
#endif
/* for bison version 2.1 output */
#define __STDC__ 1
/* for non-ANSI compilers */
#define const
#ifndef NO_YACC_DEBUG
#define YYDEBUG 1
#endif
int help_flag; /* avoid error message while doing help */
/* Backtrack to previous := in inputbuffer */
int assignbacktrack ()
{ int spot;
for ( spot = inputbufferspot - 1; spot > 0 ; spot-- )
if ( inputbuffer[spot-1] == ':' && inputbuffer[spot] == '=' )
return spot+1;
return 0;
}
%}
%pure_parser
%token EXPRESSION_START_ COMMAND_START_ HISTORY_ GEOMVIEW_ VIEW_MATRIX_
%token LEAD_INTEGER_ INTEGER_ REAL_ SIGNED_NUMBER_ NEWIDENT_ REDEFINE_
%token MATHFUNC_ MATHFUNC2_ POW_ USERFUNC_ MIDV_ DATAFILENAME_ LOGFILE_
%token PI_ E_ G_ PARAM_ SYMBOL_ TOTAL_ EXTRA_ATTRIBUTE_ FIXEDVOL_
%token IDENT_ UMINUS_ SHELL_ COLOR_ HESSIAN_ VOLCONST_ TORUS_PERIODS_
%token VERTICES_ EDGES_ FACETS_ BODIES_ HESSIAN_MENU_ POSTSCRIPT_
%token LENGTH_ AREA_ VOLUME_ ID_ OID_ TAG_ ORIGINAL_ FACETEDGES_ WRAP_
%token QUOTATION_ UNSET_ TOPINFO_ OPACITY_ VALENCE_ HESSIAN_SADDLE_
%token SET_ FIXED_ DENSITY_ PRESSURE_ CONSTRAINT_ COORD_ DISSOLVE_
%token WHERE_ LIST_ SHOW_ DELETE_ REFINE_ RECALC_ SHOWQ_ EDGESWAP_
%token FIX_ UNFIX_ TOGGLENAME_ TOGGLEVALUE_ STAR_ QUANTITY_NAME_ PAUSE_
%token GO_ SHOW_VOL_ CHECK_ READ_ ZOOM_ ON_ OFF_ GEOMPIPE_ SELF_
%token SINGLE_LETTER_ LONG_JIGGLE_ RAW_VERAVG_ COUNTS_ CHDIR_
%token ALICE_ STABILITY_TEST_ DEFINE_ UPLUS_ DATATYPE_ FLUSH_COUNTS_
%token AUTOCHOP_ UTEST_ ATTRIBUTE_ RITZ_ MOVE_ VERTEXNORMAL_ POP_
%token SYSTEM_ TETRA_POINT_ TRIPLE_POINT_ LANCZOS_ EIGENPROBE_ EXEC_
%token AREAWEED_ EDGEWEED_ GRAVITY_ EDGEDIVIDE_ LINEAR_ QUADRATIC_
%token DIFFUSION_ EXTRAPOLATE_ TRANSFORM_DEPTH_ PRINTF_ ERRPRINTF_
%token PRINT_ MAX_ MIN_ COUNT_ SUM_ AVG_ BREAK_ CONTINUE_ SIZEOF_
%token TRANSFORM_EXPR_ BARE_ BOTTOMINFO_ METIS_ KMETIS_ KEYLOGFILE_
%token SCALE_ BURCHARD_ REBODY_ BOUNDARY_ ORIENTATION_ OMETIS_
%token SQ_MEAN_CURV_ FRONTCOLOR_ SINGLE_REDEFD_ METHOD_NAME_ TASK_EXEC_
%token RAWEST_VERAVG_ SINGLE_LETTER_ARG_ BACKCOLOR_ LAGRANGE_ RETURN_
%token TRANSFORM_EXPR_VERB_ OOGLFILE_ PARALLEL_EXEC_ BINARY_OFF_FILE_
%token SPRINTF_ CONVERT_TO_QUANTS_ METIS_FACTOR_ FUNCTION_ EXPRINT_
%token DIHEDRAL_ WRAP_VERTEX_ ARRAYIDENT_ DATE_AND_TIME_ LOCAL_
%token SHOW_EXPR_ SHOW_TRANS_ AXIAL_POINT_ ENERGY_ CONSERVED_ INFO_ONLY_
%token ASSIGN_ PROCEDURE_ FOREACH_ STRINGGLOBAL_ EQUIANGULATE_
%token HISTOGRAM_ LOGHISTOGRAM_ AREA_FIXED_ QUIT_ WARNING_MESSAGES_
%token IF_ WHILE_ DO_ NO_REFINE_ STRING_ NONCONTENT_ FOR_ HIT_PARTNER_
%token FRONTBODY_ BACKBODY_ COLORFILE_ PERM_STRINGGLOBAL_ FUNCTION_IDENT_
%token THICKEN_ COLORMAP_ REDIRECT_ NEWVERTEX_ NEWEDGE_ NEWFACET_
%token MODULUS_ TARGET_ VALUE_ INVERSE_PERIODS_ NEWBODY_ DELTA_
%token GAP_CONSTANT_ DUMP_ NOTCH_ QUANTITY_ LOAD_ PERM_PROCEDURE_
%token PROCEDURE_WORD_ DYNAMIC_LOAD_FUNC_ PERM_IDENT_ PERMLOAD_
%token HELP_ VERTEX_AVERAGE_ METHOD_INSTANCE_ RAW_VERTEX_AVERAGE_
%token OPTIMIZE_ REDIRECTOVER_ TOLERANCE_ RAWEST_VERTEX_AVERAGE_
%token JIGGLE_ VIEW_TRANSFORMS_ CLOSE_SHOW_ IS_DEFINED_ NODISPLAY_
%token PERM_ASSIGN_ PHASE_ VIEW_TRANSFORM_SWAP_COLORS_ BACKQUOTE_COMMA_
%token INTERNAL_VARIABLE_ DIRICHLET_ SOBOLEV_ VIEW_TRANSFORM_PARITY_
%token SOBOLEV_SEEK_ DIRICHLET_SEEK_ HESSIAN_SEEK_ REORDER_STORAGE_
%token RENUMBER_ALL_ CONSTRAINT_NAME_ BOUNDARY_NAME_ PROCEDURE_IDENT_
%token POP_TRI_TO_EDGE_ POP_EDGE_TO_TRI_ POP_QUAD_TO_QUAD_ SHOWVERB_
%token PROCEDURES_ MPI_TASK_ATTR_ T1_EDGESWAP_ MERGE_EDGE_ MERGE_FACET_
%token MERGE_VERTEX_ RESET_COUNTS_ VALID_ELEMENT_ MID_EDGE_ MID_FACET_
%token GO_COUNT_ ELEMENT_IDENT_ BODY_METIS_ REVERSE_ORIENTATION_
%token MATRIX_MULTIPLY_ MATRIX_INVERSE_ BINARY_PRINTF_ DUMP_MEMLIST_
%token FREE_DISCARDS_ REPARTITION_ METIS_READJUST_ MEAN_CURVATURE_
%token GLOBAL_ LEAD_INTEGER_AT_ INTEGER_AT_ MATRIX_DETERMINANT_
%token SUBCOMMAND_ ABORT_ BREAKPOINT_ WHEREAMI_ ADDLOAD_ SIMPLEX_TO_FE_
%token DISPLAY_TEXT_ DELETE_TEXT_ SUPPRESS_WARNING_ UNSUPPRESS_WARNING_
%token RESET_PROFILING_ VALID_CONSTRAINT_ VALID_BOUNDARY_
%token ARRAY_ATTRIBUTE_ PROFILING_
%token ',' '.' ';' '[' ']' '{' '}' '(' ')' '`'
%start whole
%right PERM_ASSIGN_ ASSIGN_ ASSIGNOP_
%left PIPE_
%nonassoc THEN_
%nonassoc ELSE_
%left '='
%right '?' ':'
%left OR_
%left AND_
%right NOT_
%right EQ_ '>' '<' LE_ GE_ NE_
%nonassoc ON_CONSTRAINT_
%nonassoc HIT_CONSTRAINT_
%nonassoc ON_BOUNDARY_
%nonassoc ON_QUANTITY_
%nonassoc ON_METHOD_INSTANCE_
%left '+' '-'
%left '*' '/' '%' IMOD_ IDIV_ DOT_
%nonassoc UMINUS_ UPLUS_
%left '^'
%nonassoc EPRINT_
%%
/* pseudo-variable values are node indices in node list */
/**************************************************************************/
whole : COMMAND_START_ /* empty line */
whole : COMMAND_START_
{ begin_local_scope(); } commandline { end_local_scope(); }
commandline : commands { $$.i = makenode(CMDLIST_,$1.i,0); }
command : vcommand { $$.i = $1.i; /* for commands distinguishable by First tok */}
/**************************************************************************/
command : command PIPE_ stringexpr
{ int p = makenode(PIPE_,$3.i,0);
subtree_swap(&$1.i,&p); /* so pipe executed first */
$$.i = makenode(PIPE_END_,p,$1.i);
}
command : command PIPE_ error {kb_error(2330,"Piping must be to quoted string or string expression.\n",Q_ERROR);}
/**************************************************************************/
command : command REDIRECT_ stringexpr { int p = makenode(REDIRECT_,$3.i,0);
subtree_swap(&$1.i,&p); /* so file openedfirst */
$$.i = makenode(REDIRECT_END_,p,$1.i);
}
command : command REDIRECT_ error {
kb_error(2331,
"Redirection must be to quoted string or string expression.\n",Q_ERROR);}
/**************************************************************************/
command : command REDIRECTOVER_ stringexpr
{ int p = makenode(REDIRECTOVER_,$3.i,0);
subtree_swap(&$1.i,&p); /* so file openedfirst */
$$.i = makenode(REDIRECT_END_,p,$1.i);
}
command : command REDIRECTOVER_ error {
kb_error(2332,
"Redirection must be to quoted string or string expression.\n",Q_ERROR);}
/**************************************************************************/
vcommand : BREAKPOINT_ PROCEDURE_ rexpr
{ $$.i = makenode(SET_BREAKPOINT_,$2.i,$3.i); }
vcommand : BREAKPOINT_ FUNCTION_IDENT_ rexpr
{ $$.i = makenode(SET_BREAKPOINT_,$2.i,$3.i); }
vcommand : BREAKPOINT_ PROCEDURE_IDENT_ rexpr
{ $$.i = makenode(SET_BREAKPOINT_,$2.i,$3.i); }
vcommand : BREAKPOINT_ error
{ kb_error(5981,"Syntax: breakpoint procedurename linenumber\n",
Q_ERROR); }
vcommand : UNSET_ BREAKPOINT_ { $$.i = makenode(UNSET_BREAKPOINT_,0,0); }
vcommand : WHEREAMI_ { $$.i = makenode(WHEREAMI_COMMAND_,0,0); }
/**************************************************************************/
vcommand : error { kb_error(3988,"Illegal command syntax.\n", Q_ERROR); }
vcommand : PROCEDURE_ { $$.i = makenode(PROCEDURE_,$1.i,0); }
vcommand : PROCEDURE_ rexpr { int init = makenode(REPEAT_INIT_,$2.i,0);
$$.i = makenode(PROCEDURE_,$1.i,0);
$$.i = makenode(REPEAT_,init,$$.i); }
vcommand : PROCEDURE_ error {
kb_error(3600,"Missing semicolon?",Q_ERROR);
}
/**************************************************************************/
vcommand : PERM_PROCEDURE_ { $$.i = makenode(PERM_PROCEDURE_,$1.i,0); }
vcommand : PERM_PROCEDURE_ rexpr { int init = makenode(REPEAT_INIT_,$2.i,0);
$$.i = makenode(PERM_PROCEDURE_,$1.i,0);
$$.i = makenode(REPEAT_,init,$$.i); }
vcommand : PERM_PROCEDURE_ error {
kb_error(3601,"Procedure has no arguments; can be followed by repetition count.",Q_ERROR);
}
/**************************************************************************/
command : command error { kb_error(2333,"Missing semicolon?\n",Q_ERROR); }
commands: commandlist { $$.i = $1.i; }
commands: commandlistterm { $$.i = $1.i; }
commandblock: '{' { begin_local_scope(); } commands '}'
{ end_local_scope(); $$.i = makenode(COMMAND_BLOCK_,$3.i,0); }
commandblock: '{' '}' { $$.i = makenode(NULLBLOCK_,0,0); }
commandblock: '{' error '}' { kb_error(3602,"Error following '{'",Q_ERROR); }
/**************************************************************************/
onecommand : commandsemic { $$.i = $1.i; }
onecommand : command { $$.i = $1.i; }
command : commandblock { $$.i = $1.i; }
command : commandblock rexpr
{ int init = makenode(REPEAT_INIT_,$2.i,0);
subtree_swap(&$1.i,&init);
$$.i = makenode(REPEAT_,init,$1.i);
}
command : commandblock error { kb_error(3603,
"Error following command block; expected ';' or repetition count or nothing.",
Q_ERROR);
}
/**************************************************************************/
/* want to do left recursion */
commandsemic: ';' { $$.i = makenode(NULLCMD_,0,0); }
commandsemic: command ';' { $$.i = $1.i; }
commandterm: commandsemic { $$.i = $1.i; }
commandlist: command { $$.i = $1.i; }
commandlistterm: commandterm { $$.i = $1.i; }
commandlist: commandlistterm command
{ $$.i = makenode(CMDLIST_,$1.i,$2.i); }
commandlistterm: commandlistterm commandterm
{ $$.i = makenode(CMDLIST_,$1.i,$2.i); }
ifhead: IF_ rexpr { $$.i = makenode(IFTEST_,$2.i,0); }
THEN_ command { $$.i = makenode(IF_,$3.i,$5.i); }
vcommand: IF_ error
{ kb_error(2334,"Syntax: IF rexpr THEN command [ ELSE command ]\n",Q_ERROR);}
vcommand: ifhead {$$.i = makenode(ELSE_,$1.i,0); }
vcommand: ifhead ELSE_ command { $$.i = makenode(ELSE_,$1.i,$3.i); }
vcommand: ELSE_ error { kb_error(2335,"Illegal ELSE. Don't use semicolon before ELSE.\n",Q_ERROR); }
vcommand: '?' { $$.i = makenode(SINGLE_LETTER_,'?',0); }
/* commandsemic: ';' { $$.i = makenode(NOP_,0,0); } */
/**************************************************************************/
command: GEOMVIEW_ stringexpr { $$.i = makenode(GEOMVIEW_,$2.i,0); }
command: GEOMVIEW_ toggle { $$.i = makenode(GEOMVIEW_TOGGLE_,$2.i,0); }
command: GEOMVIEW_ { $$.i = makenode(GEOMVIEW_TOGGLE_,ON_,0); }
command: GEOMVIEW_ error { kb_error(2336,"Syntax: GEOMVIEW ON|OFF or GEOMVIEW \"geomview command\"\n",Q_ERROR); }
/**************************************************************************/
command: GEOMPIPE_ stringexpr { $$.i = makenode(GEOMPIPE_,$2.i,0); }
command: GEOMPIPE_ toggle { $$.i = makenode(GEOMPIPE_TOGGLE_,$2.i,0); }
command: GEOMPIPE_ { $$.i = makenode(GEOMPIPE_TOGGLE_,ON_,0); }
command: GEOMPIPE_ error { kb_error(2337,"Syntax: GEOMPIPE ON|OFF or GEOMPIPE \"shell command\"\n",Q_ERROR); }
/**************************************************************************/
command: LOGFILE_ stringexpr { $$.i = makenode(LOGFILE_,$2.i,0); }
command: LOGFILE_ toggle { $$.i = makenode(LOGFILE_TOGGLE_,$2.i,0); }
command: LOGFILE_ { $$.i = makenode(LOGFILE_TOGGLE_,ON_,0); }
command: LOGFILE_ error { kb_error(2338,"Syntax: LOGFILE ON|OFF or LOGFILE \"filename\"\n",Q_ERROR); }
/**************************************************************************/
command: KEYLOGFILE_ stringexpr { $$.i = makenode(KEYLOGFILE_,$2.i,0); }
command: KEYLOGFILE_ toggle { $$.i = makenode(KEYLOGFILE_TOGGLE_,$2.i,0); }
command: KEYLOGFILE_ { $$.i = makenode(KEYLOGFILE_TOGGLE_,ON_,0); }
command: KEYLOGFILE_ error { kb_error(2419,"Syntax: KEYLOGFILE ON|OFF or KEYLOGFILE \"filename\"\n",Q_ERROR); }
/**************************************************************************/
vcommand: POSTSCRIPT_ stringexpr { $$.i = makenode( POSTSCRIPT_,$2.i,0); }
vcommand: POSTSCRIPT_ error { kb_error(3361,"Syntax: POSTSCRIPT \"filename\"\n",Q_ERROR); }
/**************************************************************************/
vcommand: BINARY_OFF_FILE_ stringexpr { $$.i = makenode( BINARY_OFF_FILE_,$2.i,0); }
vcommand: BINARY_OFF_FILE_ error { kb_error(4339,"Syntax: BINARY_OFF_FILE \"filename\"\n",Q_ERROR); }
/**************************************************************************/
vcommand: OOGLFILE_ stringexpr { $$.i = makenode( OOGLFILE_,$2.i,0); }
vcommand: OOGLFILE_ error { kb_error(2339,"Syntax: OOGLFILE \"filename\"\n",Q_ERROR); }
/**************************************************************************/
vcommand: HISTORY_ { $$.i = makenode(HISTORY_,0,0); }
vcommand: HISTORY_ error { kb_error(2340,"Syntax: HISTORY (no arguments)\n",Q_ERROR); }
/**************************************************************************/
vcommand: RETURN_ { $$.i = makenode(RETURN_,0,0); }
vcommand: RETURN_ rexpr { $$.i = makenode(RETURN_,$2.i,0); }
vcommand: RETURN_ error { kb_error(2341,"Syntax: RETURN [expr] \n",Q_ERROR); }
/**************************************************************************/
vcommand: BREAK_ { $$.i = makenode(BREAK_,1,0); }
vcommand: BREAK_ INTEGER_ { $$.i = makenode(BREAK_,$2.i,0); }
vcommand: BREAK_ error { kb_error(2342,"Syntax: BREAK or BREAK integer (to break multiple levels)\n",Q_ERROR); }
/**************************************************************************/
vcommand: CONTINUE_ { $$.i = makenode(CONTINUE_,1,0); }
vcommand: CONTINUE_ INTEGER_ { $$.i = makenode(CONTINUE_,$2.i,0); }
vcommand: CONTINUE_ error { kb_error(2343,"Syntax: CONTINUE or CONTINUE integer (to continue in higher level loop)\n",Q_ERROR); }
/**************************************************************************/
vcommand: GO_ {
$$.i = makenode(SINGLE_LETTER_,'g',0);
}
vcommand: GO_COUNT_ { int init,count,g;
real_val = $1.i;
count = makenode(PUSHCONST,0,0);
init = makenode(REPEAT_INIT_,count,0);
g = makenode(SINGLE_LETTER_,'g',0);
$$.i = makenode(REPEAT_,init,g);
}
vcommand: GO_ rexpr { int init,g;
init = makenode(REPEAT_INIT_,$2.i,0);
g = makenode(SINGLE_LETTER_,'g',0);
$$.i = makenode(REPEAT_,init,g);
}
vcommand: GO_ error { kb_error(3666,"Syntax: GO count\n",Q_ERROR); }
/**************************************************************************/
whilehead: WHILE_ rexpr { $$.i = makenode(WHILE_TOP_,$2.i,0); }
DO_ { $$.i = $3.i; }
vcommand: whilehead command { $$.i = makenode(WHILE_END_,$1.i,$2.i); }
vcommand: WHILE_ error { kb_error(2344,"Syntax: WHILE rexpr DO command\n",Q_ERROR); }
/**************************************************************************/
dohead: DO_ { $$.i = makenode(DO_ENTRY_,0,0);}
onecommand { $$.i = makenode(DO_TOP_,$2.i,$3.i); }
vcommand: dohead WHILE_ rexpr { $$.i = makenode(DO_END_,$1.i,$3.i); }
vcommand: dohead
error { kb_error(4345,"Missing WHILE at end of DO statement.\n",Q_ERROR); }
command: DO_ error { kb_error(2345,"Syntax: DO command WHILE expr\n",Q_ERROR); }
/**************************************************************************/
forentry: FOR_ '(' commandsemic
{ $$.i = makenode(FOR_ENTRY_,$3.i,0); }
forhead: forentry rexpr ';'
{ $$.i = makenode(FOR_HEAD_,$1.i,$2.i); }
forhead: forentry ';'
{ int tmp;
real_val = 1;
tmp = makenode(PUSHCONST,0,0);
$$.i = makenode(FOR_HEAD_,$1.i,tmp);
}
fortop: forhead command ')' { $$.i = makenode(FOR_TOP_,$1.i,$2.i); }
fortop: forhead ')' { int tmp = makenode(NULLCMD_,0,0);
$$.i = makenode(FOR_TOP_,$1.i,tmp);
}
vcommand: fortop command { $$.i = makenode(FOR_END_,$1.i,$2.i); }
vcommand: FOR_ error { kb_error(2514,
"Syntax: FOR ( command ; rexpr ; command ) command\n",Q_ERROR); }
vcommand: FOR_ '(' error { kb_error(3668,
"Error in initializer of FOR loop.\n",Q_ERROR); }
forhead: forentry error { kb_error(3669,
"Error in test expression of FOR loop.\n",Q_ERROR); }
fortop: forhead error { kb_error(3670,
"Error in increment part of FOR loop.\n",Q_ERROR); }
vcommand: fortop error { kb_error(2844,
"Bad FOR loop body. Try starting body on same line as FOR header.\n",
Q_ERROR); }
/**************************************************************************/
vcommand: SINGLE_LETTER_ { $$.i = makenode(SINGLE_LETTER_,$1.i,0); }
vcommand: SINGLE_REDEFD_ { $$.i = makenode(SINGLE_REDEFD_,$1.i,0); }
vcommand: SINGLE_REDEFD_ rexpr { int init = makenode(REPEAT_INIT_,$2.i,0);
$$.i = makenode(SINGLE_REDEFD_,$1.i,0);
$$.i = makenode(REPEAT_,init,$$.i); }
vcommand: SINGLE_REDEFD_ error { kb_error(3671,
"Expected repetition count after redefined single letter.\n",Q_ERROR); }
vcommand: SINGLE_LETTER_ARG_ { $$.i = makenode(SINGLE_LETTER_,$1.i,0); }
vcommand: SINGLE_LETTER_ rexpr { int init = makenode(REPEAT_INIT_,$2.i,0);
$$.i = makenode(SINGLE_LETTER_,$1.i,0);
$$.i = makenode(REPEAT_,init,$$.i); }
vcommand: SINGLE_LETTER_ error { kb_error(3672,
"Expected repetition count after single letter command.\n",Q_ERROR); }
vcommand: SINGLE_LETTER_ARG_ rexpr { assigntype = ASSIGN_;
switch ($1.i)
{ case 't': $$.i = makenode(EDGEWEED_,$2.i,0); break;
case 'w': $$.i = makenode(AREAWEED_,$2.i,0); break;
case 'l': $$.i = makenode(EDGEDIVIDE_,$2.i,0); break;
case 'm': $$.i = makenode(SET_SCALE_,$2.i,0); break;
case 'n': $$.i = makenode(NOTCH_,$2.i,0); break;
case 'j': $$.i = makenode(JIGGLE_,$2.i,0); break;
case 'G': $$.i = makenode(SET_GRAVITY_,$2.i,0); break;
case 'P': $$.i = makenode(INVOKE_P_MENU_,$2.i,0); break;
case 'M': $$.i = makenode(SET_MODEL_,$2.i,0); break;
case 'y': $$.i = makenode(TORDUP_,$2.i,0); break;
case 'K': $$.i = makenode(SKINNY_,$2.i,0); break;
case 'k': $$.i = makenode(SET_GAP_CONSTANT_,$2.i,0); break;
case 'p': $$.i = makenode(SET_AMBIENT_PRESSURE_,$2.i,0); break;
default: kb_error(1884,"Extra expression after single letter command.\n",Q_ERROR);
}
}
vcommand: SINGLE_LETTER_ARG_ error { kb_error(3660,
"Expected argument after single letter command.\n",Q_ERROR); }
/**************************************************************************/
vcommand: READ_ { $$.i = makenode(NOP_,0,0); }
vcommand: READ_ stringexpr { $$.i = makenode(READ_,$2.i,0); }
vcommand : READ_ error { kb_error(2346,"Syntax: READ \"filename\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
command: TRANSFORM_DEPTH_ rexpr
{ $$.i = makenode(TRANSFORM_DEPTH_,$2.i,0);}
command: TRANSFORM_DEPTH_ ASSIGN_ rexpr
{ $$.i = makenode(TRANSFORM_DEPTH_,$3.i,0);}
command: TRANSFORM_DEPTH_ error { kb_error(2348,"Syntax: TRANSFORM_DEPTH := integer\n",Q_ERROR);}
/**************************************************************************/
vcommand: TRANSFORM_EXPR_VERB_ stringexpr { $$.i = makenode(TRANSFORM_EXPR_,$2.i,0);}
vcommand: TRANSFORM_EXPR_VERB_ ASSIGN_ stringexpr { $$.i = makenode(TRANSFORM_EXPR_,$3.i,0);}
vcommand: TRANSFORM_EXPR_VERB_ error { kb_error(2349,"Syntax: TRANSFORM_EXPR := string (quoted string or string expression) \n",Q_ERROR); }
/**************************************************************************/
vcommand: SYSTEM_ stringexpr { $$.i = makenode(SYSTEM_,$2.i,0); }
vcommand: SYSTEM_ error { kb_error(2350,"Syntax: SYSTEM \"command\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand: EXEC_ stringexpr { $$.i = makenode(EXEC_,$2.i,0); }
vcommand: EXEC_ error { kb_error(2351,"Syntax: EXEC string (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand: PARALLEL_EXEC_ stringexpr { $$.i = makenode(PARALLEL_EXEC_,$2.i,0); }
vcommand: PARALLEL_EXEC_ error { kb_error(3115,"Syntax: PARALLEL_EXEC string (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand: TASK_EXEC_ rexpr ',' stringexpr
{ $$.i = makenode(TASK_EXEC_,$2.i,$4.i); }
vcommand: TASK_EXEC_ error { kb_error(3119,"Syntax: TASK_EXEC nodenumber, string (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand: CHDIR_ stringexpr { $$.i = makenode(CHDIR_,$2.i,0); }
vcommand: CHDIR_ error { kb_error(2352,"Syntax: CHDIR \"command\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand: METIS_ rexpr { $$.i = makenode(METIS_,$2.i,0); }
vcommand: METIS_ error { kb_error(3236,"Syntax: METIS numparts\n",Q_ERROR); }
vcommand: KMETIS_ rexpr { $$.i = makenode(KMETIS_,$2.i,0); }
vcommand: KMETIS_ error { kb_error(2354,"Syntax: KMETIS numparts\n",Q_ERROR); }
vcommand: METIS_READJUST_ rexpr { $$.i = makenode(METIS_READJUST_,$2.i,0); }
vcommand: METIS_READJUST_ error { kb_error(3237,"Syntax: METIS_READJUST numparts\n",Q_ERROR); }
vcommand: BODY_METIS_ rexpr { $$.i = makenode(BODY_METIS_,$2.i,0); }
vcommand: BODY_METIS_ error { kb_error(3775,"Syntax: BODY_METIS numparts\n",Q_ERROR); }
command: OMETIS_ rexpr { $$.i = makenode(OMETIS_,$2.i,0); }
command: OMETIS_ { $$.i = makenode(OMETIS_,0,0); }
command: OMETIS_ error { kb_error(2355,"Syntax: OMETIS or OMETIS expr\n",Q_ERROR); }
/**************************************************************************/
vcommand: EDGEWEED_ rexpr { $$.i = makenode(EDGEWEED_,$2.i,0); }
vcommand: EDGEWEED_ error { kb_error(2356,"Syntax: EDGEWEED minlength\n",Q_ERROR);}
/**************************************************************************/
vcommand: AREAWEED_ rexpr { $$.i = makenode(AREAWEED_,$2.i,0); }
vcommand: AREAWEED_ error { kb_error(2357,"Syntax: AREAWEED minarea\n",Q_ERROR);}
/**************************************************************************/
vcommand: EDGEDIVIDE_ rexpr { $$.i = makenode(EDGEDIVIDE_,$2.i,0); }
vcommand: EDGEDIVIDE_ error { kb_error(2358,"Syntax: EDGE_DIVIDE maxlength\n",Q_ERROR);}
/**************************************************************************/
vcommand: LANCZOS_ '(' rexpr ',' rexpr ')' { $$.i = makenode(LANCZOS_,$3.i,$5.i); }
vcommand: LANCZOS_ rexpr { $$.i = makenode(LANCZOS_,$2.i,0); }
vcommand: LANCZOS_ error
{ kb_error(2359,"Syntax: lanczos rexpr or lanczos(expr,count) \n",Q_ERROR);}
/**************************************************************************/
vcommand: RITZ_ '(' rexpr ',' rexpr ')' { $$.i = makenode(RITZ_,$3.i,$5.i); }
vcommand: RITZ_ error { kb_error(2360,"Syntax: RITZ(probe_value, number_of_eigenvalues)\n",Q_ERROR); }
/**************************************************************************/
vcommand: EIGENPROBE_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(EIGENPROBE_,$3.i,$5.i); }
vcommand: EIGENPROBE_ rexpr { $$.i = makenode(EIGENPROBE_,$2.i,0); }
vcommand: EIGENPROBE_ error { kb_error(2361,
"Syntax: EIGENPROBE probe_value or EIGENPROBE(probe_value, iterationmax)\n",Q_ERROR); }
/**************************************************************************/
vcommand: MOVE_ rexpr { $$.i = makenode(MOVE_,$2.i,0); }
vcommand: MOVE_ error { kb_error(2362,"Syntax: MOVE stepsize\n",Q_ERROR); }
/**************************************************************************/
vcommand: HESSIAN_SADDLE_ { $$.i = makenode(HESSIAN_SADDLE_,0,0); }
vcommand: HESSIAN_SADDLE_ rexpr { $$.i = makenode(HESSIAN_SADDLE_,$2.i,0); }
vcommand: HESSIAN_SADDLE_ error { kb_error(2363,"Syntax: SADDLE or SADDLE maxstepsize\n",
Q_ERROR); }
/**************************************************************************/
vcommand: HESSIAN_SEEK_ { $$.i = makenode(HESSIAN_SEEK_,0,0); }
vcommand: HESSIAN_SEEK_ rexpr { $$.i = makenode(HESSIAN_SEEK_,$2.i,0); }
vcommand: HESSIAN_SEEK_ error { kb_error(2364,
"Syntax: HESSIAN_SEEK or HESSIAN_SEEK maxstepsize\n", Q_ERROR); }
/**************************************************************************/
vcommand: COUNTS_ { $$.i = makenode(COUNTS_,0,0); }
vcommand: QUIT_ { $$.i = makenode(SINGLE_LETTER_,'q',0); }
vcommand: SUBCOMMAND_ { $$.i = makenode(SUBCOMMAND_,'q',0); }
vcommand: ABORT_ { $$.i = makenode(ABORT_,'q',0); }
vcommand: SIMPLEX_TO_FE_ { $$.i = makenode(SIMPLEX_TO_FE_,'q',0); }
vcommand: REORDER_STORAGE_ { $$.i = makenode(REORDER_STORAGE_,0,0); }
vcommand: RENUMBER_ALL_ { $$.i = makenode(RENUMBER_ALL_,0,0); }
vcommand: DUMP_MEMLIST_ { $$.i = makenode(DUMP_MEMLIST_,0,0); }
vcommand: FREE_DISCARDS_ { $$.i = makenode(FREE_DISCARDS_,0,0); }
vcommand: REPARTITION_ { $$.i = makenode(REPARTITION_,0,0); }
vcommand: EXTRAPOLATE_ { $$.i = makenode(EXTRAPOLATE_,0,0); }
vcommand: REBODY_ { $$.i = makenode(REBODY_,0,0); }
/**************************************************************************/
vcommand: ZOOM_ { $$.i = makenode(ZOOM_,0,0); }
vcommand: ZOOM_ rexpr rexpr { $$.i = makenode(ZOOM_,$2.i,$3.i); }
vcommand: ZOOM_ error { kb_error(2365,"Syntax: ZOOM [ vertex_id radius ]\n",Q_ERROR);}
/**************************************************************************/
vcommand: BURCHARD_ INTEGER_ { $$.i = makenode(BURCHARD_,$2.i,0); }
/**************************************************************************/
vcommand: LAGRANGE_ rexpr { $$.i = makenode(LAGRANGE_,$2.i,0); }
vcommand: LAGRANGE_ error { kb_error(2366,"Syntax: LAGRANGE order\n",Q_ERROR); }
/**************************************************************************/
vcommand: SHOW_VOL_ { $$.i = makenode(tok,0,0); }
| PAUSE_ { $$.i = makenode(tok,0,0); }
| PRINT_ PROFILING_ { $$.i = makenode(PRINT_PROFILING_,0,0); }
| RESET_PROFILING_ { $$.i = makenode(tok,0,0); }
| FLUSH_COUNTS_ { $$.i = makenode(tok,0,0); }
| RESET_COUNTS_ { $$.i = makenode(tok,0,0); }
| CHECK_ { $$.i = makenode(tok,0,0); }
| SHOWQ_ { $$.i = makenode(tok,0,0); }
| LONG_JIGGLE_ { $$.i = makenode(tok,0,0); }
| RAW_VERAVG_ { $$.i = makenode(tok,0,0); }
| RAWEST_VERAVG_ { $$.i = makenode(tok,0,0); }
| ALICE_ { $$.i = makenode(tok,0,0); }
| LINEAR_ { $$.i = makenode(tok,0,0); }
| QUADRATIC_ { $$.i = makenode(tok,0,0); }
| STABILITY_TEST_ { $$.i = makenode(tok,0,0); }
| UTEST_ { $$.i = makenode(tok,0,0); }
| SHELL_ { $$.i = makenode(tok,0,0); }
| CONVERT_TO_QUANTS_ { $$.i = makenode(tok,0,0); }
| METIS_FACTOR_ { $$.i = makenode(tok,0,0); }
| DIRICHLET_ { $$.i = makenode(tok,0,0); }
| DIRICHLET_SEEK_ { $$.i = makenode(tok,0,0); }
| SOBOLEV_ { $$.i = makenode(tok,0,0); }
| SOBOLEV_SEEK_ { $$.i = makenode(tok,0,0); }
| HESSIAN_ { $$.i = makenode(tok,0,0); }
| HESSIAN_MENU_ { $$.i = makenode(tok,0,0); }
| HELP_ { $$.i = makenode(SINGLE_LETTER_,'h',0); }
| RECALC_ { $$.i = makenode(tok,0,0); }
| LIST_ TOPINFO_ { $$.i = makenode(TOPINFO_,0,0); }
| LIST_ BOTTOMINFO_ { $$.i = makenode(BOTTOMINFO_,0,0); }
| LIST_ ATTRIBUTE_ { $$.i = makenode(LIST_ATTRIBUTES_,0,0); }
| LIST_ PROCEDURES_ { $$.i = makenode(LIST_PROCS_,0,0); }
| LIST_ BOUNDARY_ rexpr
{ $$.i = makenode(LIST_BOUNDARY_,$3.i,0);}
| LIST_ BOUNDARY_NAME_
{ int k = makenode(PUSHCONST,$2.i,0);
$$.i = makenode(LIST_BOUNDARY_,k,0);
list[$$.i].op1.bdry_id = $2.i;
}
| LIST_ CONSTRAINT_ rexpr
{ $$.i = makenode(LIST_CONSTRAINT_,$3.i,0);}
| LIST_ CONSTRAINT_NAME_
{ int k = makenode(PUSHCONST,$2.i,0);
$$.i = makenode(LIST_CONSTRAINT_,k,0);
list[$$.i].op1.con_id = $2.i;
}
| LIST_ QUANTITY_ QUANTITY_NAME_
{ $$.i = makenode(LIST_QUANTITY_,$3.i,0);}
| LIST_ QUANTITY_NAME_
{ $$.i = makenode(LIST_QUANTITY_,$2.i,0);}
| LIST_ METHOD_INSTANCE_ METHOD_NAME_
{ $$.i = makenode(LIST_METHOD_INSTANCE_,$3.i,0);}
| LIST_ METHOD_NAME_
{ $$.i = makenode(LIST_METHOD_INSTANCE_,$2.i,0);}
| CLOSE_SHOW_ { $$.i = makenode(CLOSE_SHOW_,0,0); }
| TOGGLENAME_ toggle { $$.i = makenode($1.i,$2.i,0); }
| TOGGLENAME_ { $$.i = makenode($1.i,ON_,0); }
| OPTIMIZE_ toggle { $$.i = makenode($1.i,$2.i,0); }
| OPTIMIZE_ { $$.i = makenode($1.i,ON_,0); }
| AUTOCHOP_ toggle { $$.i = makenode($1.i,$2.i,0); }
| AUTOCHOP_ { $$.i = makenode($1.i,ON_,0); }
| JIGGLE_ { $$.i = makenode($1.i,ON_,0); }
/**************************************************************************/
estart :EXPRESSION_START_ {verb_flag=0;}
whole : estart rexpr { YYACCEPT; }
whole : estart rexpr ',' { YYACCEPT; }
/**************************************************************************/
command : INTERNAL_VARIABLE_ assignop {verb_flag=0;} rexpr
{ assigntype = $2.i; $$.i = makenode(SET_INTERNAL_,$1.i,$4.i); }
command : INTERNAL_VARIABLE_ assignop error
{ kb_error(3673,"Expected expression to assign to internal variable.\n",Q_ERROR);}
vcommand : SET_ INTERNAL_VARIABLE_ {verb_flag=0;} rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_INTERNAL_,$2.i,$4.i); }
vcommand : SET_ INTERNAL_VARIABLE_ error
{ kb_error(3661,"Expected expression for setting internal variable.\n",Q_ERROR);}
/**************************************************************************/
vcommand : SET_ GRAVITY_ rexpr { $$.i = makenode(SET_GRAVITY_,$3.i,0); }
vcommand : SET_ GRAVITY_ error
{ kb_error(3675,"Expected expression for setting gravity.\n",Q_ERROR);}
command : GRAVITY_ assignop rexpr
{assigntype = $2.i; $$.i = makenode(SET_GRAVITY_,$3.i,0); }
command : GRAVITY_ error
{ kb_error(2367,"Syntax: GRAVITY := rexpr \n GRAVITY ON|OFF\n",Q_ERROR);}
/***************************************************************************/
vcommand : SET_ CONSTRAINT_ rexpr GLOBAL_
{ $$.i = makenode(SET_CONSTRAINT_GLOBAL,$3.i,0); }
vcommand : UNSET_ CONSTRAINT_ rexpr GLOBAL_
{ $$.i = makenode(UNSET_CONSTRAINT_GLOBAL,$3.i,0); }
vcommand : SET_ CONSTRAINT_ CONSTRAINT_NAME_ GLOBAL_
{ $$.i = makenode(SET_CONSTRAINT_NAME_GLOBAL,$3.i,0); }
vcommand : UNSET_ CONSTRAINT_ CONSTRAINT_NAME_ GLOBAL_
{ $$.i = makenode(SET_CONSTRAINT_NAME_GLOBAL,$3.i,0); }
vcommand : SET_ CONSTRAINT_NAME_ GLOBAL_
{ $$.i = makenode(SET_CONSTRAINT_NAME_GLOBAL,$2.i,0); }
vcommand : UNSET_ CONSTRAINT_NAME_ GLOBAL_
{ $$.i = makenode(SET_CONSTRAINT_NAME_GLOBAL,$2.i,0); }
/**************************************************************************/
vcommand : SET_ SCALE_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_INTERNAL_,V_SCALE,$3.i); }
vcommand : SET_ SCALE_ error
{ kb_error(3676,"Syntax: SET SCALE expr\n",Q_ERROR);}
command : SCALE_ assignop rexpr
{ assigntype = $2.i; $$.i = makenode(SET_INTERNAL_,V_SCALE,$3.i); }
command : SCALE_ assignop error
{ kb_error(3677,"Syntax: SCALE := expr\n",Q_ERROR);}
vcommand : SET_ DIFFUSION_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_INTERNAL_,V_DIFFUSION,$3.i); }
vcommand : SET_ DIFFUSION_ error
{ kb_error(3662,"Syntax: SET DIFFUSION expr\n",Q_ERROR);}
/**************************************************************************/
command : GAP_CONSTANT_ assignop rexpr
{ assigntype = $2.i; $$.i = makenode(SET_INTERNAL_,V_GAP_CONSTANT,$3.i); }
command : GAP_CONSTANT_ error
{ kb_error(2369,"Syntax: GAP_CONSTANT := expr\n",Q_ERROR);}
command : AREA_FIXED_ ASSIGN_ rexpr { $$.i = makenode(SET_FIXED_AREA_,$3.i,0); }
/**************************************************************************/
vcommand : NOTCH_ rexpr { $$.i = makenode(NOTCH_,$2.i,0); }
vcommand : NOTCH_ error { kb_error(2371,"Syntax: NOTCH maxangle\n",Q_ERROR);}
/**************************************************************************/
command : AUTOCHOP_ rexpr { $$.i = makenode(SET_AUTOCHOP_,$2.i,0); }
command : AUTOCHOP_ ASSIGN_ rexpr { $$.i = makenode(SET_AUTOCHOP_,$3.i,0); }
command : AUTOCHOP_ error { kb_error(2372,
"Syntax: AUTOCHOP ON|OFF or AUTOCHOP choplength\n", Q_ERROR); }
/**************************************************************************/
command : QUANTITY_NAME_ '.' TARGET_ assignop rexpr
{ assigntype = $4.i; $$.i = makenode(SET_QTARGET_,$5.i,$1.i); }
command : QUANTITY_NAME_ '.' MODULUS_ assignop rexpr
{ assigntype = $4.i; $$.i = makenode(SET_QMODULUS_,$5.i,$1.i); }
command : QUANTITY_NAME_ '.' TOLERANCE_ assignop rexpr
{ assigntype = $4.i; $$.i = makenode(SET_QTOLERANCE_,$5.i,$1.i); }
command : METHOD_NAME_ '.' MODULUS_ assignop rexpr
{ assigntype = $4.i; $$.i = makenode(SET_MMODULUS_,$5.i,$1.i); }
command : QUANTITY_NAME_ '.' VOLCONST_ assignop rexpr
{ assigntype = $4.i; $$.i = makenode(SET_QVOLCONST_,$5.i,$1.i); }
command : QUANTITY_NAME_ '.' error { kb_error(3372,
"Syntax: QUANTITY_NAME . TARGET|MODULUS|TOLERANCE|VOLCONST := expr\n",
Q_ERROR); }
command : METHOD_NAME_ '.' error { kb_error(3379,
"Syntax: METHOD_NAME . MODULUS\n", Q_ERROR); }
/**************************************************************************/
command : SET_ QUANTITY_NAME_ TARGET_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_QTARGET_,$4.i,$2.i); }
command : SET_ QUANTITY_NAME_ MODULUS_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_QMODULUS_,$4.i,$2.i); }
command : SET_ QUANTITY_NAME_ TOLERANCE_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_QTOLERANCE_,$4.i,$2.i); }
command : SET_ METHOD_NAME_ MODULUS_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_MMODULUS_,$4.i,$2.i); }
command : SET_ QUANTITY_NAME_ VOLCONST_ rexpr
{ assigntype = ASSIGN_; $$.i = makenode(SET_QVOLCONST_,$4.i,$2.i); }
command : SET_ QUANTITY_NAME_ FIXED_
{ $$.i = makenode(SET_Q_FIXED_,$2.i,0); }
command : SET_ QUANTITY_NAME_ INFO_ONLY_
{ $$.i = makenode(SET_Q_INFO_,$2.i,0); }
command : SET_ QUANTITY_NAME_ ENERGY_
{ $$.i = makenode(SET_Q_ENERGY_,$2.i,0); }
command : SET_ QUANTITY_NAME_ CONSERVED_
{ $$.i = makenode(SET_Q_CONSERVED_,$2.i,0); }
command : SET_ QUANTITY_NAME_ error
{ strcpy(errmsg,"Syntax:\n");
strcat(errmsg," SET quantityname TARGET expr\n");
strcat(errmsg," SET quantityname MODULUS expr\n");
strcat(errmsg," SET quantityname TOLERANCE expr\n");
strcat(errmsg," SET quantityname VOLCONST expr\n");
strcat(errmsg," SET quantityname FIXED\n");
strcat(errmsg," SET quantityname INFO_ONLY\n");
strcat(errmsg," SET quantityname ENERGY\n");
strcat(errmsg," SET quantityname CONSERVED\n");
kb_error(3663,errmsg,Q_ERROR);
}
/**************************************************************************/
command : SUPPRESS_WARNING_ rexpr
{ $$.i = makenode(SUPPRESS_WARNING_,$2.i,0); }
command : SUPPRESS_WARNING_ error { kb_error(3456,
"Syntax: SUPPRESS_WARNING number\n",Q_ERROR) }
command : UNSUPPRESS_WARNING_ rexpr
{ $$.i = makenode(UNSUPPRESS_WARNING_,$2.i,0); }
command : UNSUPPRESS_WARNING_ error { kb_error(3457,
"Syntax: UNSUPPRESS_WARNING number\n",Q_ERROR) }
/**************************************************************************/
vcommand : LOAD_ stringexpr { $$.i = makenode(LOAD_,$2.i,0); }
vcommand : LOAD_ error { kb_error(2373,"Syntax: LOAD \"filename\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand : ADDLOAD_ stringexpr { $$.i = makenode(ADDLOAD_,$2.i,0); }
vcommand : ADDLOAD_ error { kb_error(3544,"Syntax: ADDLOAD \"filename\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand : PERMLOAD_ stringexpr { $$.i = makenode(PERMLOAD_,$2.i,0); }
vcommand : PERMLOAD_ error { kb_error(2544,"Syntax: PERMLOAD \"filename\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
vcommand : DUMP_ stringexpr { $$.i = makenode(DUMP_,$2.i,0); }
vcommand : DUMP_ { $$.i = makenode(DUMP_,0,0); }
vcommand : DUMP_ error { kb_error(2374,"Syntax: DUMP \"filename\" (need quoted string or string expression)\n",Q_ERROR);}
/**************************************************************************/
command : COLORFILE_ ASSIGN_ stringexpr { $$.i = makenode(SET_COLORMAP_,$3.i,0); }
/**************************************************************************/
vcommand : OPTIMIZE_ rexpr {$$.i = makenode(SET_OPTIMIZE_,$2.i,0);}
command : OPTIMIZE_ error { kb_error(2375,"Syntax: OPTIMIZE maxscale\n",Q_ERROR); }
/**************************************************************************/
identassign : IDENT_ ASSIGN_ { $$.i = $1.i; }
permidentassign : PERM_IDENT_ PERM_ASSIGN_ { $$.i = $1.i; }
command : STRINGGLOBAL_ ASSIGN_ stringexpr {
$$.i = makenode(SET_SGLOBAL_,$1.i,$3.i); }
command : identassign stringexpr {
$$.i = makenode(SET_SGLOBAL_,$1.i,$2.i); }
command : STRINGGLOBAL_ ASSIGN_ rexpr {
$$.i = makenode(SET_GLOBAL_,$1.i,$3.i); }
command : PERM_STRINGGLOBAL_ PERM_ASSIGN_ stringexpr {
$$.i = makenode(SET_PERM_SGLOBAL_,$1.i,$3.i); }
command : STRINGGLOBAL_ PERM_ASSIGN_
{ kb_error(2604,"Cannot make permanent assigment to nonpermanent variable.\n",Q_ERROR) };
command : PERM_STRINGGLOBAL_ ASSIGN_
{ kb_error(2603,"Cannot make nonpermanent assigment to permanent variable.\n",Q_ERROR) };
command : identassign rexpr
{ $$.i = makenode(SET_GLOBAL_,$1.i,$2.i); }
command : permidentassign rexpr
{ $$.i = makenode(SET_PERM_GLOBAL_,$1.i,$2.i); }
elidassign : ELEMENT_IDENT_ ASSIGN_ { $$ = $1; }
command : elidassign rexpr
{ $$.i = makenode(SET_ELEMENT_GLOBAL_,$1.i,$2.i); }
lvalue : IDENT_ '.' DELTA_ { $$.i = makenode(PDELTA_LVALUE_,$1.i,0); }
lvalue : IDENT_ '.' SCALE_ { $$.i = makenode(PSCALE_LVALUE_,$1.i,0); }
command : lvalue assignop rexpr
{ subtree_swap(&$1.i,&$3.i);
switch ( list[$1.i].type )
{ case PDELTA_LVALUE_:
list[$1.i].type = SET_DELTA_;
list[$1.i].left = $3.i - $1.i;
break;
case PSCALE_LVALUE_:
list[$1.i].type = SET_PARAM_SCALE;
list[$1.i].left = $3.i - $1.i;
break;
default:
sprintf(errmsg,"Internal error: lvalue type %d\n",
list[$1.i].type);
kb_error(2882,errmsg,COMMAND_ERROR);
}
list[$1.i].op2.assigntype = $2.i;
list[$1.i].stack_delta = -1;
$$ = $1;
}
rexpr : IDENT_ '.' FIXED_ { $$.i = makenode(PUSH_PARAM_FIXED,$1.i,0); }
rexpr : lvalue
{ switch ( list[$1.i].type )
{ case PDELTA_LVALUE_:
list[$1.i].type = PUSHDELTA_;
list[$1.i].datatype = REAL_TYPE;
break;
case PSCALE_LVALUE_:
list[$1.i].type = PUSH_PARAM_SCALE;
list[$1.i].datatype = REAL_TYPE;
break;
default:
sprintf(errmsg,"Internal error: lvalue type %d\n",
list[$1.i].type);
kb_error(2883,errmsg,COMMAND_ERROR);
}
list[$1.i].stack_delta = 1;
$$ = $1;
}
command : IDENT_ '.' error { kb_error(3380,
"Syntax: VARIABLE . PDELTA|PSCALE \n", Q_ERROR); }
command : IDENT_ ASSIGNOP_ rexpr
{ $$.i = makenode($2.i,$1.i,$3.i); }
/*
command : arrayhead ASSIGNOP_ rexpr
{ assigntype = $2.i;
$$.i = makenode(ARRAYASSIGN,$1.i,$3.i);
}
command : arrayhead ASSIGN_ rexpr
{ assigntype = ASSIGN_;
$$.i = makenode(ARRAYASSIGN,$1.i,$3.i);
}
command : arrayhead EQ_
{ kb_error(3423,"Got '=' instead of the assignment operator ':='\n",
Q_ERROR);
}
*/
command : IDENT_ ASSIGN_ error
{ kb_error(2376,"Syntax: variable := expr\n",Q_ERROR);}
command : IDENT_ EQ_
{ kb_error(3422,"Got '=' instead of the assignment operator ':='\n",
Q_ERROR);
}
command : NEWIDENT_ EQ_
{ kb_error(3424,"Got '=' instead of the assignment operator ':='\n",
Q_ERROR);
}
command : IDENT_ error
{ kb_error(2377,"Syntax: variable := expr\n",Q_ERROR);}
/**************************************************************************/
datatype : DATATYPE_ { $$.i = $1.datatype; }
datatype : STRING_ { $$.i = STRING_TYPE; }
argident : NEWIDENT_ { $$.i = add_local_var($1.lexeme,1); }
argident : IDENT_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared variable.\n",
$1.lexeme);
kb_error(2635,errmsg,WARNING);
}
}
argident : ARRAYIDENT_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared variable.\n",
$1.lexeme);
kb_error(2636,errmsg,WARNING);
}
}
argident : PROCEDURE_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared procedure.\n",
$1.lexeme);
kb_error(2637,errmsg,WARNING);
}
}
argident : FUNCTION_IDENT_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared function.\n",
$1.lexeme);
kb_error(2638,errmsg,WARNING);
}
}
argident : STRINGGLOBAL_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared string variable.\n",
$1.lexeme);
kb_error(2639,errmsg,WARNING);
}
}
argident : QUANTITY_NAME_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared quantity name.\n",
$1.lexeme);
kb_error(2640,errmsg,WARNING);
}
}
argident : METHOD_NAME_ {$$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared method name.\n",
$1.lexeme);
kb_error(2641,errmsg,WARNING);
}
}
argident : CONSTRAINT_NAME_ {$$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared constraint.\n",
$1.lexeme);
kb_error(2642,errmsg,WARNING);
}
}
argident : BOUNDARY_NAME_ { $$.i = add_local_var($1.lexeme,1);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Argument \"%s\" shadows already declared boundary.\n",
$1.lexeme);
kb_error(2643,errmsg,WARNING);
}
}
arglist : '(' ')'
{ $$.i = makenode(ARGLIST_,0,0); }
argliststart : '(' datatype argident
{ int_val = $2.i; $$.i = makenode(ARGLIST_,0,$3.i); }
argliststart : argliststart ',' datatype argident
{ int_val = $3.i; $$.i = makenode(ARGLIST_,$1.i,$4.i); }
arglist : '(' error
{ if ( strcmp(yytext,"int") == 0 )
kb_error(3604,"Expecting datatype or ')' after '('\n ('integer' is the Evolver datatype, not 'int'.\n",Q_ERROR);
else
kb_error(3636,"Expecting datatype or ')' after '('\n",Q_ERROR);
}
argliststart : '(' datatype
{ kb_error(3605,"Expecting identifier after datatype.\n",Q_ERROR); }
argliststart : argliststart ',' error
{ kb_error(3606,"Expecting datatype after ','\n",Q_ERROR); }
argliststart : argliststart ',' datatype error
{ kb_error(3625,"Expecting identifier after datatype.\n",Q_ERROR); }
argliststart : argliststart error
{ kb_error(3525,"Expecting comma or right parenthesis after argument.\n",Q_ERROR); }
arglist : argliststart ')'
{ $$.i = $1.i };
/**************************************************************************/
protobody : commandblock { $$.i = $1.i; }
protobody : ';' { $$.i = 0; }
protobody : { kb_error(2624,"Missing function body, or ';' after prototype.\n",
Q_ERROR);
}
/**************************************************************************/
functionname : NEWIDENT_ { $$.i = $1.i; }
functionname : FUNCTION_IDENT_ { $$.i = $1.i; }
vcommand : FUNCTION_ datatype functionname
{ in_function = 1;
if ( $3.i == 0 ) $3.i = add_global($3.lexeme);
init_local_scope($3.i); begin_local_scope();
$$.i = makenode(FUNCTION_DEF_START_,$3.i,$2.i); }
arglist { $$.i = makenode(FUNCTION_HEAD_,$4.i,$5.i); }
protobody
{ int insize = inputbufferspot - $1.qnum;
in_function = 0;
globals($3.i)->attr.procstuff.proc_text = mycalloc(insize+1,1);
strncpy(globals($3.i)->attr.procstuff.proc_text,inputbuffer+$3.qnum,insize);
globals($3.i)->attr.procstuff.proc_text[insize] = 0;
list[$4.i].op5.locals = globals($3.i)->attr.procstuff.locals =
localbase;
if ( localbase )
localbase->flags |= LL_IN_USE;
int_val = $2.i;
if ( $7.i )
$$.i = makenode(SET_FUNCTION_,$6.i,$7.i);
else
{ makenode(FUNCTION_PROTO_,$6.i,0);
$$.i = 0;
}
exit_local_scope();
}
procedurename : NEWIDENT_ { $$.i = $1.i; }
procedurename : PROCEDURE_IDENT_ { $$.i = $1.i; }
vcommand : PROCEDURE_WORD_ procedurename
{ in_function = 1; /* for lex*/
if ( $2.i == 0 ) $2.i = add_global($2.lexeme);
init_local_scope($2.i); begin_local_scope();
$$.i = makenode(PROCEDURE_DEF_START_,$2.i,0); }
arglist { $$.i = makenode(PROCEDURE_HEAD_,$3.i,$4.i); }
protobody
{ int insize = inputbufferspot - $1.qnum;
in_function = 0;
globals($2.i)->attr.procstuff.proc_text = mycalloc(insize+1,1);
strncpy(globals($2.i)->attr.procstuff.proc_text,inputbuffer+$2.qnum,insize);
globals($2.i)->attr.procstuff.proc_text[insize] = 0;
list[$3.i].op5.locals = globals($2.i)->attr.procstuff.locals =
localbase;
if ( localbase )
localbase->flags |= LL_IN_USE;
if ( $6.i )
$$.i = makenode(SET_ARGSPROC_,$5.i,$6.i);
else
{ makenode(PROCEDURE_PROTO_,$5.i,0);
$$.i = 0;
}
exit_local_scope();
}
vcommand : FUNCTION_ datatype error
{ kb_error(3704,"Expected function name after datatype.\n",Q_ERROR); }
vcommand : FUNCTION_ error
{ kb_error(3705,"Expected datatype for function.\n",Q_ERROR); }
vcommand : PROCEDURE_WORD_ error
{ kb_error(3706,"Expected name of procedure.\n",Q_ERROR); }
vcommand : FUNCTION_
{ kb_error(3496,"Function returns a value; it's not a stand-alone command.\n",Q_ERROR); }
/**************************************************************************/
vcommand : DEFINE_ IDENT_ datatype { $$.i = makenode(DEFINE_IDENT_,$2.i,$3.i); }
vcommand : DEFINE_ NEWIDENT_ datatype
{int g; if ( $2.i == 0 )g = add_global($2.lexeme);
else g = $2.i; /* local */
$$.i = makenode(DEFINE_IDENT_,g,$3.i); }
vcommand : DEFINE_ IDENT_ { $$.i = makenode(DEFINE_IDENT_,$2.i,REAL_TYPE); }
vcommand : DEFINE_ NEWIDENT_
{int g = $2.i ? $2.i : add_global($2.lexeme);
$$.i = makenode(DEFINE_IDENT_,g,REAL_TYPE); }
vcommand : DEFINE_ STRINGGLOBAL_
{ $$.i = makenode(DEFINE_IDENT_,$2.i,STRING_TYPE); }
indexset : '[' rexpr ']' { $$.i = makenode(INDEXSET_,0,$2.i); }
indexset : indexset '[' rexpr ']' { $$.i = makenode(INDEXSET_,$1.i,$3.i); }
dimensionset : '[' rexpr ']' { $$.i = makenode(DIMENSIONSET_,0,$2.i); }
dimensionset : dimensionset '[' rexpr ']'
{ $$.i = makenode(DIMENSIONSET_,$1.i,$3.i); }
arraydecl : DEFINE_ ARRAYIDENT_ datatype dimensionset
{
$$.qnum = $2.i ; $$.datatype = $3.i;
int_val= $$.datatype;
$$.i = makenode(DEFINE_ARRAY_,$2.i,$4.i);
}
arraydecl : DEFINE_ NEWIDENT_ datatype dimensionset
{ $$.qnum = $2.i ? $2.i : add_global($2.lexeme);
$$.datatype = $3.i;
int_val= $$.datatype;
$$.i = makenode(DEFINE_ARRAY_,$$.qnum,$4.i);
}
arraydecl : DEFINE_ IDENT_ datatype dimensionset
{
$$.qnum = $2.i ; $$.datatype = $3.i;
int_val= $$.datatype;
$$.i = makenode(DEFINE_ARRAY_,$2.i,$4.i);
}
vcommand : arraydecl
{ $$.i = $1.i; }
/*
arrayhead : ARRAYIDENT_ indexset
{ $$.i = makenode(ARRAY_HEAD_,$2.i,$1.i);
$$.qnum = $2.i ;
}
arrayhead : ARRAYIDENT_ error {
sprintf(errmsg,"%s is an array; needs indexing.\n",
globals($1.i)->name);
kb_error(2378,errmsg,Q_ERROR);
}
*/
/**************************************************************
Some whole-array arithmetic syntax.
To handle both stand-alone and attribute arrays,
datastart of array is pushed on stack for each operand.
***************************************************************/
arraylvalue : ARRAYIDENT_
{ $$.i = makenode(ARRAYIDENT_,$1.i,0);
}
arraylvalue : VERTEXNORMAL_
{ /* for implicit generator */
$$.i = makenode(ATTRIB_LVALUE_,0,0);
list[$$.i].op1.localnum = 0;
list[$$.i].op2.name_id = set_name_eltype(V_NORMAL_ATTR,VERTEX);
list[$$.i].type = ARRAY_VERTEX_NORMAL_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
}
arraylvalue : ARRAY_ATTRIBUTE_
{ /* for implicit generator */
$$.i = makenode(ATTRIB_LVALUE_,0,0);
list[$$.i].op1.localnum = 0;
list[$$.i].op2.name_id = set_name_eltype($1.qnum,$1.etype);
if ( ($1.etype == VERTEX) && ($1.qnum == V_NORMAL_ATTR) )
{ list[$$.i].type = ARRAY_VERTEX_NORMAL_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
else if ( ($1.etype == EDGE) && ($1.qnum == E_VECTOR_ATTR) )
{ list[$$.i].type = ARRAY_EDGE_VECTOR_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
else if ( ($1.etype == FACET) && ($1.qnum == F_NORMAL_ATTR) )
{ list[$$.i].type = ARRAY_FACET_NORMAL_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
}
arraylvalue : singlep ARRAY_ATTRIBUTE_
{
if ( $2.etype != $1.etype )
{ sprintf(errmsg, "\"%s\" is a %s attribute, not %s.\n",
EXTRAS($2.etype)[$2.qnum].name,typenames[$2.etype],
typenames[$1.etype]);
kb_error(3678,errmsg,Q_ERROR);
}
$$.i = makenode(ATTRIB_LVALUE_,$1.i,0);
list[$$.i].op1.localnum = list[$1.i].op2.localnum;
list[$$.i].op2.name_id = set_name_eltype($2.qnum,$2.etype);
if ( ($2.etype == VERTEX) && ($2.qnum == V_NORMAL_ATTR) )
{ list[$$.i].type = ARRAY_VERTEX_NORMAL_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
else if ( ($2.etype == EDGE) && ($2.qnum == E_VECTOR_ATTR) )
{ list[$$.i].type = ARRAY_EDGE_VECTOR_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
else if ( ($2.etype == FACET) && ($2.qnum == F_NORMAL_ATTR) )
{ list[$$.i].type = ARRAY_FACET_NORMAL_;
list[$$.i].op3.localnum = add_local_var(NULL,SDIM);
list[$$.i].flags |= IS_VIRTUAL_ATTR;
}
}
arraylvalue : singlep NEWIDENT_
{ sprintf(errmsg,"\"%s\" is not an attribute name.\n",$2.lexeme);
kb_error(3573,errmsg,Q_ERROR);
}
arraylvalue : singlep error
{ sprintf(errmsg,"Missing attribute.\n");
kb_error(3574,errmsg,Q_ERROR);
}
arraylvalueindexset : arraylvalue indexset
{ $$.i = makenode(ARRAY_LVALUE_INDEXED_,$1.i,$2.i);
}
vcommand : arraylvalueindexset assignop rexpr
{
$$.i = makenode(ARRAY_ASSIGNOP_SINGLE_,$1.i,$3.i);
list[$$.i].op1.assigntype = $2.i;
list[$$.i].op2.name_id = list[$1.i].op2.name_id;
list[$$.i].stack_delta = list[$1.i].op1.indexcount + 2;
}
vcommand : arraylvalue assignop arraylvalue
{
$$.i = makenode(ARRAY_ASSIGNOP_ARRAY_,$1.i,$3.i);
list[$$.i].op1.assigntype = $2.i;
list[$3.i].flags |= IS_RVALUE;
}
vcommand : arraylvalue assignop rexpr
{ $$.i = makenode(ARRAY_ASSIGNOP_SCALAR_,$1.i,$3.i);
list[$$.i].op1.assigntype = $2.i;
}
vcommand : arraylvalue assignop rexpr '*' arraylvalue
{ int k = makenode(ARRAY_RVALUE_,$3.i,$5.i);
list[k].op1.intval = '*';
$$.i = makenode(ARRAY_ASSIGNOP_S_X_A_,$1.i,k);
list[$$.i].op1.assigntype = $2.i;
list[$$.i].op3.name_id = list[$5.i].op2.name_id;
list[$5.i].flags |= IS_RVALUE;
check_special_attr(list[$5.i].op2.name_id);
/* Can do dimension check now */
if ( check_array_dims_same(list[$1.i].op2.name_id,
list[$5.i].op2.name_id ) == 0 )
kb_error(4379,"Arrays don't have same number of dimensions or types are different.\n",
COMMAND_ERROR);
}
vcommand : arraylvalue assignop arraylvalue '+' arraylvalue
{ int k = makenode(ARRAY_RVALUE_,$3.i,$5.i);
list[k].op1.intval = '+';
$$.i = makenode(ARRAY_ASSIGNOP_A_P_A_,$1.i,k);
list[$$.i].op1.assigntype = $2.i;
list[$$.i].op3.name_id = list[$3.i].op2.name_id;
list[$$.i].op4.name_id = list[$5.i].op2.name_id;
list[$3.i].flags |= IS_RVALUE;
list[$5.i].flags |= IS_RVALUE;
check_special_attr(list[$3.i].op2.name_id);
check_special_attr(list[$5.i].op2.name_id);
/* Can do dimension check now */
if ( check_array_dims_same(list[$1.i].op2.name_id,
list[$3.i].op2.name_id) == 0 )
kb_error(4380,"Arrays don't have same number of dimensions or types are different.\n",
COMMAND_ERROR);
if ( check_array_dims_same(list[$1.i].op2.name_id,
list[$5.i].op2.name_id) == 0 )
kb_error(4381,"Arrays don't have same number of dimensions or types are different.\n",
COMMAND_ERROR);
}
vcommand : arraylvalue assignop arraylvalue '-' arraylvalue
{ int k = makenode(ARRAY_RVALUE_,$3.i,$5.i);
list[k].op1.intval = '-';
$$.i = makenode(ARRAY_ASSIGNOP_A_S_A_,$1.i,k);
list[$$.i].op1.assigntype = $2.i;
list[$$.i].op3.name_id = list[$3.i].op2.name_id;
list[$$.i].op4.name_id = list[$5.i].op2.name_id;
list[$3.i].flags |= IS_RVALUE;
list[$5.i].flags |= IS_RVALUE;
check_special_attr(list[$3.i].op2.name_id);
check_special_attr(list[$5.i].op2.name_id);
/* Can do dimension check now */
if ( check_array_dims_same(list[$1.i].op2.name_id,
list[$3.i].op2.name_id) == 0 )
kb_error(3030,"Arrays don't have same number of dimensions or types are different.\n",
COMMAND_ERROR);
if ( check_array_dims_same(list[$1.i].op2.name_id,
list[$5.i].op2.name_id) == 0 )
kb_error(4383,"Arrays don't have same number of dimensions or types are different.\n",
COMMAND_ERROR);
}
rexpr : arraylvalue DOT_ arraylvalue
{ $$.i = makenode(DOT_,$1.i,$3.i);
list[$1.i].flags |= IS_RVALUE;
list[$3.i].flags |= IS_RVALUE;
}
rexpr : arraylvalue indexset
{ $$.i = makenode(ARRAY_EVAL_,$1.i,$2.i);
list[$1.i].flags |= IS_RVALUE;
}
/*********** end whole-array syntax *************************/
extraat : EXTRA_ATTRIBUTE_ { $$.i = $1.i; }
extraat : ARRAY_ATTRIBUTE_ { $$.i = $1.i; }
defextra : DEFINE_ eltype ATTRIBUTE_ extraat datatype
{ struct extra *ex;
$$.qnum = $4.qnum;
$$.etype = $4.etype;
if ( $2.i != $$.etype )
kb_error(1885,"This extra attribute already defined on different element type.\n",COMMAND_ERROR);
ex = EXTRAS($$.etype) + $$.qnum;
if ( ex->type != $5.i )
{ sprintf(errmsg,
"Attribute %s already defined with different type, %s.\n",
ex->name,datatype_name[ex->type]);
kb_error(1886,errmsg,COMMAND_ERROR);
}
$$.i = makenode(DEFINE_EXTRA_,0,$2.i);
list[$$.i].op1.extranum = $$.qnum;
}
defextra : DEFINE_ eltype ATTRIBUTE_ NEWIDENT_ datatype
{ int attr_type=INTEGER_TYPE;
if ( $4.i )
{ sprintf(errmsg,"Cannot use local variable \"%s\" as attribute.\n",
$4.lexeme);
kb_error(2615,errmsg,COMMAND_ERROR);
}
attr_type = $5.i;
$$.qnum = add_attribute($2.i,$4.lexeme,attr_type,0,NULL,DUMP_ATTR,NULL);
/* being a declaration, has effect when parsed */
$$.i = makenode(DEFINE_EXTRA_,0,$2.i);
list[$$.i].op1.extranum = $$.qnum;
}
vcommand : defextra dimensionset
{ $$.i = makenode(DEFINE_EXTRA_INDEX_,$1.i,$2.i);
}
vcommand : defextra FUNCTION_
{
begin_scope(); /* ended right below */
elsym = symbol_add("self",list[$1.i].op2.eltype);
$$.i = makenode(ATTR_FUNCTION_,$1.i,0);
}
'{' { init_local_scope(0); begin_local_scope(); }
commands '}'
{ struct extra *ext;
end_local_scope();
$$.i = makenode(ATTR_FUNCTION_END_,$3.i,$6.i);
list[$$.i].op1.extranum = list[$1.i].op1.extranum; /* attr number */
list[$$.i].op2.eltype = list[$1.i].op2.eltype; /* element type */
list[$3.i].op1.skipsize = $$.i - $3.i;
ext = EXTRAS(list[$$.i].op2.eltype) + list[$$.i].op1.extranum;
ext->code.locals = localbase;
if ( localbase )
localbase->flags |= LL_IN_USE;
exit_local_scope();
ext->flags |= FUNCTION_ATTR;
end_scope();
}
vcommand : defextra
{ $$.i = $1.i; }
vcommand : DEFINE_ QUANTITY_ { $$.i = makenode(DEFINE_QUANTITY_,0,0); }
vcommand : DEFINE_ METHOD_INSTANCE_
{ $$.i = makenode(DEFINE_METHOD_INSTANCE_,0,0); }
vcommand : DEFINE_ CONSTRAINT_ { $$.i = makenode(DEFINE_CONSTRAINT_,0,0); }
vcommand : DEFINE_ BOUNDARY_ { $$.i = makenode(DEFINE_BOUNDARY_,0,0); }
vcommand : DEFINE_ error { kb_error(2379,
"Syntax: DEFINE name [REAL|INTEGER]\n or: DEFINE elementtype ATTRIBUTE name REAL|INTEGER [ dimension ] \n",Q_ERROR); }
newlvalue : NEWIDENT_ ASSIGN_ {
strncpy($$.lexeme,$1.lexeme,31);
/* if ( $$.i == 0 ) ?? */
$$.i = add_global($1.lexeme);
/* else $$.i = $1.i; */ /* local ?? */
$$.qnum = assignbacktrack();
}
new_permlvalue : NEWIDENT_ PERM_ASSIGN_ {
$$.i = add_perm_global($1.lexeme);
perm_globals($$.i)->flags |= PERMANENT;
perm_flag++;
$$.qnum = assignbacktrack();
}
newlvalue : SET_ NEWIDENT_ {
/* if ( $$.i == 0 ) ?? */
$$.i = add_global($2.lexeme);
/* else $$.i = $2.i; ?? */ /* local */
} ASSIGN_ { $$.i = $2.i;$$.qnum = assignbacktrack(); }
newlvalue : SET_ NEWIDENT_ {
/* if ( $$.i == 0 ) ?? */
$$.i = add_global($2.lexeme);
/* else $$.i = $2.i; ?? */
$$.qnum = assignbacktrack();
strcpy($$.lexeme,$2.lexeme);
}
command : NEWIDENT_ error
{ kb_error(2380,"Syntax: variable := rexpr | {command} \n",Q_ERROR);}
rexpr : NEWIDENT_ error
{ sprintf(errmsg,"Syntax error: Unexpected new identifier '%s'.\n",$1.lexeme);
kb_error(2381,errmsg, Q_ERROR);}
command : NEWIDENT_ ASSIGN_ error
{ kb_error(2382,"Syntax: variable := rexpr | {command} (braces needed around command) \n",Q_ERROR);}
command : newlvalue stringexpr { $$.i = makenode(SET_SGLOBAL_,$1.i,$2.i); }
command : newlvalue rexpr { $$.i = makenode(SET_GLOBAL_,$1.i,$2.i); }
command : newlvalue error
{ sprintf(errmsg,"Illegal right side of assignment.\n");
kb_error(3756,errmsg, Q_ERROR);}
command : new_permlvalue stringexpr
{ $$.i = makenode(SET_PERM_SGLOBAL_,$1.i,$2.i); }
command : new_permlvalue rexpr { $$.i = makenode(SET_PERM_GLOBAL_,$1.i,$2.i); }
command : newlvalue { init_local_scope($1.i);
begin_local_scope(); }
vcommand
{ int insize = inputbufferspot - $1.qnum;
globals($1.i)->attr.procstuff.proc_text = mycalloc(insize+1,1);
strncpy(globals($1.i)->attr.procstuff.proc_text,inputbuffer+$1.qnum,insize);
$$.i = makenode(SET_PROCEDURE_,$3.i,$1.i);
globals($1.i)->attr.procstuff.proc_text[insize] = 0;
exit_local_scope();
}
command : newlvalue '{' { init_local_scope($1.i); begin_local_scope(); }
commands '}'
{ int k,insize = inputbufferspot - $1.qnum;
globals($1.i)->attr.procstuff.proc_text = mycalloc(insize+1,1);
strncpy(globals($1.i)->attr.procstuff.proc_text,inputbuffer+$1.qnum,insize);
globals($1.i)->attr.procstuff.proc_text[insize] = 0;
k = makenode(COMMAND_BLOCK_,$4.i,0);
$$.i = makenode(SET_PROCEDURE_,k,$1.i);
exit_local_scope();
}
command : newlvalue '{' '}'
{ int k = makenode(NULLBLOCK_,0,0);
localbase = NULL;
$$.i = makenode(SET_PROCEDURE_,k,$1.i);
}
command : new_permlvalue '{' { init_local_scope($1.i); begin_local_scope(); }
commands '}'
{ int k,insize = inputbufferspot - $1.qnum;
perm_globals($1.i)->attr.procstuff.proc_text = calloc(insize+1,1);
strncpy(perm_globals($1.i)->attr.procstuff.proc_text,inputbuffer+$1.qnum,insize);
perm_globals($1.i)->attr.procstuff.proc_text[insize] = 0;
k = makenode(COMMAND_BLOCK_,$4.i,0);
$$.i = makenode(SET_PERM_PROCEDURE_,k,$1.i);
exit_local_scope();
}
command : new_permlvalue '{' '}'
{ int k = makenode(NULLBLOCK_,0,0);
localbase = NULL;
$$.i = makenode(SET_PERM_PROCEDURE_,k,$1.i);
}
command : PROCEDURE_ ASSIGN_ { $$.qnum = assignbacktrack();
init_local_scope($1.i); begin_local_scope();
} command
{ int insize = inputbufferspot - $3.qnum;
myfree(globals($1.i)->attr.procstuff.proc_text);
globals($1.i)->attr.procstuff.proc_text = mycalloc(insize+1,1);
strncpy(globals($1.i)->attr.procstuff.proc_text,inputbuffer+$3.qnum,insize);
globals($1.i)->attr.procstuff.proc_text[insize] = 0;
$$.i = makenode(SET_PROCEDURE_,$4.i,$1.i);
exit_local_scope();
}
command : PERM_PROCEDURE_ PERM_ASSIGN_
{ $$.i = perm_flag++; $$.qnum = assignbacktrack();
init_local_scope($1.i); begin_local_scope(); }
command
{ int insize = inputbufferspot - $3.qnum;
free(perm_globals($1.i)->attr.procstuff.proc_text);
perm_globals($1.i)->attr.procstuff.proc_text = calloc(insize+1,1);
strncpy(perm_globals($1.i)->attr.procstuff.proc_text,inputbuffer+$3.qnum,insize);
perm_globals($1.i)->attr.procstuff.proc_text[insize] = 0;
perm_globals($1.i)->flags |= PERMANENT;
$$.i = makenode(SET_PERM_PROCEDURE_,$4.i,$1.i);
perm_flag = $3.i;
exit_local_scope();
}
command : PROCEDURE_ ASSIGN_ error
{ kb_error(2383,"Syntax: procedure_name := {command} \n",Q_ERROR);}
command : PROCEDURE_ PERM_ASSIGN_ error
{ kb_error(2384,"Syntax: procedure_name ::= {command} \n",Q_ERROR);}
command : identassign '{'
{ sprintf(errmsg,
"'%s' is a variable; cannot be assigned a procedure.\n",
globals($1.i)->name);
kb_error(3899,errmsg,Q_ERROR);
}
/**************************************************************************/
vcommand : LOCAL_ localidlist { $$.i = makenode(LOCAL_LIST_START_,$2.i,0); }
localidlist: localid { $$.i = $1.i; }
localidlist: localidlist ',' localid
{ $$.i = $3.i; list[$3.i].left = -1; }
localid : NEWIDENT_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0); }
localid : IDENT_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared variable.\n",
$1.lexeme);
kb_error(2625,errmsg,WARNING);
}
}
localid : ARRAYIDENT_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared variable.\n",
$1.lexeme);
kb_error(2626,errmsg,WARNING);
}
}
localid : PROCEDURE_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared procedure.\n",
$1.lexeme);
kb_error(2627,errmsg,WARNING);
}
}
localid : FUNCTION_IDENT_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared function.\n",
$1.lexeme);
kb_error(2628,errmsg,WARNING);
}
}
localid : STRINGGLOBAL_ { ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared string variable.\n",
$1.lexeme);
kb_error(2629,errmsg,WARNING);
}
}
localid : QUANTITY_NAME_ {ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared quantity name.\n",
$1.lexeme);
kb_error(2630,errmsg,WARNING);
}
}
localid : METHOD_NAME_ {ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared method name.\n",
$1.lexeme);
kb_error(2631,errmsg,WARNING);
}
}
localid : CONSTRAINT_NAME_ {ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared constraint.\n",
$1.lexeme);
kb_error(2632,errmsg,WARNING);
}
}
localid : BOUNDARY_NAME_ {ident_t iid = add_local_var($1.lexeme,1);
$$.i = makenode(DECLARE_LOCAL_,iid,0);
if ( shadow_warn_flag )
{ sprintf(errmsg,
"Local name \"%s\" shadows already declared boundary.\n",
$1.lexeme);
kb_error(2633,errmsg,WARNING);
}
}
localid : error { kb_error(2614,"Syntax: LOCAL varname; \n",Q_ERROR);}
/**************************************************************************/
vcommand : SINGLE_LETTER_ REDEFINE_
{ init_local_scope(0); begin_local_scope(); }
command
{ $$.i = makenode(REDEFINE_SINGLE_,$4.i,$1.i);
exit_local_scope();
}
vcommand : SINGLE_LETTER_ARG_ REDEFINE_
{ init_local_scope(0); begin_local_scope(); }
command
{
$$.i = makenode(REDEFINE_SINGLE_,$4.i,$1.i);
exit_local_scope();
}
vcommand : SINGLE_REDEFD_ REDEFINE_
{ init_local_scope(0); begin_local_scope(); }
command
{
$$.i = makenode(REDEFINE_SINGLE_,$4.i,$1.i);
exit_local_scope();
}
vcommand : SINGLE_LETTER_ REDEFINE_
{ $$.i = makenode(UNREDEFINE_SINGLE_,0,$1.i); }
vcommand : SINGLE_REDEFD_ REDEFINE_
{ $$.i = makenode(UNREDEFINE_SINGLE_,0,$1.i); }
/**************************************************************************/
exprlist : rexpr ',' exprlist { $$.i = makenode(EXPRLIST_,$1.i,$3.i); }
exprlist : rexpr ',' error { kb_error(3801,"Missing expression after ','\n",
Q_ERROR); }
exprlist : rexpr { $$.i = makenode(EXPRLIST_,$1.i,0); }
exprlist : stringexpr ',' exprlist { $$.i = makenode(EXPRLIST_,$1.i,$3.i); }
exprlist : stringexpr ',' error
{ kb_error(3891,"Missing expression after ','\n", Q_ERROR); }
exprlist : stringexpr { $$.i = makenode(EXPRLIST_,$1.i,0); }
/**************************************************************************/
printfhead : PRINTF_ stringexpr { $$.i = makenode(PRINTFHEAD_,$2.i,0); }
printfhead : PRINTF_ error
{ kb_error(3892,"Missing format string after printf.\n", Q_ERROR); }
binaryprintfhead : BINARY_PRINTF_ stringexpr { $$.i = makenode(BINARY_PRINTFHEAD_,$2.i,0); }
binaryprintfhead : BINARY_PRINTF_ error
{ kb_error(4892,"Missing format string after printf.\n", Q_ERROR); }
errprintfhead : ERRPRINTF_ stringexpr
{ $$.i = makenode(ERRPRINTFHEAD_,$2.i,0); }
errprintfhead : ERRPRINTF_ error
{ kb_error(3802,"Missing format string after errprintf.\n", Q_ERROR); }
vcommand : printfhead { $$.i = $1.i; }
vcommand : printfhead ',' exprlist { $$.i = makenode(PRINTF_,$1.i,$3.i); }
vcommand : printfhead ',' error
{ kb_error(3893,"Missing expression after ','\n", Q_ERROR); }
vcommand : binaryprintfhead { $$.i = $1.i; }
vcommand : binaryprintfhead ',' exprlist { $$.i = makenode(BINARY_PRINTF_,$1.i,$3.i); }
vcommand : binaryprintfhead ',' error
{ kb_error(4893,"Missing expression after ','\n", Q_ERROR); }
vcommand : errprintfhead { $$.i = $1.i; }
vcommand : errprintfhead ',' exprlist { $$.i = makenode(ERRPRINTF_,$1.i,$3.i); }
vcommand : errprintfhead ',' error { $$.i = makenode(ERRPRINTF_,$1.i,$3.i); }
{ kb_error(3803,"Missing expression after ','\n", Q_ERROR); }
/**************************************************************************/
print : PRINT_
vcommand : print PROCEDURE_WORD_ { $$.i = makenode(LIST_PROCS_,0,0); }
vcommand : print stringexpr { $$.i = makenode(STRPRINT_,$2.i,0); }
vcommand : print PROCEDURE_ { $$.i = makenode(PRINT_PROCEDURE_,$2.i,0); }
vcommand : print FUNCTION_IDENT_ { $$.i = makenode(PRINT_PROCEDURE_,$2.i,0); }
vcommand : print PROCEDURE_IDENT_ { $$.i = makenode(PRINT_PROCEDURE_,$2.i,0); }
vcommand : print PERM_PROCEDURE_
{ $$.i = makenode(PRINT_PERM_PROCEDURE_,$2.i,0); }
vcommand : EXPRINT_ PROCEDURE_ { $$.i = makenode(EXPRINT_PROCEDURE_,$2.i,0); }
/*
vcommand : print arrayhead { $$.i = makenode(PRINT_ARRAYPART_,$2.i,0); }
*/
vcommand : print rexpr { $$.i = makenode(PRINT_,$2.i,0); }
/* the previous two rules give a reduce/reduce conflict, resolved by yacc
in favor of the first, which is ok since it prints a fully indexed
array entry as a scalar. */
vcommand : print arraylvalue
{ $$.i = makenode(PRINT_ARRAY_LVALUE_,$2.i,0);
list[$2.i].flags |= IS_RVALUE;
}
vcommand: print singlep ggetattrib
{ int k;
switch ( $3.i )
{ case COORD_:
switch ( $2.etype )
{ case VERTEX: case EDGE: case FACET:
k = makenode(ATTRIBUTE,$3.i,$3.qnum);
list[k].op1.localnum = list[$2.i].op2.localnum;
list[k].op2.coordnum = $3.qnum - 1; /* 1-based indexing to 0 */
k = makenode(QUALIFIED_ATTRIBUTE,$2.i,k);
$$.i = makenode(PRINT_,k,0);
goto vnexit;
default:
sprintf(errmsg,"\"x\" is not a %s attribute.\n",
typenames[$2.etype]);
kb_error(2650,errmsg,COMMAND_ERROR);
}
break;
case GET_VERTEXNORMAL_:
if ( $2.etype != VERTEX )
{ sprintf(errmsg,"\"vertexnormal\" is vertex attribute; cannot be on %s.\n",
typenames[$2.etype]);
kb_error(2651,errmsg,COMMAND_ERROR);
}
$$.i = makenode(PRINT_VERTEXNORMAL_,$2.i,0);
list[$$.i].op1.localnum = list[$2.i].op2.localnum;
goto vnexit;
break;
case PARAM_:
if ( $2.etype != VERTEX )
{ sprintf(errmsg,"\"p\" is %s attribute; cannot be on %s.\n",
typenames[VERTEX], typenames[$2.etype]);
kb_error(2652,errmsg,COMMAND_ERROR);
}
int_val = V_PARAM_ATTR;
break;
case GET_EXTRA_ATTR_:
if ( $2.etype != $3.etype )
{ sprintf(errmsg,"\"%s\" is %s attribute; cannot be on %s.\n",
EXTRAS($3.etype)[$3.qnum & YYSHIFTMASK].name,
typenames[$3.etype], typenames[$2.etype]);
kb_error(2653,errmsg,COMMAND_ERROR);
}
int_val = $3.qnum;
break;
default:
k = makenode(ATTRIBUTE,$3.i,$3.qnum);
list[k].op1.localnum = list[$2.i].op2.localnum;
k = makenode(QUALIFIED_ATTRIBUTE,$2.i,k);
$$.i = makenode(PRINT_,k,0);
goto vnexit;
}
int_val |= ($2.etype << YYTYPESHIFT);
$$.i = makenode(PRINT_ATTR_ARRAY_,$2.i,0);
vnexit: ;
}
/*
rexpr : arrayhead
{ $$.i = makenode(ARRAYEVAL,$1.i,0); }
*/
vcommand : print SINGLE_LETTER_ { $$.i = makenode(PRINT_LETTER_,$2.i,0); }
vcommand : print SINGLE_LETTER_ARG_ { $$.i = makenode(PRINT_LETTER_,$2.i,0); }
vcommand : print SINGLE_REDEFD_ { $$.i = makenode(PRINT_LETTER_,$2.i,0); }
vcommand : print error { kb_error(2385,
"Syntax: PRINT procedure | expression | stringexpression \n",Q_ERROR ); }
/**************************************************************************/
vcommand : SHOW_TRANS_ stringexpr { $$.i = makenode(SHOW_TRANS_,$2.i,0); }
vcommand : SHOW_TRANS_ error { kb_error(2386,"Syntax: SHOW_TRANS \"string\"\n",Q_ERROR);}
/**************************************************************************/
backquote : '`' { backquote_flag = 1; $$.i = makenode(BACKQUOTE_START_,0,0);
if ( local_nest_depth == 0 )
init_local_scope(0);
begin_local_scope();
list[listtop++].type = SETUP_FRAME_; }
rexpr : backquote commands BACKQUOTE_COMMA_
{ verb_flag = 0; backquote_flag = 0; end_local_scope();
$$.i = makenode(BACKQUOTE_END_,$1.i,$2.i);}
rexpr { $$.i = makenode(ACOMMANDEXPR_,$4.i,$5.i); }
rexpr : backquote error
{
backquote_flag = 0;
kb_error(3805,"Backquote syntax: ` commands ` , expression\n",
Q_ERROR);
}
/**************************************************************************/
rexpr : FUNCTION_IDENT_ '(' ')'
{ $$.i = makenode(FUNCTION_CALL_,$1.i,0);
$$.i = makenode(FUNCTION_CALL_RETURN_,$$.i,0);
}
rexpr : FUNCTION_IDENT_ '(' exprlist ')'
{ $$.i = makenode(FUNCTION_CALL_,$1.i,$3.i);
makenode(FUNCTION_CALL_RETURN_,$$.i,0);
}
rexpr : FUNCTION_IDENT_ error
{ kb_error(2870, "Function call needs argument list.\n",Q_ERROR); }
/**************************************************************************/
vcommand : PROCEDURE_IDENT_ '(' ')'
{ $$.i = makenode(PROCEDURE_CALL_,$1.i,0);
$$.i = makenode(PROCEDURE_CALL_RETURN_,$$.i,0);
}
vcommand : PROCEDURE_IDENT_ '(' exprlist ')'
{ $$.i = makenode(PROCEDURE_CALL_,$1.i,$3.i);
makenode(PROCEDURE_CALL_RETURN_,$$.i,0);
}
vcommand : PROCEDURE_IDENT_ error
{ kb_error(2871, "Procedure call needs argument list.\n",Q_ERROR); }
/**************************************************************************/
vcommand : WRAP_VERTEX_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(WRAP_VERTEX_,$3.i,$5.i); }
vcommand : WRAP_VERTEX_ error
{ kb_error(3808,"Syntax: wrap_vertex(vertex_number,wrap_code_number)\n",
Q_ERROR); }
/**************************************************************************/
rexpr : VIEW_TRANSFORM_PARITY_ '[' rexpr ']'
{ $$.i = makenode(VIEW_TRANSFORM_PARITY_,$3.i,0); }
rexpr : VIEW_TRANSFORM_PARITY_ error { kb_error(2602,
"view_transform_parity needs one index.\n", Q_ERROR); }
/**************************************************************************/
rexpr : DISPLAY_TEXT_ '(' rexpr ',' rexpr ',' stringexpr ')'
{ int nn = makenode(TEXT_SPOT_,$3.i,$5.i);
$$.i = makenode(DISPLAY_TEXT_,nn,$7.i);
}
rexpr : DISPLAY_TEXT_ error
{ kb_error(4683,"Syntax: text_id := DISPLAY_TEXT(x,y,string)\n",Q_ERROR );
}
command : DISPLAY_TEXT_
{ kb_error(3254,"Syntax: text_id := DISPLAY_TEXT(x,y,string)\n",Q_ERROR );
}
command : DELETE_TEXT_ '(' rexpr ')'
{ $$.i = makenode(DELETE_TEXT_,$3.i,0);
}
command : DELETE_TEXT_ error
{ kb_error(4684,"Syntax: DELETE_TEXT(text_id)\n",Q_ERROR );
}
/**************************************************************************/
rexpr : NEWVERTEX_ '(' exprlist ')'
{ $$.i = makenode(CREATE_VERTEX_,$3.i,0); }
rexpr : NEWVERTEX_ error { kb_error(2387,"Syntax: NEW_VERTEX(x,y,...) \n",Q_ERROR); }
/**************************************************************************/
rexpr : NEWEDGE_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(CREATE_EDGE_,$3.i,$5.i); }
rexpr : NEWEDGE_ error { kb_error(2388,"Syntax: NEW_EDGE(tail_id,head_id) \n",Q_ERROR); }
/**************************************************************************/
rexpr : NEWFACET_ '(' exprlist ')'
{ $$.i = makenode(CREATE_FACET_,$3.i,0); }
rexpr : NEWFACET_ error { kb_error(2389,"Syntax: NEW_FACET(edge1,edge2,...) \n",Q_ERROR); }
/**************************************************************************/
rexpr : NEWBODY_ { $$.i = makenode(CREATE_BODY_,0,0); }
rexpr : NEWBODY_ error { kb_error(2390,"Syntax: NEW_BODY \n",Q_ERROR); }
/**************************************************************************/
elindex : rexpr { $$.i = makenode(ELINDEX_,$1.i,0); }
elindex : rexpr '@' rexpr { $$.i = makenode(ELINDEX_,$1.i,$3.i); }
elindex : INTEGER_AT_ { $$.i = makenode(PUSH_ELEMENT_ID_,$1.i,$1.qnum); }
elindex : UMINUS_ INTEGER_AT_ { $$.i = makenode(PUSH_ELEMENT_ID_,-$1.i,$1.qnum); }
elindex : LEAD_INTEGER_AT_ { $$.i = makenode(PUSH_ELEMENT_ID_,$1.i,$1.qnum); }
elindex : UMINUS_ LEAD_INTEGER_AT_ { $$.i = makenode(PUSH_ELEMENT_ID_,-$1.i,$1.qnum); }
rexpr : VALID_ELEMENT_ '(' eltype '[' elindex ']' ')'
{ $$.i = makenode(VALID_ELEMENT_,$3.i,$5.i); }
rexpr : VALID_ELEMENT_ error
{ kb_error(3904,"Syntax: valid_element(element_type[expr]) \n",Q_ERROR); }
/**************************************************************************/
rexpr : VALID_CONSTRAINT_ '(' rexpr ')'
{ $$.i = makenode(VALID_CONSTRAINT_,$3.i,0); }
rexpr : VALID_CONSTRAINT_ error
{ kb_error(1901,"Syntax: valid_constraint(expr) \n",Q_ERROR); }
/**************************************************************************/
rexpr : VALID_BOUNDARY_ '(' rexpr ')'
{ $$.i = makenode(VALID_BOUNDARY_,$3.i,0); }
rexpr : VALID_BOUNDARY_ error
{ kb_error(3029,"Syntax: valid_boundary(expr) \n",Q_ERROR); }
/**************************************************************************/
vcommand : MERGE_VERTEX_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(MERGE_VERTEX_,$3.i,$5.i); }
vcommand : MERGE_VERTEX_ error
{ kb_error(3885,"Syntax: VERTEX_MERGE(first_id,second_id) \n",Q_ERROR); }
/**************************************************************************/
vcommand : MERGE_EDGE_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(MERGE_EDGE_,$3.i,$5.i); }
vcommand : MERGE_EDGE_ error
{ kb_error(3637,"Syntax: EDGE_MERGE(first_oid,second_oid) \n",Q_ERROR); }
/**************************************************************************/
vcommand : MERGE_FACET_ '(' rexpr ',' rexpr ')'
{ $$.i = makenode(MERGE_FACET_,$3.i,$5.i); }
vcommand : MERGE_FACET_ error
{ kb_error(3607,"Syntax: FACET_MERGE(first_oid,second_oid) \n",Q_ERROR); }
/**************************************************************************/
vcommand : MATRIX_MULTIPLY_ '(' arraylvalue ',' arraylvalue ',' arraylvalue ')'
{ int_val = $7.i; $$.i = makenode(MATRIX_MULTIPLY_,$3.i,$5.i); }
vcommand : MATRIX_MULTIPLY_ error
{ kb_error(3790,"matrix_multiply syntax: matrix_multiply(mat1,mat2,mat3)\n",
COMMAND_ERROR);
}
vcommand : MATRIX_MULTIPLY_ '(' arraylvalue ',' arraylvalue ',' error
{ kb_error(3791,"matrix_multiply third argument is not an array.\n",
COMMAND_ERROR);
}
vcommand : MATRIX_MULTIPLY_ '(' arraylvalue ',' error
{ kb_error(3792,"matrix_multiply second argument is not an array.\n",
COMMAND_ERROR);
}
vcommand : MATRIX_MULTIPLY_ '(' error
{ kb_error(3793,"matrix_multiply first argument is not an array.\n",
COMMAND_ERROR);
}
rexpr : MATRIX_DETERMINANT_ '(' arraylvalue ')'
{ $$.i = makenode(MATRIX_DETERMINANT_,$3.i,0); }
rexpr : MATRIX_INVERSE_ '(' arraylvalue ',' arraylvalue ')'
{ $$.i = makenode(MATRIX_INVERSE_,$3.i,$5.i); }
rexpr : MATRIX_INVERSE_ error
{ kb_error(3794,"matrix_inverse syntax: matrix_inverse(mat1,mat2)\n",
COMMAND_ERROR);
}
rexpr : MATRIX_INVERSE_ '(' arraylvalue ',' error
{ kb_error(3795,"matrix_inverse second argument is not an array.\n",
COMMAND_ERROR);
}
rexpr : MATRIX_INVERSE_ '(' error
{ kb_error(3796,"matrix_inverse first argument is not an array.\n",
COMMAND_ERROR);
}
/**************************************************************************/
verb : LIST_ { $$.i = LIST_; loopdepth++; }
vcommand : LIST_ error
{ erroutstring("Syntax: LIST element_gen [ name ] [ WHERE rexpr ]\n");
erroutstring(" LIST TOPINFO\n");
erroutstring(" LIST BOTTOMINFO\n");
erroutstring(" LIST ATTRIBUTES\n");
erroutstring(" LIST PROCEDURES\n");
erroutstring(" LIST QUANTITY quantityname\n");
erroutstring(" LIST METHOD_INSTANCE instancename\n");
erroutstring(" LIST CONSTRAINT rexpr or name\n");
erroutstring(" LIST BOUNDARY rexpr or name\n");
kb_error(1899,NULL,Q_ERROR);
}
/**************************************************************************/
verb : DELETE_ { $$.i = DELETE_; loopdepth++; }
vcommand : DELETE_ error
{ kb_error(2391,"Syntax: DELETE element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : VERTEX_AVERAGE_ { $$.i = VERTEX_AVERAGE_; loopdepth++; }
verb : RAW_VERTEX_AVERAGE_ { $$.i = RAW_VERTEX_AVERAGE_; loopdepth++; }
verb : RAWEST_VERTEX_AVERAGE_ { $$.i = RAWEST_VERTEX_AVERAGE_; loopdepth++; }
vcommand : VERTEX_AVERAGE_ error
{ kb_error(2392,"Syntax: VERTEX_AVERAGE element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
vcommand : RAW_VERTEX_AVERAGE_ error
{ kb_error(2393,"Syntax: RAW_VERTEX_AVERAGE element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
vcommand : RAWEST_VERTEX_AVERAGE_ error
{ kb_error(2394,"Syntax: RAWEST_VERTEX_AVERAGE element_gen [ name ] [ WHERE expr ]\n",Q_ERROR); }
/**************************************************************************/
verb : DISSOLVE_ { $$.i = DISSOLVE_; loopdepth++; }
vcommand : DISSOLVE_ error
{ kb_error(2395,"Syntax: DISSOLVE element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : REVERSE_ORIENTATION_ { $$.i = REVERSE_ORIENTATION_; loopdepth++; }
vcommand : REVERSE_ORIENTATION_ error
{ kb_error(3250,"Syntax: REVERSE_ORIENTATION element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : REFINE_ { $$.i = REFINE_; loopdepth++; }
vcommand : REFINE_ error
{ kb_error(2396,"Syntax: REFINE element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : EDGESWAP_ { $$.i = EDGESWAP_; loopdepth++; }
vcommand : EDGESWAP_ error
{ kb_error(2397,"Syntax: EDGESWAP edge_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : T1_EDGESWAP_ { $$.i = T1_EDGESWAP_; loopdepth++; }
vcommand : T1_EDGESWAP_ error
{ kb_error(4009,"Syntax: T1_EDGESWAP edge_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : EQUIANGULATE_ { $$.i = EQUIANGULATE_; loopdepth++; }
vcommand : EQUIANGULATE_ error
{ kb_error(2545,"Syntax: EQUIANGULATE_ edge_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : POP_ { $$.i = POP_; loopdepth++; }
vcommand : POP_ error
{ kb_error(2431,"Syntax: POP element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : POP_TRI_TO_EDGE_ { $$.i = POP_TRI_TO_EDGE_; loopdepth++; }
vcommand : POP_TRI_TO_EDGE_ error
{ kb_error(2800,
"Syntax: POP_TRI_TO_EDGE facet_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : POP_EDGE_TO_TRI_ { $$.i = POP_EDGE_TO_TRI_; loopdepth++; }
vcommand : POP_EDGE_TO_TRI_ error
{ kb_error(2801,"Syntax: POP_EDGE_TO_TRI edge_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : POP_QUAD_TO_QUAD_ { $$.i = POP_QUAD_TO_QUAD_; loopdepth++; }
vcommand : POP_QUAD_TO_QUAD_ error
{ kb_error(2802,"Syntax: POP_QUAD_TO_QUAD facet_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
verb : FIX_ { $$.i = FIX_; loopdepth++; }
verb : UNFIX_ { $$.i = UNFIX_; loopdepth++; }
vcommand : FIX_ IDENT_ { $$.i = makenode(FIX_PARAMETER_,$2.i,0); }
vcommand : UNFIX_ IDENT_ { $$.i = makenode(UNFIX_PARAMETER_,$2.i,0); }
vcommand : FIX_ QUANTITY_NAME_
{ $$.i = makenode(FIX_QUANTITY_,$2.i,0);}
vcommand : UNFIX_ QUANTITY_NAME_
{ $$.i = makenode(UNFIX_QUANTITY_,$2.i,0);}
vcommand : FIX_ error
{ kb_error(2398,"Syntax: FIX element_gen [ name ] [ WHERE rexpr ] or FIX quantity_name\n",
Q_ERROR); }
vcommand : UNFIX_ error
{ kb_error(2399,"Syntax: UNFIX element_gen [ name ] [ WHERE rexpr ] or UNFIX quantity_name\n",
Q_ERROR); }
/**************************************************************************/
eltype: VERTICES_ { if ( const_expr_flag ) YYABORT; $$.etype = $$.i = VERTEX; }
eltype: EDGES_ { if ( const_expr_flag ) YYABORT; $$.etype = $$.i = EDGE ; }
eltype: FACETS_ { if ( const_expr_flag ) YYABORT; $$.etype = $$.i = FACET ; }
eltype: BODIES_ { if ( const_expr_flag ) YYABORT; $$.etype = $$.i = BODY ; }
eltype: FACETEDGES_ { if ( const_expr_flag ) YYABORT; $$.etype = $$.i = FACETEDGE; }
multiple: eltype
{ int next;
next = makenode(INIT_ELEMENT_,$1.i,0);
$$.i = makenode(NEXT_ELEMENT_,next,0);
$$.etype = $1.i;
}
multiple: singlep eltype
{ int next;
next = makenode(INIT_SUBELEMENT_,$1.i,$2.i);
$$.i = makenode(NEXT_ELEMENT_,next,0);
$$.etype = $2.etype;
}
/*
single: rexpr { if ( list[$1].datatype < VERTEX_TYPE ||
list[$1].datatype > FACETEDGE_TYPE )
kb_error(3712,"Need element here.\n",COMMAND_ERROR);
$$ = $1;
}
*/
single: eltype '[' elindex ']'
{ verb_flag = 0; $$.i = makenode(INDEXED_ELEMENT_,$1.i,$3.i);
$$.etype = $1.i; }
single: eltype '[' error
{ kb_error(3809,"Missing index of element.\n",Q_ERROR); }
single: eltype '[' rexpr error
{ kb_error(3832,"Missing right bracket after index expression.\n",Q_ERROR); }
single: SYMBOL_ { verb_flag = 0; $$.i = makenode(SYMBOL_ELEMENT_,$1.i,0);
$$.etype = list[$$.i].op1.eltype; }
single: SELF_
{ verb_flag = 0;
elsym = symbol_lookup("self");
if ( elsym == NULL )
kb_error(2400,"SELF not defined, since not in attribute function def.\n",
COMMAND_ERROR);
$$.i = makenode(SELF_ELEMENT_,elsym->type,0);
$$.etype = elsym->type;
}
single: ELEMENT_IDENT_ { verb_flag = 0; $$.i = makenode(ELEMENT_IDENT_,$1.i,0);
list[$$.i].op1.eltype = $1.etype;
$$.etype = $1.etype; }
singlep: single '.' { $$ = $1; }
singlep: single { $$ = $1; }
single: singlep eltype '[' rexpr ']'
{ subtype = $2.i; $$.i = makenode(INDEXED_SUBTYPE_,$1.i,$4.i);
$$.etype = $2.etype; }
single: singlep eltype '[' error
{ kb_error(3810,"Missing index of element.\n",Q_ERROR); }
single: singlep eltype '[' rexpr error
{ kb_error(3812,"Missing right bracket after index expression.\n",Q_ERROR); }
/* turn off element as datatype for now
rexpr: single { $$.i = makenode(SINGLE_ELEMENT_EXPR_,$1.i,$1.etype); }
*/
element_gen: singlep
{ int type = list[$1.i].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add(default_name,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,default_name);
$1.symptr = elsym;
$$.i = makenode(SINGLE_ELEMENT_,$1.i,0);
$$.symptr = elsym;
$$.etype = $1.etype;
}
element_gen: single NEWIDENT_
{ int type = list[$1.i].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add($2.lexeme,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,$2.lexeme);
$$.i = makenode(SINGLE_ELEMENT_,$1.i,0);
list[$1.i].op5.string =
(char*)mycalloc(strlen(elsym->name)+1,1);
list[$1.i].flags |= HAS_STRING_5;
strcpy(list[$1.i].op5.string,elsym->name);
$1.symptr = elsym;
$$.symptr = elsym;
elsym = symbol_add(default_name,type); /* current id as default */
elsym->localnum = list[$1.i].op2.localnum;
$$.etype = $1.etype;
}
element_gen: multiple
{ int type = list[$1.i+list[$1.i].left].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add(default_name,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,default_name);
list[$1.i].op5.string =
(char*)mycalloc(strlen(default_name)+1,1);
list[$1.i].flags |= HAS_STRING_5;
strcpy(list[$1.i].op5.string,default_name);
$1.symptr = elsym;
$$.symptr = elsym;
$$.i = $1.i;
$$.etype = $1.etype;
}
element_gen: multiple NEWIDENT_
{ int type = list[$1.i+list[$1.i].left].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add($2.lexeme,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,$2.lexeme);
list[$1.i].op5.string =
(char*)mycalloc(strlen(elsym->name)+1,1);
list[$1.i].flags |= HAS_STRING_5;
strcpy(list[$1.i].op5.string,elsym->name);
$1.symptr = elsym;
$$.symptr = elsym;
$$.i = $1.i;
elsym = symbol_add(default_name,type); /* current id as default */
elsym->localnum = list[$1.i].op2.localnum;
$$.etype = $1.etype;
}
element_gen: single PROCEDURE_
{ kb_error(1890,"Name already in use as procedure name.\n",COMMAND_ERROR); }
element_gen: multiple PROCEDURE_
{ kb_error(1891,"Name already in use as procedure name.\n",COMMAND_ERROR); }
element_gen: single IDENT_
{ kb_error(1892,"Name already in use as variable name.\n",COMMAND_ERROR); }
element_gen: multiple IDENT_
{ kb_error(1893,"Name already in use as variable name.\n",COMMAND_ERROR); }
element_gen : element_gen WHERE_ rexpr
{ $$.i = makenode(WHERE_,$1.i,$3.i);
$$.symptr = $1.symptr;
}
element_gen : element_gen WHERE_ error
{ kb_error(3901,"Missing boolean expression after WHERE.\n",Q_ERROR); }
/*****************************************************************************/
toggle: ON_ { $$.i = ON_; }
toggle: OFF_ { $$.i = OFF_; }
/**************************************************************************/
quotation_concat : QUOTATION_ { $$.i = makenode(QUOTATION_,0,0); }
quotation_concat : quotation_concat QUOTATION_
{ int size1 = strlen(list[$$.i].op1.string);
int size2 = strlen(yytext);
$$.i = $1.i;
list[$$.i].op1.string = (char*)kb_realloc(list[$$.i].op1.string,
size1+size2+1);
strncpy(list[$$.i].op1.string+size1,yytext,size2);
}
stringexpr : quotation_concat { $$.i = $1.i }
stringexpr : STRINGGLOBAL_ { $$.i = makenode(STRINGGLOBAL_,$1.i,0); }
stringexpr : PERM_STRINGGLOBAL_ { $$.i = makenode(PERM_STRINGGLOBAL_,$1.i,0); }
stringexpr : DATAFILENAME_ { $$.i = makenode(DATAFILENAME_,$1.i,0); }
stringexpr : WARNING_MESSAGES_ { $$.i = makenode(WARNING_MESSAGES_,$1.i,0); }
stringexpr : DATE_AND_TIME_ { $$.i = makenode(DATE_AND_TIME_,0,0); }
stringexpr : TRANSFORM_EXPR_ { $$.i = makenode(GET_TRANSFORM_EXPR_,0,0); }
sprintfhead : SPRINTF_ stringexpr
{ $$.i = makenode(SPRINTFHEAD_,$2.i,0); }
sprintfhead : SPRINTF_ error
{ kb_error(3894,"Missing format string after SPRINTF.\n",Q_ERROR); }
stringexpr : sprintfhead { $$.i = $1.i; }
stringexpr : sprintfhead ',' exprlist { $$.i = makenode(SPRINTF_,$1.i,$3.i); }
stringexpr : sprintfhead ',' error
{ kb_error(3806,"Error in SPRINTF arguments.\n",Q_ERROR); }
/**************************************************************************/
getattrib : COORD_ { $$.qnum = $1.i; $$.i = COORD_; $$.datatype=REAL_TYPE; }
getattrib : PARAM_ { $$.qnum = $1.i; $$.i = PARAM_; $$.datatype=REAL_TYPE; }
getattrib : LENGTH_ { $$.i = GET_LENGTH_; $$.datatype=REAL_TYPE; }
getattrib : MEAN_CURVATURE_ { $$.i = GET_MEANCURV_; $$.datatype=REAL_TYPE; }
getattrib : SHOW_ { $$.i = GET_SHOW_; $$.datatype=REAL_TYPE; }
getattrib : ORIENTATION_ { $$.i = GET_ORIENTATION_; $$.datatype=REAL_TYPE; }
getattrib : STAR_ { $$.i = GET_STAR_; $$.datatype=REAL_TYPE; }
getattrib : SQ_MEAN_CURV_ { $$.i = GET_SQ_MEAN_CURV_; $$.datatype=REAL_TYPE; }
getattrib : DIHEDRAL_ { $$.i = GET_DIHEDRAL_; $$.datatype=REAL_TYPE; }
getattrib : VALENCE_ { $$.i = GET_VALENCE_; $$.datatype=REAL_TYPE; }
getattrib : AREA_ { $$.i = GET_AREA_; $$.datatype=REAL_TYPE; }
getattrib : VOLUME_ { $$.i = GET_VOLUME_; $$.datatype=REAL_TYPE; }
getattrib : VOLCONST_ { $$.i = GET_VOLCONST_; $$.datatype=REAL_TYPE; }
getattrib : TARGET_ { $$.i = GET_TARGET_; $$.datatype=REAL_TYPE; }
getattrib : MPI_TASK_ATTR_ { $$.i = GET_MPI_TASK_; $$.datatype=REAL_TYPE; }
getattrib : DENSITY_ { $$.i = GET_DENSITY_; $$.datatype=REAL_TYPE; }
getattrib : PRESSURE_ { $$.i = GET_PRESSURE_; $$.datatype=REAL_TYPE; }
getattrib : ID_ { $$.i = GET_ID_; $$.datatype=REAL_TYPE; }
getattrib : OID_ { $$.i = GET_OID_; $$.datatype=REAL_TYPE; }
getattrib : TAG_ { $$.i = GET_TAG_; $$.datatype=REAL_TYPE; }
getattrib : COLOR_ { $$.i = GET_COLOR_; $$.datatype=REAL_TYPE; }
getattrib : FRONTCOLOR_ { $$.i = GET_FRONTCOLOR_; $$.datatype=REAL_TYPE; }
getattrib : BACKCOLOR_ { $$.i = GET_BACKCOLOR_; $$.datatype=REAL_TYPE; }
getattrib : BACKBODY_ { $$.i = GET_BACKBODY_; $$.datatype=REAL_TYPE; }
getattrib : FRONTBODY_ { $$.i = GET_FRONTBODY_; $$.datatype=REAL_TYPE; }
getattrib : ORIGINAL_ { $$.i = GET_ORIGINAL_; $$.datatype=REAL_TYPE; }
getattrib : FIXED_ { $$.i = GET_FIXED_; $$.datatype=REAL_TYPE; }
getattrib : NO_REFINE_ { $$.i = GET_NO_REFINE_; $$.datatype=REAL_TYPE; }
getattrib : HIT_PARTNER_ { $$.i = GET_HIT_PARTNER_; $$.datatype=REAL_TYPE;}
getattrib : NONCONTENT_ { $$.i = GET_NONCONTENT_; $$.datatype=REAL_TYPE; }
getattrib : NODISPLAY_ { $$.i = GET_NO_DISPLAY_; $$.datatype=REAL_TYPE; }
getattrib : FIXEDVOL_ { $$.i = GET_FIXEDVOL_; $$.datatype=REAL_TYPE; }
getattrib : AXIAL_POINT_ { $$.i = GET_AXIAL_POINT_; $$.datatype=REAL_TYPE; }
getattrib : TRIPLE_POINT_ { $$.i = GET_TRIPLE_PT_; $$.datatype=REAL_TYPE; }
getattrib : TETRA_POINT_ { $$.i = GET_TETRA_PT_; $$.datatype=REAL_TYPE; }
getattrib : MIDV_ { $$.i = GET_MIDV_; $$.datatype=REAL_TYPE; }
getattrib : WRAP_ { $$.i = GET_WRAP_; $$.datatype=REAL_TYPE; }
getattrib : MID_EDGE_ { $$.i = GET_MID_EDGE_; $$.datatype=REAL_TYPE; }
getattrib : MID_FACET_ { $$.i = GET_MID_FACET_; $$.datatype=REAL_TYPE; }
getattrib : BARE_ { $$.i = GET_BARE_; $$.datatype=REAL_TYPE; }
getattrib : PHASE_ { $$.i = GET_PHASE_; $$.datatype=REAL_TYPE; }
getattrib : QUANTITY_NAME_ { $$.qnum = $1.i; $$.i = GET_QUANTITY_; $$.datatype=REAL_TYPE; }
getattrib : METHOD_NAME_ { $$.qnum = $1.i; $$.i = GET_INSTANCE_; $$.datatype=REAL_TYPE; }
getattrib : EXTRA_ATTRIBUTE_
{ struct extra *ex;
$$.i = GET_EXTRA_ATTR_ ;
$$.qnum = $1.qnum + ($1.etype << YYTYPESHIFT);
$$.etype = $1.etype;
ex = EXTRAS($1.etype) + $1.qnum;
$$.datatype= (ex->type <= MAX_NUMERIC_TYPE) ? REAL_TYPE : ex->type;
}
ggetattrib: getattrib
{ if ( const_expr_flag ) { YYABORT; /* illegal for const rexpr */ }
$$= $1;
}
fullattrib: ggetattrib
{
if ( (datafile_flag && boundary_expr_flag && ($1.i==PARAM_))
|| ( datafile_flag && ($1.i==COORD_) ) )
{ coord_num = $1.qnum; $$.i = makenode(PUSHPARAM,0,0); }
else
{
$$.i = makenode(ATTRIBUTE,$1.i,$1.qnum);
$$.datatype = list[$$.i].datatype = $1.datatype;
}
}
fullattrib: ggetattrib indexset
{
if ( const_expr_flag ) { YYABORT; /* illegal for const rexpr */ }
switch ( $1.i )
{ case COORD_:
$$.i = makenode(INDEXED_COORD_,$2.i,0);
break;
case GET_VERTEXNORMAL_:
$$.i = makenode(GET_VERTEXNORMAL_,$2.i,0);
break;
case PARAM_:
if ( $1.etype == VERTEX )
{ $$.qnum = V_PARAM_ATTR;
$$.i =
makenode(INDEXED_ATTRIBUTE,$2.i,$$.qnum+($1.etype<type);
list[$1.i].op1.localnum = elsym->localnum;
}
else kb_error(1896,"\nMissing element for attribute. (Get quantity value with name.value) \n",COMMAND_ERROR);
}
list[$1.i].datatype = $1.datatype;
}
rexpr : singlep fullattrib
{ $$.i = makenode(QUALIFIED_ATTRIBUTE,$1.i,$2.i);
list[$2.i].op1.localnum = list[$1.i].op2.localnum;
list[$$.i].datatype = $2.datatype;
}
rexpr : singlep NEWIDENT_
{ sprintf(errmsg,"\"%s\" is not a attribute name.\n",$2.lexeme);
kb_error(3458,errmsg,Q_ERROR);
}
/**************************************************************************/
rexpr : IS_DEFINED_ '(' stringexpr ')' { $$.i = makenode(IS_DEFINED_,$3.i,0); }
rexpr : IS_DEFINED_ error
{ kb_error(3814,"Syntax: IS_DEFINED ( quoted_string )\n",Q_ERROR); }
rexpr : IS_DEFINED_ '(' stringexpr
{ kb_error(3815,"Missing closing parenthesis for IS_DEFINED\n",Q_ERROR); }
/**************************************************************************/
rexpr : SIZEOF_ '(' ARRAY_ATTRIBUTE_ ')'
{ int etype;
$$.qnum = $3.qnum;
etype = $3.etype;
$$.i = makenode(SIZEOF_ATTR_,$$.qnum,etype); }
rexpr : SIZEOF_ '(' ARRAYIDENT_ ')'
{ $$.i = makenode(SIZEOF_ARRAY_,$3.i,0); }
rexpr : SIZEOF_ '(' stringexpr ')'
{ $$.i = makenode(SIZEOF_STRING_,$3.i,0); }
rexpr : SIZEOF_ error
{ strcpy(errmsg,"Syntax: SIZEOF ( extra_attribute )\n");
strcat(errmsg," SIZEOF ( array_name ) \n");
strcat(errmsg," SIZEOF ( string_expr ) \n");
kb_error(3816,errmsg,Q_ERROR);
}
/**************************************************************************/
rexpr : TOGGLEVALUE_ { $$.i = makenode(TOGGLEVALUE,$1.i,0); }
rexpr : AUTOCHOP_ { $$.i = makenode(TOGGLEVALUE,AUTOCHOP_,0); }
rexpr : LAGRANGE_ { $$.i = makenode(TOGGLEVALUE,LAGRANGE_,0); }
rexpr : EPRINT_ rexpr { $$.i = makenode(EPRINT_,$2.i,0); }
rexpr : EPRINT_ error
{ kb_error(2886,"Syntax: EPRINT expression\n",Q_ERROR); }
/**************************************************************************/
rexpr : '(' rexpr ')' { $$.i = $2.i; }
rexpr : '(' error { kb_error(2401,"Missing closing parenthesis?\n",Q_ERROR); }
/**************************************************************************/
rexpr : INTERNAL_VARIABLE_ { $$.i = makenode(GET_INTERNAL_,$1.i,0); }
rexpr : SCALE_ { $$.i = makenode(GET_INTERNAL_,V_SCALE,0); }
rexpr : IDENT_ { $$.i = makenode(PUSHGLOBAL_,$1.i,0); }
rexpr : PERM_IDENT_ { $$.i = makenode(PUSH_PERM_GLOBAL_,$1.i,0); }
/**************************************************************************/
rexpr : IDENT_ '.' EXTRA_ATTRIBUTE_ { $$.i = makenode(PUSH_PARAM_EXTRA_,$1.i,$3.i); }
rexpr : IDENT_ '.' error
{ kb_error(3817,"Permitted optimizing parameter attributes: pdelta pscale\n",
Q_ERROR);
}
/**************************************************************************/
rexpr : DYNAMIC_LOAD_FUNC_ { $$.i = makenode(DYNAMIC_LOAD_FUNC_,$1.i,0); }
rexpr : TOTAL_ QUANTITY_NAME_ { $$.i = makenode(PUSHQVALUE_,$2.i,0); }
rexpr : QUANTITY_NAME_ '.' PRESSURE_ { $$.i = makenode(PUSHQPRESSURE_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' MODULUS_ { $$.i = makenode(PUSHQMODULUS_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' TOLERANCE_ { $$.i = makenode(PUSHQTOLERANCE_,$1.i,0); }
rexpr : METHOD_NAME_ '.' MODULUS_ { $$.i = makenode(PUSHMMODULUS_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' TARGET_ { $$.i = makenode(PUSHQTARGET_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' VALUE_ { $$.i = makenode(PUSHQVALUE_,$1.i,0); }
rexpr : METHOD_NAME_ '.' VALUE_ { $$.i = makenode(PUSHMVALUE_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' VOLCONST_ { $$.i = makenode(PUSHQVOLCONST_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' FIXED_ { $$.i = makenode(PUSHQFIXED_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' ENERGY_ { $$.i = makenode(PUSHQENERGY_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' INFO_ONLY_ { $$.i = makenode(PUSHQINFO_ONLY_,$1.i,0); }
rexpr : QUANTITY_NAME_ '.' CONSERVED_ { $$.i = makenode(PUSHQCONSERVED_,$1.i,0); }
rexpr : QUANTITY_NAME_ error
{ strcpy(errmsg,
"Quantity name needs attribute. Syntax: quantityname.attribute\n");
strcat(errmsg,"Possible quantity attributes: \n");
strcat(errmsg," value, modulus, pressure, target, tolerance, volconst,\n");
strcat(errmsg," fixed, energy, info_only, conserved\n");
kb_error(3818,errmsg,Q_ERROR);
}
rexpr : QUANTITY_NAME_ '.' error
{ strcpy(errmsg,"Possible quantity attributes: \n");
strcat(errmsg," value, modulus, pressure, target, tolerance, volconst,\n");
strcat(errmsg," fixed, energy, info_only, conserved\n");
kb_error(3819,errmsg,Q_ERROR);
}
rexpr : METHOD_NAME_ '.' error
{ kb_error(3907,"Possible method instance attributes: value, modulus \n",
Q_ERROR);
}
rexpr : METHOD_NAME_ error
{ strcpy(errmsg,
"Method instance name needs attribute. Syntax: instancename.attribute\n");
strcat(errmsg,"Possible method instance attributes: value, modulus \n");
kb_error(3820,errmsg,Q_ERROR);
}
/**************************************************************************/
rexpr : INTEGER_ { real_val = (REAL)$1.i; $$.i = makenode(PUSHCONST,0,0); }
rexpr : LEAD_INTEGER_
{
real_val = (REAL)$1.i; $$.i = makenode(PUSHCONST,0,0);
}
rexpr : REAL_ { real_val = $1.r; $$.i = makenode(PUSHCONST,0,0); }
signed_expr : SIGNED_NUMBER_ { real_val = $1.r; $$.i = makenode(PUSHCONST,0,0); }
rexpr : signed_expr { $$.i = $1.i; }
rexpr : PI_ { $$.i = makenode(PUSHPI,0,0); }
rexpr : E_ { $$.i = makenode(PUSHE,0,0); }
rexpr : G_ { $$.i = makenode(PUSHG,0,0); }
rexpr : USERFUNC_ { int_val = $1.i; $$.i = makenode(USERFUNC,0,0); }
rexpr : MATHFUNC_ '(' rexpr ')' { $$.i = makenode($1.i,(NTYPE)$3.i,0); }
rexpr : MATHFUNC_ error
{ sprintf(errmsg,"Syntax: %s ( rexpr )\n",keywordname($1.i));
kb_error(3821,errmsg,Q_ERROR);
}
rexpr : MATHFUNC2_ '(' rexpr ',' rexpr ')' { $$.i = makenode($1.i,(NTYPE)$3.i,$5.i); }
rexpr : MATHFUNC2_
{ sprintf(errmsg,"Syntax: %s ( rexpr , rexpr )\n",keywordname($1.i));
kb_error(3822,errmsg,Q_ERROR);
}
/* binary operations kept separate for precedence purposes */
rexpr : rexpr '+' rexpr { $$.i = makenode('+',(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '-' rexpr { $$.i = makenode('-',(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '=' rexpr { $$.i = makenode('=',(NTYPE)$1.i,(NTYPE)$3.i); } /* for constraints */
rexpr : rexpr '/' rexpr { $$.i = makenode('/',(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '*' rexpr { $$.i = makenode('*',(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '%' rexpr { $$.i = makenode('%',(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr IMOD_ rexpr { $$.i = makenode(IMOD_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr IDIV_ rexpr { $$.i = makenode(IDIV_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '^' rexpr { $$.i = makenode(POW,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '<' rexpr { $$.i = makenode(LT_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '>' rexpr { $$.i = makenode(GT_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr NE_ rexpr { $$.i = makenode(NE_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr EQ_ rexpr { $$.i = makenode(EQ_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr LE_ rexpr { $$.i = makenode(LE_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr GE_ rexpr { $$.i = makenode(GE_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr AND_ rexpr { $$.i = makenode(AND_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr OR_ rexpr { $$.i = makenode(OR_,(NTYPE)$1.i,(NTYPE)$3.i); }
rexpr : rexpr '+' arraylvalue error
{ kb_error(3031,"Cannot add scalar and array\n",Q_ERROR); }
rexpr : rexpr '-' arraylvalue error
{ kb_error(3027,"Cannot subtract scalar and array\n",Q_ERROR); }
rexpr : rexpr '+' error
{ kb_error(3823,"Bad second expression after +\n",Q_ERROR); }
rexpr : rexpr '-' error
{ kb_error(3825,"Bad second expression after -\n",Q_ERROR); }
rexpr : rexpr '=' error
{ kb_error(3828,"Bad second expression after =\n",Q_ERROR); }
rexpr : rexpr '/' error
{ kb_error(3829,"Bad second expression after /\n",Q_ERROR); }
rexpr : rexpr '*' error
{ kb_error(3830,"Bad second expression after *\n",Q_ERROR); }
rexpr : rexpr '%' error
{ kb_error(3831,"Bad second expression after %\n",Q_ERROR); }
rexpr : rexpr IMOD_ error
{ kb_error(2887,"Bad second expression after IMOD\n",Q_ERROR); }
rexpr : rexpr IDIV_ error
{ kb_error(3919,"Bad second expression after IDIV\n",Q_ERROR); }
rexpr : rexpr '^' error
{ kb_error(3920,"Bad second expression after ^\n",Q_ERROR); }
rexpr : rexpr '<' error
{ kb_error(3921,"Bad second expression after <\n",Q_ERROR); }
rexpr : rexpr '>' error
{ kb_error(3922,"Bad second expression after >\n",Q_ERROR); }
rexpr : rexpr NE_ error
{ kb_error(3923,"Bad second expression after !=\n",Q_ERROR); }
rexpr : rexpr EQ_ error
{ kb_error(3924,"Bad second expression after ==\n",Q_ERROR); }
rexpr : rexpr LE_ error
{ kb_error(3925,"Bad second expression after <=\n",Q_ERROR); }
rexpr : rexpr GE_ error
{ kb_error(3926,"Bad second expression after >=\n",Q_ERROR); }
rexpr : rexpr AND_ error
{ kb_error(3927,"Bad second expression after AND\n",Q_ERROR); }
rexpr : rexpr OR_ error
{ kb_error(3928,"Bad second expression after OR\n",Q_ERROR); }
/**************************************************************************/
rexpr : UMINUS_ rexpr { $$.i = makenode(CHS,(NTYPE)$2.i,0); }
rexpr : UMINUS_ error
{ kb_error(3826,"Bad expression after unary minus.\n",Q_ERROR); }
rexpr : UPLUS_ rexpr { $$.i = $2.i; }
rexpr : NOT_ rexpr { $$.i = makenode(NOT_,(NTYPE)$2.i,0); }
rexpr : NOT_ error
{ kb_error(3827,"Bad expression after NOT.\n",Q_ERROR); }
/**************************************************************************/
rexpr : rexpr '?' { cond_expr_flag++; $$.i = makenode(COND_TEST_,$1.i,0); }
rexpr ':' { cond_expr_flag--; $$.i = makenode(COND_EXPR_,$3.i,$4.i); }
rexpr { $$.i = makenode(COND_ELSE_,$6.i,$7.i); }
rexpr : rexpr '?' error
{ kb_error(3824,"Conditional expression syntax: expr1 ? expr2 : expr3\n",
Q_ERROR);
}
/**************************************************************************/
aggregate : MAX_ { $$.i = MAX_; }
aggregate : MIN_ { $$.i = MIN_; }
aggregate : SUM_ { $$.i = SUM_; }
aggregate : AVG_ { $$.i = AVG_; }
aggregate : COUNT_ { $$.i = COUNT_; }
histotype : HISTOGRAM_ { $$.i = HISTOGRAM_; }
histotype : LOGHISTOGRAM_ { $$.i = LOGHISTOGRAM_; }
vcommand : HISTOGRAM_ error
{ kb_error(2402,"Syntax: HISTOGRAM(element_gen,expression)\n", Q_ERROR); }
vcommand : LOGHISTOGRAM_ error
{ kb_error(2403,"Syntax: LOGHISTOGRAM(element_gen,expression)\n", Q_ERROR); }
/**************************************************************************/
foreachhead : FOREACH_ { aggrtype = FOREACH_; loopdepth++;
$$.i = makenode(AGGREGATE_INIT_,0,0); }
vcommand: foreachhead element_gen DO_ command
{ int aggr;
aggrtype = FOREACH_;
aggr = makenode(AGGREGATE_,$2.i,$4.i);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : FOREACH_ error
{ kb_error(2404,
"Syntax: FOREACH element_gen [ name ] [WHERE expr] DO command\n",Q_ERROR);}
/**************************************************************************/
vcommand : SHOWVERB_ { use_given_id = 1; /* in eval() */ } element_gen
{ $$.i = makenode(SHOW_,$3.i,0);
use_given_id = 0;
end_scope();
}
vcommand: SHOWVERB_ { $$.i = makenode(SINGLE_LETTER_,'s',0); }
vcommand: SHOWVERB_ error
{ kb_error(2405,"Syntax: SHOW element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR);}
/**************************************************************************/
vcommand : SHOW_EXPR_ { use_given_id = 1; /* in eval() */ } element_gen
{ $$.i = makenode(SHOW_EXPR_,$3.i,0);
use_given_id = 0;
end_scope();
}
vcommand : SHOW_EXPR_ error
{ kb_error(2406,"Syntax: SHOW_EXPR element_gen [ name ] [ WHERE rexpr ]\n",Q_ERROR);}
/**************************************************************************/
vcommand : histotype { loopdepth++;
aggrtype = $1.i; $$.i = makenode(AGGREGATE_INIT_,0,0); }
'(' element_gen ',' rexpr ')'
{ int aggr;
aggrtype = $1.i;
aggr = makenode(AGGREGATE_,$4.i,$6.i);
$$.i = makenode(AGGREGATE_END_,$2.i,aggr);
end_scope();
}
rexpr : aggregate { loopdepth++;
aggrtype = $1.i; $$.i = makenode(AGGREGATE_INIT_,0,0); }
'(' element_gen ',' rexpr ')'
{ int aggr;
aggrtype = $1.i;
aggr = makenode(AGGREGATE_,$4.i,$6.i);
$$.i = makenode(AGGREGATE_END_,$2.i,aggr);
end_scope();
}
vcommand : verb
{ aggrtype = $1.i;
$$.i = makenode(AGGREGATE_INIT_,0,0);
}
element_gen
{ int aggr;
aggrtype = $1.i;
aggr = makenode(AGGREGATE_,$3.i,0);
$$.i = makenode(AGGREGATE_END_,$2.i,aggr);
end_scope();
}
set : SET_ { $$.i = makenode(SET_INIT_,0,0); }
/* set_attrib for settable attributes without values */
set_attrib : NO_REFINE_ { $$.i = SET_NO_REFINE_ ; }
set_attrib : HIT_PARTNER_ { $$.i = SET_HIT_PARTNER_ ; }
set_attrib : FIXED_ { $$.i = SET_FIXED_ ; }
set_attrib : BARE_ { $$.i = SET_BARE_ ; }
set_attrib : NONCONTENT_ { $$.i = SET_NONCONTENT_ ; }
set_attrib : NODISPLAY_ { $$.i = SET_NO_DISPLAY_ ; }
set_attrib : AXIAL_POINT_ { $$.i = SET_AXIAL_POINT_ ; }
set_attrib : TETRA_POINT_ { $$.i = SET_TETRA_PT_; }
set_attrib : TRIPLE_POINT_ { $$.i = SET_TRIPLE_PT_; }
vcommand : set element_gen set_attrib
{ int aggr;
aggrtype = $3.i;
aggr = makenode(AGGREGATE_,$2.i,0);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen set_attrib WHERE_ rexpr
{ int aggr,where;
aggrtype = $3.i;
where = makenode(WHERE_,$2.i,$5.i);
aggr = makenode(AGGREGATE_,where,0);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
/* setattrib for settable attributes with values */
setattrib : FRONTBODY_ { $$.i = SET_FRONTBODY_; tok=0; /* for UMINUS */ }
setattrib : BACKBODY_ { $$.i = SET_BACKBODY_; tok=0; }
setattrib : COLOR_ { $$.i = SET_COLOR_; tok=0; }
setattrib : FRONTCOLOR_ { $$.i = SET_FRONTCOLOR_; tok=0; }
setattrib : BACKCOLOR_ { $$.i = SET_BACKCOLOR_; tok=0; }
setattrib : DENSITY_ { $$.i = SET_DENSITY_; tok=0; }
setattrib : ORIGINAL_ { $$.i = SET_ORIGINAL_; tok=0; }
setattrib : VOLCONST_ { $$.i = SET_VOLCONST_; tok=0; }
setattrib : VOLUME_ { $$.i = SET_VOLUME_; tok=0; }
setattrib : TARGET_ { $$.i = SET_TARGET_; tok=0; }
setattrib : PRESSURE_ { $$.i = SET_PRESSURE_; tok=0; }
setattrib : OPACITY_ { $$.i = SET_OPACITY_; tok=0; }
setattrib : CONSTRAINT_ { $$.i = SET_CONSTRAINT_; tok=0; }
setattrib : BOUNDARY_ { $$.i = SET_BOUNDARY_; tok=0; }
setattrib : TAG_ { $$.i = SET_TAG_; tok=0; }
setattrib : COORD_ { $$.i = SET_COORD_+$1.i; tok = 0; /* UMINUS bug */ }
setattrib : PARAM_ { $$.i = SET_PARAM_+$1.i; tok=0; }
setattrib : PHASE_ { $$.i = SET_PHASE_; tok=0; }
setattrib : EXTRA_ATTRIBUTE_ { $$.i = SET_EXTRA_ATTR_ ; tok=0;
$$.qnum = $1.qnum;
$$.etype = $1.etype;
strcpy(set_extra_name,EXTRAS($$.etype)[$$.qnum].name); }
setattrib : ORIENTATION_ { $$.i = SET_ORIENTATION_ ; tok=0; }
setattrib : WRAP_ { $$.i = SET_WRAP_ ; tok = 0;}
setattribb : '.' setattrib { $$.i = $2.i;}
setattribb : setattrib { $$.i = $1.i;}
assignop : ASSIGN_ { $$.i = ASSIGN_; }
assignop : ASSIGNOP_ { $$.i = $1.i; }
assignop : EQ_ { kb_error(3415,"Expected assignment operator, got '='\n",
Q_ERROR);
}
command : single '.' setattrib { $$.i = makenode(SINGLE_ELEMENT_,$1.i,0); }
assignop rexpr
{ int mm;
int type = list[$1.i].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add(default_name,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,default_name);
$1.symptr = elsym;
attr_kind = $3.i;
$4.symptr = 0; /* in case of WHERE */
assigntype = $5.i;
mm = makenode(SET_ATTRIBUTE_A,$6.i,0);
$$.i = makenode(SINGLE_ASSIGN_,$4.i,mm);
end_scope();
}
command : single '.' setattrib { $$.i = makenode(SINGLE_ELEMENT_,$1.i,0); }
indexset assignop rexpr
{ int mm;
int type = list[$1.i].op1.eltype;
begin_scope(); /* ended at end of aggregate */
elsym = symbol_add(default_name,type);
elsym->localnum = list[$1.i].op2.localnum;
strcpy(last_name,default_name);
$1.symptr = elsym;
attr_kind = $3.i;
subtree_swap(&$5.i,&$7.i);
$4.symptr = 0; /* in case of WHERE */
assigntype = $6.i;
mm = makenode(SET_ATTRIBUTE_A,$7.i,$5.i);
$$.i = makenode(SINGLE_ASSIGN_,$4.i,mm);
end_scope();
}
vcommand : set element_gen setattribb rexpr
{ int aggr;
int nn;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
nn = makenode(SET_ATTRIBUTE_L,$4.i,0);
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen setattribb indexset rexpr
{ int aggr;
int nn;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
subtree_swap(&$4.i,&$5.i); /* get index eval in top of stack */
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
nn = makenode(SET_ATTRIBUTE_L,$5.i,$4.i);
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ indexset rexpr
{ int aggr;
int nn,mm,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$5.i,&kk); /* so datastart before rexpr */
subtree_swap(&$4.i,&kk); /* so datastart before indexset */
mm = makenode(ARRAY_LVALUE_INDEXED_,kk,$4.i);
nn = makenode(ARRAY_ASSIGNOP_SINGLE_,mm,$5.i);
list[nn].flags |= SET_ASSIGNOP;
list[nn].op1.assigntype = ASSIGN_;
list[nn].op2.name_id = set_name_eltype($3.qnum,$3.etype);
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ arraylvalue
{ int aggr;
int nn,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$4.i,&kk); /* so lvalue before rvalue */
nn = makenode(ARRAY_ASSIGNOP_ARRAY_,kk,$4.i);
list[nn].flags |= SET_ASSIGNOP;
list[nn].op1.assigntype = ASSIGN_;
list[nn].op2.name_id = set_name_eltype($3.qnum,$3.etype);
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ rexpr
{ int aggr;
int nn,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$4.i,&kk); /* so rexpr before datastart */
nn = makenode(ARRAY_ASSIGNOP_SCALAR_,kk,$4.i);
list[nn].op1.assigntype = ASSIGN_;
list[nn].op2.name_id = set_name_eltype($3.qnum,$3.etype);
list[nn].flags |= SET_ASSIGNOP;
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ rexpr WHERE_ rexpr
{ int aggr,where;
int nn,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
/* splice in the WHERE clause */
subtree_swap(&$4.i,&$6.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$4.i,&kk); /* so rexpr before datastart */
nn = makenode(ARRAY_ASSIGNOP_SCALAR_,kk,$4.i);
list[nn].flags |= SET_ASSIGNOP;
list[nn].op2.name_id = set_name_eltype($3.qnum,$3.etype);
list[nn].op1.assigntype = ASSIGN_;
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ indexset rexpr WHERE_ rexpr
{ int aggr,where;
int nn,mm,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
/* splice in the WHERE clause */
subtree_swap(&$5.i,&$7.i);
subtree_swap(&$4.i,&$7.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$5.i,&where); /* get in proper linear order */
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $7.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$5.i,&kk); /* so datastart before rexpr */
subtree_swap(&$4.i,&kk); /* so datastart before indexset */
mm = makenode(ARRAY_LVALUE_INDEXED_,kk,$4.i);
nn = makenode(ARRAY_ASSIGNOP_SINGLE_,mm,$5.i);
list[nn].flags |= SET_ASSIGNOP;
list[nn].op1.assigntype = ASSIGN_;
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen ARRAY_ATTRIBUTE_ arraylvalue WHERE_ rexpr
{ int aggr,where;
int nn,kk;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
/* splice in the WHERE clause */
subtree_swap(&$4.i,&$6.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
kk = makenode(ATTRIB_LVALUE_,0,0);
list[kk].op1.localnum = 0;
list[kk].op2.name_id = set_name_eltype($3.qnum,$3.etype);
subtree_swap(&$4.i,&kk); /* so lvalue before rvalue */
nn = makenode(ARRAY_ASSIGNOP_ARRAY_,kk,$4.i);
list[nn].flags |= SET_ASSIGNOP;
list[nn].op1.assigntype = ASSIGN_;
aggr = makenode(AGGREGATE_,$2.i,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen setattribb rexpr WHERE_ rexpr
{ int aggr,where,nn;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
subtree_swap(&$4.i,&$6.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
nn = makenode(SET_ATTRIBUTE_L,$4.i,0);
aggr = makenode(AGGREGATE_,where,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen setattribb indexset rexpr WHERE_ rexpr
{ int aggr,where,nn;
aggrtype = SET_ATTRIBUTE_LOOP_;
attr_kind = $3.i;
subtree_swap(&$4.i,&$5.i); /* get index eval in top of stack */
subtree_swap(&$4.i,&$7.i); /* get index eval in top of stack */
subtree_swap(&$5.i,&$7.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
subtree_swap(&$5.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $7.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
nn = makenode(SET_ATTRIBUTE_L,$5.i,$4.i);
aggr = makenode(AGGREGATE_,where,nn);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen QUANTITY_ QUANTITY_NAME_
{ int aggr,idnode;
aggrtype = SET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$4.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen QUANTITY_ QUANTITY_NAME_
{ int aggr,idnode;
aggrtype = UNSET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$4.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen QUANTITY_ QUANTITY_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = SET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$4.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen QUANTITY_ QUANTITY_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = UNSET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$4.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen METHOD_INSTANCE_ METHOD_NAME_
{ int aggr,idnode;
aggrtype = SET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$4.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen METHOD_INSTANCE_ METHOD_NAME_
{ int aggr,idnode;
aggrtype = UNSET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_, $4.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen METHOD_INSTANCE_ METHOD_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = SET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$4.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen METHOD_INSTANCE_ METHOD_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = UNSET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$4.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen QUANTITY_NAME_
{ int aggr,idnode;
aggrtype = SET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$3.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen QUANTITY_NAME_
{ int aggr,idnode;
aggrtype = UNSET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$3.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen QUANTITY_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = SET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$3.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen QUANTITY_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = UNSET_NAMED_QUANTITY_;
idnode = makenode(PUSH_NAMED_QUANTITY,$3.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen METHOD_NAME_
{ int aggr,idnode;
aggrtype = SET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$3.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen METHOD_NAME_
{ int aggr,idnode;
aggrtype = UNSET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$3.i,0);
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,$2.i,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set element_gen METHOD_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = SET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$3.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen METHOD_NAME_ WHERE_ rexpr
{ int aggr,where,idnode;
aggrtype = UNSET_METHOD_INSTANCE_;
idnode = makenode(PUSH_METHOD_INSTANCE_,$3.i,0);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&idnode,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
$2.symptr = 0; /* in case of WHERE */
aggr = makenode(AGGREGATE_,where,idnode);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : set error
{
if ( tok == '-' )
kb_error(1897,"Syntax kludge: cannot have leading minus sign after ]. Use parentheses.\n",
Q_ERROR);
else
kb_error(2532,
"Syntax: SET element_gen [ name ] attribute rexpr [ WHERE rexpr ]\n",Q_ERROR);
}
/**************************************************************************/
unset : UNSET_ { $$.i = makenode(SET_INIT_,0,0); }
unsetattrib: FIXED_ { $$.i = UNSET_FIXED_; }
unsetattrib: HIT_PARTNER_ { $$.i = UNSET_HIT_PARTNER_; }
unsetattrib: BARE_ { $$.i = UNSET_BARE_; }
unsetattrib: NO_REFINE_ { $$.i = UNSET_NO_REFINE_; }
unsetattrib: NONCONTENT_ { $$.i = UNSET_NONCONTENT_; }
unsetattrib: NODISPLAY_ { $$.i = UNSET_NO_DISPLAY_; }
unsetattrib: DENSITY_ { $$.i = UNSET_DENSITY_; }
unsetattrib: VOLUME_ { $$.i = UNSET_TARGET_; }
unsetattrib: TARGET_ { $$.i = UNSET_TARGET_; }
unsetattrib: PRESSURE_ { $$.i = UNSET_PRESSURE_; }
unsetattrib: TRIPLE_POINT_ { $$.i = UNSET_TRIPLE_PT_; }
unsetattrib: TETRA_POINT_ { $$.i = UNSET_TETRA_PT_; }
unsetattrib: AXIAL_POINT_ { $$.i = UNSET_AXIAL_POINT_; }
unsetattrib: FRONTBODY_ { $$.i = UNSET_FRONTBODY_; }
unsetattrib: BACKBODY_ { $$.i = UNSET_BACKBODY_; }
unsetattrib: BODIES_ { $$.i = UNSET_FACET_BODY_; }
vcommand : unset element_gen unsetattrib
{ int aggr;
aggrtype = $3.i;
aggr = makenode(AGGREGATE_,$2.i,0);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen unsetattrib WHERE_ rexpr
{ int aggr,where;
aggrtype = $3.i;
elsym = $2.symptr;
where = makenode(WHERE_,$2.i,$5.i);
aggr = makenode(AGGREGATE_,where,0);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
conname : CONSTRAINT_NAME_ { $$.i = $1.i; }
vcommand : unset element_gen conname
{ int aggr;
aggrtype = UNSET_CONSTRAINT_NAME;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,$2.i,0);
list[aggr].stack_delta = 0;
list[aggr].op3.connum = globals($3.i)->value.cnum;
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
rexpr : CONSTRAINT_NAME_ { real_val = globals($1.i)->value.cnum;
$$.i = makenode(PUSHCONST,0,0); }
vcommand : unset element_gen CONSTRAINT_ rexpr
{ int aggr;
aggrtype = UNSET_CONSTRAINT_;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,$2.i,$4.i);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen CONSTRAINT_ rexpr WHERE_ rexpr
{ int aggr,where;
aggrtype = UNSET_CONSTRAINT_;
subtree_swap(&$4.i,&$6.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,where,$4.i);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen conname WHERE_ rexpr
{ int aggr,where;
aggrtype = UNSET_CONSTRAINT_NAME;
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,where,0);
list[aggr].op3.connum = globals($3.i)->value.cnum;
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
bdryname : BOUNDARY_NAME_ { $$.i = $1.i; }
vcommand : unset element_gen bdryname
{ int aggr;
aggrtype = UNSET_BOUNDARY_NAME;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,$2.i,0);
list[aggr].stack_delta = 0;
list[aggr].op3.bdrynum = globals($3.i)->value.bnum;
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
rexpr : BOUNDARY_NAME_ { real_val = globals($1.i)->value.bnum;
$$.i = makenode(PUSHCONST,0,0); }
vcommand : unset element_gen BOUNDARY_ rexpr
{ int aggr;
aggrtype = UNSET_BOUNDARY_;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,$2.i,$4.i);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen bdryname WHERE_ rexpr
{ int aggr,where;
aggrtype = UNSET_BOUNDARY_NAME;
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
list[where].left = $2.i - where;
list[where].right = $5.i - where;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,where,0);
list[aggr].op3.bdrynum = globals($3.i)->value.bnum;
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : unset element_gen BOUNDARY_ rexpr WHERE_ rexpr
{ int aggr,where;
aggrtype = UNSET_BOUNDARY_;
subtree_swap(&$4.i,&$6.i);
where = makenode(WHERE_,0,0);
list[where].left = 0;
list[where].right = 0;
subtree_swap(&$4.i,&where); /* get in proper linear order */
list[where].left = $2.i - where;
list[where].right = $6.i - where;
elsym = $2.symptr;
aggr = makenode(AGGREGATE_,where,$4.i);
$$.i = makenode(AGGREGATE_END_,$1.i,aggr);
end_scope();
}
vcommand : UNSET_ error
{ kb_error(1898, "Syntax: UNSET element_gen attribute [ WHERE rexpr ]\n",Q_ERROR); }
/**************************************************************************/
whole : EXPRESSION_START_ { YYABORT; /* no expression */ }
vcommand : HELP_ WHILE_ { $$.i = makenode(HELP_KEYWORD,0,0); help_flag = 0; tok = 0; yyerrok; yyclearin ; }
vcommand : HELP_ error { $$.i = makenode(HELP_KEYWORD,0,0); help_flag = 0; tok = 0; yyerrok; yyclearin ; }
/**************************************************************************/
%%
int yybegin()
{ int retval;
PROF_START(yyparse);
parse_errors = 0;
perm_flag = 0;
cond_expr_flag = 0;
use_given_id = 0;
parens = brace_depth = in_quote = 0;
yylex_init();
reset_inputbuffer();
/* unput command start token */
tok = COMMAND_START_; unput_tok();
retval = yyparse();
PROF_FINISH(yyparse);
return retval;
}
int yyerror(s)
char *s;
{ char modmsg[1000];
if ( help_flag ) return 0;
parens = brace_depth = in_quote = 0;
strncpy(modmsg,s,998);
if ( modmsg[strlen(modmsg)-1] != '\n' )
strcat(modmsg,"\n");
if ( datafile_flag )
{
if ( listtop == 2 ) return 0; /* no expression */
kb_error(2407,modmsg,PARSE_ERROR);
}
else
{ /* fprintf(stderr,"tok = %d\n",tok); */
kb_error(2408,modmsg,SYNTAX_ERROR);
}
return 0;
}
evolver-2.30c.dfsg/src/quantity.c 0000644 0001753 0001753 00000372315 11410765113 017252 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/******************************************************************
*
* File: quantity.c
*
* Purpose: General handling of general quantities.
*/
#include "include.h"
struct gen_quant *Gen_quants;
struct method_instance *Meth_inst;
int compound_quant_list_head = -1;
/* new system of general quantity allocation */
struct gen_quant **gen_quant_list;
struct gen_quant *gen_quant_free;
int gen_quant_list_max;
int gen_quant_free_left;
/* new system of general instance allocation */
struct method_instance **meth_inst_list;
int meth_inst_list_max;
struct method_instance *meth_inst_free;
int meth_inst_free_left;
/* element setup routines */
void (*q_setup[NUMELEMENTS]) ARGS((struct linsys *,QINFO,int)) =
{ q_vertex_setup,q_edge_setup,q_facet_setup,q_body_setup,q_facetedge_setup};
struct gen_quant_method basic_gen_methods[] =
{
{"null_length",EDGE,NEED_SIDE,NOSPEC,NULL, null_length_value, null_length_grad,
null_length_hess,NULL},
{"null_area",FACET,NEED_SIDE,NOSPEC,NULL, null_area_value, null_area_grad,
null_area_hess,NULL},
{"edge_tension",EDGE,NEED_SIDE,NOSPEC,q_edge_tension_init,
q_edge_tension_value, q_edge_tension_gradient, q_edge_tension_hessian,NULL},
{"edge_length",EDGE,NEED_SIDE,NOSPEC,q_edge_tension_init,
q_edge_tension_value, q_edge_tension_gradient, q_edge_tension_hessian,NULL},
{"density_edge_length",EDGE,NEED_SIDE,SPEC_USE_DENSITY,q_edge_tension_init,
q_edge_tension_value, q_edge_tension_gradient, q_edge_tension_hessian,NULL},
{"facet_tension",FACET,NEED_SIDE,NOSPEC, q_facet_tension_init,
q_facet_tension_value, q_facet_tension_gradient, q_facet_tension_hessian,NULL},
{"facet_area",FACET,NEED_SIDE,NOSPEC, q_facet_tension_init,
q_facet_tension_value, q_facet_tension_gradient, q_facet_tension_hessian,NULL},
{"density_facet_area",FACET,NEED_SIDE,SPEC_USE_DENSITY, q_facet_tension_init,
q_facet_tension_value, q_facet_tension_gradient, q_facet_tension_hessian,NULL},
{"facet_area_u",FACET,NEED_SIDE,NOSPEC, q_facet_tension_u_init,
q_facet_tension_u_value, q_facet_tension_u_gradient,
q_facet_tension_u_hessian,NULL},
{"density_facet_area_u",FACET,NEED_SIDE,SPEC_USE_DENSITY,
q_facet_tension_u_init, q_facet_tension_u_value,
q_facet_tension_u_gradient, q_facet_tension_u_hessian,NULL},
{"pos_area_hess",FACET,NEED_SIDE,NOSPEC, pos_area_hess_init,
q_facet_tension_value, q_facet_tension_gradient, pos_area_hess,NULL},
{"sobolev_area",FACET,NEED_SIDE,NOSPEC, sobolev_area_init,
q_facet_tension_value, q_facet_tension_gradient, sobolev_area_hess,NULL},
{"dirichlet_area",FACET,NEED_SIDE,NOSPEC, dirichlet_area_init,
q_facet_tension_value, q_facet_tension_gradient, dirichlet_area_hess,NULL},
{"wulff_energy",FACET,0,NOSPEC, wulff_method_init,
facet_wulff_value, facet_wulff_grad, null_q_hess,NULL},
{"area_square",FACET,NEED_SIDE,NOSPEC, NULL,
area_square_value, area_square_gradient, null_q_hess,NULL},
{"vertex_scalar_integral", VERTEX,ORIENTABLE_METHOD,SPEC_SCALAR, NULL,
vertex_scalar_integral,vertex_scalar_integral_grad,
vertex_scalar_integral_hess,NULL},
{"edge_scalar_integral",EDGE,NEED_SIDE|NEED_GAUSS,SPEC_SCALAR, NULL,
edge_scalar_integral,edge_scalar_integral_grad,edge_scalar_integral_hess,NULL},
{"edge_vector_integral",EDGE,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
SPEC_VECTOR, NULL,
edge_vector_integral,edge_vector_integral_grad,edge_vector_integral_hess,NULL},
{"edge_general_integral",EDGE,NEED_SIDE|NEED_GAUSS,
SPEC_SCALAR|SPEC_EXTRADIM, edge_general_init, edge_general_value,
edge_general_grad,edge_general_hess,NULL},
{"edge_area",EDGE,ORIENTABLE_METHOD,NOSPEC, NULL,
q_edge_area,q_edge_area_grad,q_edge_area_hess,NULL},
{"edge_torus_area",EDGE,ORIENTABLE_METHOD,NOSPEC, NULL,
q_edge_torus_area,q_edge_torus_area_grad,q_edge_torus_area_hess,NULL},
{"circular_arc_length",EDGE,NEED_SIDE,NOSPEC, circular_arc_length_init,
circular_arc_length_value,circular_arc_length_grad,circular_arc_length_hess,NULL},
{"circular_arc_area",EDGE,ORIENTABLE_METHOD|NEED_SIDE,NOSPEC, circular_arc_area_init,
circular_arc_area_value,circular_arc_area_grad,circular_arc_area_hess,NULL},
{"string_gravity",EDGE,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
NOSPEC,string_gravity_init,
string_gravity_energy,string_gravity_grads,string_gravity_hessian,NULL},
{"gap_energy",EDGE,NEED_SIDE,NOSPEC,NULL,gap_energy,gap_grads,null_q_hess,NULL},
{"klein_length",EDGE,0,NOSPEC,NULL,klein_length_method,
klein_length_method_grad,null_q_hess,NULL},
{"klein_area",FACET,0,NOSPEC,NULL,klein_area_method,
klein_area_method_grad,null_q_hess,NULL},
{"facet_scalar_integral",FACET,NEED_SIDE|NEED_GAUSS,SPEC_SCALAR,
facet_scalar_integral_init, facet_scalar_integral,
facet_scalar_integral_grad,facet_scalar_integral_hess,NULL},
{"facet_vector_integral",FACET,NEED_SIDE|NEED_NORMAL|NEED_GAUSS
|ORIENTABLE_METHOD,
SPEC_VECTOR, facet_vector_integral_init, facet_vector_integral,
facet_vector_integral_grad, facet_vector_integral_hess,NULL},
{"facet_2form_integral",FACET,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
SPEC_2FORM, facet_2form_integral_init,
facet_2form_integral,facet_2form_integral_grad,facet_2form_integral_hess,NULL},
{"facet_2form_sq_integral",FACET,NEED_SIDE|NEED_GAUSS,
SPEC_2FORM, facet_2form_sq_integral_init,
facet_2form_sq_integral,facet_2form_sq_integral_grad,null_q_hess,NULL},
{"facet_general_integral",FACET,NEED_SIDE|NEED_NORMAL|NEED_GAUSS,
SPEC_SCALAR|SPEC_EXTRADIM, facet_general_init, facet_general_value,
facet_general_grad, facet_general_hess,NULL},
{"metric_facet_area",FACET,NEED_GAUSS|NEED_SIDE,NOSPEC, metric_area_init,
metric_area_value, metric_area_grad, metric_area_hess,NULL},
{"metric_edge_length",EDGE,NEED_GAUSS,NOSPEC, metric_area_init, metric_area_value,
metric_area_grad, metric_area_hess,NULL},
{"spherical_area",FACET,NEED_SIDE,NOSPEC,
NULL, spherical_area_value,spherical_area_grad,NULL,NULL},
{"spherical_arc_length",EDGE,NEED_SIDE,NOSPEC,
NULL, spherical_arc_length_value,spherical_arc_length_grad,spherical_arc_length_hess,NULL},
{"spherical_arc_area_n",EDGE,NEED_SIDE|ORIENTABLE_METHOD,NOSPEC,
spherical_arc_area_init, spherical_arc_area_n_value,
spherical_arc_area_n_grad,spherical_arc_area_n_hess,NULL},
{"spherical_arc_area_s",EDGE,NEED_SIDE|ORIENTABLE_METHOD,NOSPEC,
spherical_arc_area_init, spherical_arc_area_s_value,
spherical_arc_area_s_grad,spherical_arc_area_s_hess,NULL},
{"facet_volume",FACET,NEED_SIDE|TORUS_MODULO_MUNGE|ORIENTABLE_METHOD,NOSPEC,
q_facet_volume_init, q_facet_volume,q_facet_volume_grad,q_facet_volume_hess,NULL},
{"facet_torus_volume",FACET,NEED_SIDE|TORUS_MODULO_MUNGE|ORIENTABLE_METHOD,
NOSPEC, NULL,
q_facet_torus_volume,q_facet_torus_volume_grad,q_facet_torus_volume_hess,NULL},
{"simplex_vector_integral",FACET,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
SPEC_VECTOR, simplex_vector_integral_init, simplex_vector_integral,
simplex_vector_integral_grad, simplex_vector_integral_hess,NULL},
{"simplex_k_vector_integral",FACET,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
SPEC_KVECTOR, simplex_k_vector_integral_init, simplex_k_vector_integral,
simplex_k_vector_integral_grad, simplex_k_vector_integral_hess,NULL},
{"edge_k_vector_integral",EDGE,NEED_SIDE|NEED_GAUSS|ORIENTABLE_METHOD,
SPEC_KVECTOR, simplex_k_vector_integral_init, simplex_k_vector_integral,
simplex_k_vector_integral_grad, simplex_k_vector_integral_hess,NULL},
{"stress_integral",FACET,NEED_SIDE|NEED_NORMAL,SPEC_SCALAR,
stress_integral_init,stress_integral, stress_integral_grad, null_q_hess,NULL},
{"gravity_method",FACET,NEED_SIDE|ORIENTABLE_METHOD,NOSPEC,
gravity_init,gravity_energy, gravity_grads,gravity_hessian,NULL},
{"full_gravity_method",FACET,NEED_SIDE|ORIENTABLE_METHOD,NOSPEC,
full_gravity_init,gravity_energy, gravity_grads,gravity_hessian,NULL},
{"sqcurve_string",VERTEX,NEED_WINGS,NOSPEC,sqcurve_string_init,
sqcurve_string_value, sqcurve_string_grad,sqcurve_string_hess,NULL},
{"sqcurve_string_marked",VERTEX,NEED_MARKED_WINGS,NOSPEC,sqcurve_string_marked_init,
sqcurve_string_value, sqcurve_string_grad,sqcurve_string_hess,NULL},
{"sqcurve2_string",VERTEX,NEED_WINGS,NOSPEC,sqcurve2_string_init,
sqcurve2_string_value, sqcurve2_string_grad,NULL,NULL},
{"sqcurve3_string",VERTEX,NEED_WINGS,NOSPEC,sqcurve3_string_init,
sqcurve3_string_value, sqcurve3_string_grad,sqcurve3_string_hess,NULL},
{"sq_mean_curv_cyl",VERTEX,NEED_WINGS,NOSPEC,sq_mean_curv_cyl_init,
sq_mean_curv_cyl_value, sq_mean_curv_cyl_grad,sq_mean_curv_cyl_hess,NULL},
{"sq_gaussian_curv_cyl",VERTEX,NEED_WINGS,NOSPEC,sq_gauss_curv_cyl_init,
sq_gauss_curv_cyl_value, sq_gauss_curv_cyl_grad,sq_gauss_curv_cyl_hess,NULL},
{"mean_curvature_integral",EDGE,NEED_SIDE|NEED_WINGS,NOSPEC,mean_int_init,
mean_int_value, mean_int_gradient,mean_int_hessian,NULL},
{"mean_curvature_integral_A",EDGE,NEED_SIDE|NEED_WINGS,NOSPEC,mean_int_a_init,
mean_int_a_value, mean_int_a_gradient,mean_int_a_hessian,NULL},
{"gauss_curvature_integral",FACET,0,NOSPEC,gauss_integral_init,
gauss_int_energy, gauss_int_gradient, null_q_hess ,NULL},
{"levine_energy",VERTEX,NEED_FULL_STAR,NOSPEC,levine_energy_init,
levine_energy_value, levine_energy_grad, null_q_hess ,NULL},
/*
{"sq_gauss_curvature",VERTEX,0,NOSPEC,sqgauss_method_init,
sqgauss_method_value, sqgauss_method_grad, null_q_hess ,NULL},
*/
{"star_gauss_curvature",VERTEX,NEED_PART_STAR,NOSPEC,star_gauss_method_init,
star_gauss_method_value, star_gauss_method_grad, star_gauss_method_hess ,NULL},
{"sq_gauss_curvature",VERTEX,NEED_FULL_STAR,NOSPEC,star_sqgauss_method_init,
star_sqgauss_method_value, star_sqgauss_method_grad,
star_sqgauss_method_hess ,NULL},
{"sq_mean_curvature",VERTEX,0,NOSPEC,sqcurve_method_init,
sqcurve_method_value, sqcurve_method_grad, null_q_hess,
sqcurve_method_cleanup},
{"eff_area_sq_mean_curvature",VERTEX,0,NOSPEC,sqcurve_method_init,
sqcurve_method_value, sqcurve_method_grad, null_q_hess,
sqcurve_method_cleanup },
{"normal_sq_mean_curvature",VERTEX,0,NOSPEC,sqcurve_method_init,
sqcurve_method_value, sqcurve_method_grad, null_q_hess,
sqcurve_method_cleanup },
{"star_sq_mean_curvature",VERTEX,NEED_PART_STAR,NOSPEC,star_sqcurve_method_init,
star_sqcurve_method_value, star_sqcurve_method_grad, star_sqcurve_method_hess ,NULL},
{"star_eff_area_sq_mean_curvature",VERTEX,NEED_PART_STAR,NOSPEC,
star_sqcurve_method_init, star_sqcurve_method_value,
star_sqcurve_method_grad, star_sqcurve_method_hess ,NULL},
{"star_normal_sq_mean_curvature",VERTEX,NEED_PART_STAR,NOSPEC,
star_sqcurve_method_init, star_sqcurve_method_value,
star_sqcurve_method_grad, star_sqcurve_method_hess ,NULL},
{"star_perp_sq_mean_curvature",VERTEX,NEED_PART_STAR,NOSPEC,
star_sqcurve_method_init, star_sqcurve_method_value,
star_sqcurve_method_grad, star_sqcurve_method_hess ,NULL},
{"circle_willmore",EDGE,NEED_WINGS|NEED_SIDE,NOSPEC,
circle_willmore_init, circle_willmore_value,
circle_willmore_grad, circle_willmore_hess ,NULL},
{"laplacian_mean_curvature",VERTEX,NEED_PART_STAR,NOSPEC,
laplacian_mean_curvature_init, laplacian_mean_curvature_value,
laplacian_mean_curvature_grad, NULL, NULL },
{"stokes2d",VERTEX,NEED_PART_STAR,NOSPEC, stokes2d_init,
stokes2d_value, stokes2d_grad, stokes2d_hess ,NULL},
{"stokes2d_laplacian",VERTEX,NEED_PART_STAR,NOSPEC, stokes2d_init,
stokes2d_laplacian, NULL, NULL ,NULL},
{"hooke_energy",EDGE,NEED_SIDE,NOSPEC,hooke_energy_init,hooke_energy,
hooke_energy_gradient,hooke_energy_hessian,NULL},
{"hooke2_energy",EDGE,NEED_SIDE,NOSPEC,hooke2_energy_init,hooke2_energy,
hooke2_energy_gradient,hooke2_energy_hessian,NULL},
{"hooke3_energy",EDGE,NEED_SIDE,NOSPEC,hooke3_energy_init,hooke3_energy,
hooke3_energy_gradient,hooke3_energy_hessian,NULL},
{"local_hooke_energy",VERTEX,0,NOSPEC,local_hooke_init,
local_hooke, local_hooke_gradient,null_q_hess,NULL},
{"dihedral_hooke",EDGE,NEED_WINGS,NOSPEC,NULL,
dihedral_hooke_energy, dihedral_hooke_grad, dihedral_hooke_hess ,NULL},
{"linear_elastic",FACET,NEED_SIDE,NOSPEC,linear_elastic_init,
linear_elastic_energy, linear_elastic_gradient,linear_elastic_hessian,NULL},
{"general_linear_elastic",FACET,NEED_SIDE,NOSPEC,general_linear_elastic_init,
general_linear_elastic_energy, general_linear_elastic_gradient,
general_linear_elastic_hessian,NULL},
{"linear_elastic_B",FACET,NEED_SIDE,NOSPEC,linear_elastic_B_init,
linear_elastic_B_energy, linear_elastic_B_gradient,linear_elastic_B_hessian,NULL},
{"relaxed_elastic",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_init,
relaxed_elastic_energy, relaxed_elastic_gradient,relaxed_elastic_hessian,NULL},
{"relaxed_elastic1",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_init,
relaxed_elastic1_energy, relaxed_elastic1_gradient,relaxed_elastic1_hessian,NULL},
{"relaxed_elastic2",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_init,
relaxed_elastic2_energy, relaxed_elastic2_gradient,relaxed_elastic2_hessian,NULL},
{"relaxed_elastic_A",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_A_init,
relaxed_elastic_A_energy, relaxed_elastic_A_gradient,relaxed_elastic_A_hessian,NULL},
{"relaxed_elastic1_A",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_A_init,
relaxed_elastic1_A_energy, relaxed_elastic1_A_gradient,relaxed_elastic1_A_hessian,NULL},
{"relaxed_elastic2_A",FACET,NEED_SIDE,NOSPEC,relaxed_elastic_A_init,
relaxed_elastic2_A_energy, relaxed_elastic2_A_gradient,relaxed_elastic2_A_hessian,NULL},
{"dirichlet_elastic",FACET,NEED_SIDE,NOSPEC,dirichlet_elastic_init,
dirichlet_elastic_energy, dirichlet_elastic_gradient,
dirichlet_elastic_hessian,NULL},
{"SVK_elastic",FACET,NEED_SIDE,NOSPEC,SVK_init,
SVK_energy, SVK_gradient,SVK_hessian,NULL},
{"neo_hookean",FACET,NEED_SIDE,NOSPEC,Neo_Hookean_init,
Neo_Hookean_energy, Neo_Hookean_gradient,Neo_Hookean_hessian,NULL},
{"knot_energy",VERTEX,0,NOSPEC,knot_power_init,knot_energy,
knot_energy_gradient,knot_energy_hessian,NULL},
{"charge_gradient",VERTEX,0,NOSPEC,charge_gradient_init,charge_gradient,
charge_gradient_gradient,null_q_hess,NULL},
{"uniform_knot_energy",VERTEX,0,NOSPEC,uniform_knot_energy_init,
uniform_knot_energy, uniform_knot_energy_gradient,null_q_hess,NULL},
{"uniform_knot_energy_normalizer",VERTEX,0,NOSPEC,knot_power_init,
uniform_normalization, null_q_grad, null_q_hess,NULL},
{"uniform_knot_normalizer1",VERTEX,0,NOSPEC,knot_power_init,
uniform_normalization, null_q_grad, null_q_hess,NULL},
{"uniform_knot_normalizer2",VERTEX,0,NOSPEC,knot_power_init,
uniform_binormalization, null_q_grad, null_q_hess,NULL},
{"edge_knot_energy_normalizer",EDGE,0,NOSPEC,knot_power_init,
edge_normalization, null_q_grad, null_q_hess,NULL},
{"simon_knot_energy_normalizer",EDGE,0,NOSPEC,knot_power_init,
simon_normalization, null_q_grad, null_q_hess,NULL},
{"edge_min_knot_energy",EDGE,0,NOSPEC,knot_power_init,
edge_min_knot_energy, null_q_grad, null_q_hess,NULL},
{"edge_knot_energy",EDGE,0,NOSPEC,knot_power_init,
edge_edge_knot_energy, edge_edge_knot_energy_gradient,null_q_hess,NULL},
{"edge_edge_knot_energy",EDGE,0,NOSPEC,knot_power_init,
edge_edge_knot_energy, edge_edge_knot_energy_gradient,null_q_hess,NULL},
{"facet_knot_energy",VERTEX,0,NOSPEC,facet_knot_energy_init,
facet_knot_energy, facet_knot_energy_gradient,null_q_hess,NULL},
{"facet_knot_energy_fix",VERTEX,0,NOSPEC,facet_knot_energy_fix_init,
facet_knot_energy_fix, facet_knot_energy_fix_gradient,null_q_hess,NULL},
{"bi_surface",VERTEX,0,SPEC_SCALAR,bi_surface_init,
bi_surface_energy, bi_surface_gradient,null_q_hess,NULL},
{"buck_knot_energy",EDGE,0,NOSPEC,knot_power_init,
buck_knot_energy, buck_knot_energy_gradient,null_q_hess,NULL},
{"proj_knot_energy",EDGE,0,NOSPEC,knot_power_init,
proj_knot_energy, proj_knot_energy_gradient,null_q_hess,NULL},
{"sin_knot_energy",EDGE,0,NOSPEC,NULL,
sin_knot_energy, sin_knot_energy_gradient,null_q_hess,NULL},
{"circle_knot_energy",EDGE,0,NOSPEC,NULL,
circle_knot_energy, circle_knot_energy_gradient,null_q_hess,NULL},
{"twist",EDGE,0,NOSPEC,NULL, twist, null_q_grad, null_q_hess,NULL},
{"writhe",EDGE,0,NOSPEC,NULL, writhe, writhe_gradient,null_q_hess,NULL},
{"average_crossings",EDGE,0,NOSPEC, NULL,
average_crossing,null_q_grad,null_q_hess,NULL},
{"sphere_knot_energy",FACET,0,NOSPEC,sphere_knot_energy_init,
sphere_knot_energy, sphere_knot_energy_gradient,null_q_hess,NULL},
{"knot_thickness_0",VERTEX,0,NOSPEC, knot_power_init,knot_thickness_0,
knot_thickness_0_gradient, null_q_hess,NULL},
{"knot_thickness",VERTEX,0,NOSPEC, NULL,knot_thickness,
null_q_grad, null_q_hess,NULL},
{"knot_thickness_p",VERTEX,0,NOSPEC, uniform_knot_energy_init,
knot_thickness_p, knot_thickness_p_gradient, null_q_hess,NULL},
{"knot_thickness_p2",VERTEX,0,NOSPEC, uniform_knot_energy_init,
knot_thickness_p2, knot_thickness_p2_gradient, null_q_hess,NULL},
{"knot_thickness2",VERTEX,0,NOSPEC, NULL, knot_thickness2,
null_q_grad, null_q_hess,NULL},
{"knot_local_thickness",VERTEX,0,NOSPEC, NULL, knot_local_thickness,
null_q_grad, null_q_hess,NULL},
{"curvature_function",VERTEX,0,NOSPEC,curvature_forces_init,
curvature_forces_energy, curvature_forces,null_q_hess,NULL},
{"johndust",VERTEX,0,NOSPEC,NULL,johndust_energy,
johndust_gradient,null_q_hess,NULL},
{"true_writhe",EDGE,0,NOSPEC,NULL, true_writhe, null_q_grad,null_q_hess,NULL},
{"true_average_crossings",EDGE,0,NOSPEC, NULL,
true_average_crossing,null_q_grad,null_q_hess,NULL},
{"ackerman",VERTEX,0,NOSPEC,ackerman_init,ackerman_energy,
ackerman_forces,null_q_hess,NULL},
{"carter_energy",FACET,NEED_SIDE,NOSPEC,carter_energy_init,
carter_energy, carter_energy_gradient,null_q_hess,NULL},
{"curvature_binormal",VERTEX,0,NOSPEC,curvature_binormal_init,
curvature_binormal_energy, curvature_binormal_force ,null_q_hess,NULL},
{"ddd_gamma_sq",EDGE,NEED_STRING_STAR,NOSPEC,ddd_gamma_sq_init,
ddd_gamma_sq_energy, ddd_gamma_sq_gradient ,null_q_hess,NULL},
{ " ",0,0,0,NULL,NULL,NULL,NULL,NULL} /* to signal end of array */
};
/*********************************************************************/
/*************************************************************************
*
* function: quantity_init()
*
* purpose: initialize quantity structures for a surface
*/
void quantity_init()
{ int k;
/* set lists to empty; memory deallocation taken care of by global
permanent memory freeing at the start of each new surface */
gen_quant_count = 0;
gen_quant_list_max = 0;
gen_quant_free_left = 0;
gen_quant_free = NULL;
meth_inst_count = 0;
meth_inst_list_max = 0;
meth_inst_free_left = 0;
meth_inst_free = NULL;
compound_quant_list_head = -1;
meth_inst_count = LOW_INST; /* skip 0, so all indexes signable */
meth_inst_alloc = 20;
dy_meth_inst = dy_calloc(meth_inst_alloc,sizeof(struct method_instance));
for ( k = 0 ; k < NUMELEMENTS ; k++ )
{ quant_flags[k] = 0;
global_meth_inst_count[k] = 0;
}
memset((char*)global_meth_inst,0,sizeof(global_meth_inst));
}
/*************************************************************************
*
* function: find_quantity()
*
* purpose: find existing quantity by name in globals table.
*
* return: quantity number, or -1 if not found.
*/
int find_quantity(name)
char *name;
{ int q;
q = lookup_global_hash(name,0,QUANTITYNAME,HASH_LOOK);
if ( (q & NAMETYPEMASK) == QUANTITYNAME )
return q & INDEXMASK;
return -1;
}
/*************************************************************************
*
* function: find_method_instance()
*
* purpose: find existing instance by name
*
* return: instance number, or -1 if not found.
*/
int find_method_instance(name)
char *name;
{ int n;
n = lookup_global_hash(name,0,METHODNAME,HASH_LOOK);
if ( (n & NAMETYPEMASK) == METHODNAME )
return n & INDEXMASK;
return -1;
}
/*************************************************************************
*
* function: new_quantity()
*
* purpose: set up new named quantity.
* returns number of new quantity.
* If already exists, returns number, does not re-initialize.
*/
int new_quantity(name,mode)
char *name; /* identifying name for this quantity */
int mode; /* Q_ENERGY, Q_FIXED, Q_CONSERVED, or Q_INFO */
{ int q=0; /* new structure */
int g; /* hash return */
/* check to see if name used, and add if not */
g = lookup_global_hash(name,0,QUANTITYNAME,0);
if ( g != 0 )
{ int qq = g & INDEXMASK;
if ( datafile_flag == IN_DATAFILE )
{ if ( (GEN_QUANT(qq)->flags & Q_FORWARD_DEF) || addload_flag )
{
q = qq;
}
else
{
sprintf(errmsg,"'%s' already declared.\n",name);
kb_error(1555,errmsg,RECOVERABLE);
}
}
}
else /* need to allocate new structure */
{ /* check to see if any free ones left */
if ( gen_quant_free_left <= 0 )
{ gen_quant_free_left = 100;
gen_quant_free = (struct gen_quant*)mycalloc(gen_quant_free_left,
sizeof(struct gen_quant));
}
if ( gen_quant_count >= gen_quant_list_max )
{ if ( gen_quant_list_max == 0 )
{ gen_quant_list_max = 1000;
gen_quant_list = (struct gen_quant**)mycalloc(gen_quant_list_max,
sizeof(struct gen_quant*));
}
else
{ gen_quant_list = (struct gen_quant **)kb_realloc((char*)gen_quant_list,
2*gen_quant_list_max*sizeof(struct gen_quant*));
gen_quant_list_max *= 2;
}
}
/* initialize */
q = gen_quant_count;
gen_quant_list[q] = gen_quant_free;
g = lookup_global_hash(name,q,QUANTITYNAME,HASH_ADD);
GEN_QUANT(q)->num = q;
GEN_QUANT(q)->modulus = 1.0;
GEN_QUANT(q)->timestamp = -1;
GEN_QUANT(q)->tolerance = -1.0;
strncpy(GEN_QUANT(q)->name,name,sizeof(GEN_QUANT(q)->name));
gen_quant_count++; /* so seen by global_hash_expand */
gen_quant_free++;
gen_quant_free_left--;
}
GEN_QUANT(q)->flags = mode;
return q;
}
/*************************************************************************
*
* function: new_method_instance()
*
* purpose: set up new method instance.
* If already exists, then returns instance number;
* does not re-initialize.
* return: index of new instance in METH_INST list
*
*/
int new_method_instance(meth_name,inst_name)
char *meth_name,*inst_name;
{ struct method_instance * m; /* new instance */
struct gen_quant_method *gm=NULL;
int n=0,nb;
int inst_num; /* number of new instance */
int g; /* hash return */
if ( meth_name )
{
nb = sizeof(basic_gen_methods)/sizeof(struct gen_quant_method);
for ( gm = basic_gen_methods,n = 0 ; n < nb ; n++,gm++ )
if ( stricmp(gm->name,meth_name) == 0 ) break;
if ( n >= nb )
{ sprintf(errmsg,"No method '%s' exists.\n",meth_name);
kb_error(1559,errmsg,DATAFILE_ERROR); return -1;
}
}
/* make sure there is room for new instance */
if ( meth_inst_free_left <= 0 )
{ meth_inst_free_left = 100;
meth_inst_free = (struct method_instance*)mycalloc(meth_inst_free_left,
sizeof(struct method_instance));
}
if ( meth_inst_count >= meth_inst_list_max )
{ if ( meth_inst_list_max == 0 )
{ meth_inst_list_max = 1000;
meth_inst_list = (struct method_instance**)mycalloc(meth_inst_list_max,
sizeof(struct method_instance*));
}
else
{ meth_inst_list =
(struct method_instance **)kb_realloc((char*)meth_inst_list,
2*meth_inst_list_max*sizeof(struct method_instance*));
meth_inst_list_max *= 2;
}
}
inst_num = meth_inst_count;
meth_inst_list[inst_num] = meth_inst_free;
m = METH_INSTANCE(inst_num);
memset(m,0,sizeof(struct method_instance));
m->self_id = METHBASE + inst_num;
m->modulus = 1.0;
m->gen_method = n;
m->quant = -1; /* not attached to quantity yet */
m->timestamp = -1;
if ( gm )
{ m->type = gm->type;
if ( gm->spec_flags & SPEC_USE_DENSITY )
m->flags |= USE_DENSITY;
}
if ( strlen(inst_name) >= MNAMESIZE )
{ sprintf(errmsg,"Method name too long: %s\n",inst_name);
kb_error(2856,errmsg,RECOVERABLE);
}
strncpy(m->name,inst_name,sizeof(m->name));
g = lookup_global_hash(inst_name,inst_num,METHODNAME,HASH_ADD);
if ( g != 0 )
{ int inum = g & INDEXMASK;
if ( datafile_flag == IN_DATAFILE )
{ if ( (METH_INSTANCE(inum)->flags & Q_FORWARD_DEF) || addload_flag )
{ *METH_INSTANCE(inum) = *m; /* copy over initialization */
inst_num = inum;
METH_INSTANCE(inum)->self_id = METHBASE + inst_num;
}
else
{ sprintf(errmsg,"'%s' already declared.\n",inst_name);
memset((char*)m,0,sizeof(struct method_instance));
kb_error(1558,errmsg,RECOVERABLE);
}
}
}
else
{ meth_inst_count++;
meth_inst_free++;
meth_inst_free_left--;
}
return inst_num;
}
/*********************************************************************
*
* function: add_standard_quantity()
*
* purpose: for common quantities, creates method instance
* and quantity. Global energy only.
*/
int add_standard_quantity(meth_name,modulus)
char *meth_name; /* name of method (not instance) */
REAL modulus;
{
int mi;
int q;
char inst_name[40];
strncpy(inst_name,meth_name,25);
strcat(inst_name,"_inst");
mi = new_method_instance(meth_name,inst_name);
q = new_quantity(meth_name,Q_ENERGY);
attach_method_num(q,mi);
apply_method(NULLID,inst_name);
METH_INSTANCE(mi)->modulus = 1.0;
GEN_QUANT(q)->modulus = modulus;
GEN_QUANT(q)->flags |= STANDARD_QUANTITY;
return q;
}
/*********************************************************************
*
* function: attach_method()
*
* purpose: attach method instance to quantity
*
* return: instance number
*/
int attach_method(quantnum,meth_name)
int quantnum;
char *meth_name;
{
int inst_num;
inst_num = find_method_instance(meth_name);
if ( inst_num < 0 )
{ sprintf(errmsg,"Undefined method instance '%s'. \n",meth_name);
kb_error(1562,errmsg,DATAFILE_ERROR); return -1;
}
return attach_method_num(quantnum,inst_num);
}
int attach_method_num(quantnum,inst_num)
int quantnum;
int inst_num;
{ struct method_instance *m = METH_INSTANCE(inst_num);
struct gen_quant_method *gm;
struct gen_quant *quant = GEN_QUANT(quantnum);
int i;
if ( (inst_num < 0) || (inst_num >= meth_inst_count) )
kb_error(2446,
"Internal error: Unknown method number in attach_method_num().\n",
RECOVERABLE);
if ( (m->quant >= 0) && (m->quant != quantnum) )
{ sprintf(errmsg,"%s: Sorry, but for now, a method instance can only belong to one quantity.\n",m->name);
kb_error(1564,errmsg,DATAFILE_ERROR);
}
m->quant = quant->num;
gm = basic_gen_methods + m->gen_method;
if ( (gm->gradient==NULL) && (quant->flags & (Q_ENERGY|Q_FIXED|Q_CONSERVED)) )
{ sprintf(errmsg,"Sorry; method %s does not have a gradient available.\n",gm->name);
kb_error(1565,errmsg,DATAFILE_ERROR);
}
for ( i = 0 ; i < quant->method_count ; i++ )
if ( quant->meth_inst[i] == inst_num )
goto attach_method_num_exit;
if ( quant->meth_inst == NULL )
quant->meth_inst = quant->meth_inst_space;
else
if ( quant->method_count >= MAXMETH )
{ if ( quant->meth_inst == quant->meth_inst_space )
{ quant->meth_inst = (int*)mycalloc(quant->method_count+1,sizeof(int));
memcpy(quant->meth_inst,quant->meth_inst_space,MAXMETH*sizeof(int));
}
else
quant->meth_inst = (int*)kb_realloc((char*)(quant->meth_inst),
(quant->method_count+1)*sizeof(int));
}
quant->meth_inst[quant->method_count++] = inst_num;
quant_flags[gm->type] |= quant->flags & (Q_ENERGY|Q_FIXED|Q_INFO|Q_CONSERVED);
quant->flags |= (basic_gen_methods[m->gen_method].flags & TORUS_MODULO_MUNGE);
attach_method_num_exit:
return inst_num;
}
/*********************************************************************
*
* function: apply_method()
*
* purpose: make a method apply to an element
* if element id inverted and method orientable, then
* store method number as negative.
* for null element, assumed to be global method of type
*/
void apply_method(id,method_name)
element_id id;
char *method_name;
{
int inst_num;
/* search for method */
inst_num = find_method_instance(method_name);
if ( inst_num < 0 )
{ sprintf(errmsg, "Undefined method instance '%s' on %s %s. \n",
method_name,typenames[id_type(id)],ELNAME(id));
kb_error(1566, errmsg,DATAFILE_ERROR);
return;
}
/* really annoying in case of compound quantity
if ( valid_id(id) && (m->quant == -1) )
{ sprintf(errmsg,"Method instance '%s' not attached to a quantity.\n",
method_name);
kb_error(1567,errmsg,WARNING);
}
*/
apply_method_num(id,inst_num);
}
/*********************************************************************
*
* function: apply_method_num()
*
* purpose: make a method apply to an element (by method number)
* if element id inverted and method orientable, then
* store method number as negative.
* for null element, assumed to be global method of type
* If method of opposite sign already existing, then
* it is deleted, due to cancellation.
*/
void apply_method_num(id,inst_num)
element_id id;
int inst_num; /* method instance number */
{
struct method_instance *m;
struct element *e_ptr;
int type; /* of element */
struct gen_quant_method *gm;
int i;
/* search for method */
if ( inst_num < -meth_inst_count )
{ kb_error(2178,"Internal error: Undefined method instance. \n",DATAFILE_ERROR); return; }
if ( inst_num > meth_inst_count )
{ kb_error(2179,"Internal error: Undefined method instance. \n",DATAFILE_ERROR); return; }
m = METH_INSTANCE(abs(inst_num));
if ( m->flags & GLOBAL_INST )
{ /* trying to apply global method to single element */
if ( inverted(id) )
{ kb_error(4569,"Cannot apply signed method/quantity to individual element.\n",DATAFILE_ERROR);
}
return;
}
gm = basic_gen_methods + m->gen_method;
if ( valid_id(id) ) /* individual element */
{ int *instlist,maxinst;
int meth_offset;
if ( inverted(id) && (gm->flags & ORIENTABLE_METHOD) )
inst_num = -inst_num;
type = id_type(id);
meth_offset = get_meth_offset(type);
e_ptr = elptr(id);
/* see if already there */
instlist = (int*)((char*)e_ptr + meth_offset);
for ( i = 0 ; i < (int)e_ptr->method_count ; i++ )
{ if ( instlist[i] == inst_num ) return;
if ( instlist[i] == -inst_num )
{ /* cancels out */
instlist[i] = instlist[--e_ptr->method_count];
return;
}
}
/* add */
maxinst = EXTRAS(type)[web.meth_attr[type]].array_spec.datacount;
if ( (int)e_ptr->method_count >= maxinst )
{ int newc = maxinst+4;
expand_attribute(type,web.meth_attr[type],&newc);
e_ptr = elptr(id); /* since things moved */
instlist = (int*)((char*)e_ptr + meth_offset);
}
instlist[e_ptr->method_count] = inst_num;
e_ptr->method_count++;
}
else /* global */
{ m->flags |= GLOBAL_INST;
type = gm->type;
/* see if already there */
for ( i = 0 ; i < global_meth_inst_count[type] ; i++ )
if ( global_meth_inst[type][i] == inst_num )
break;
if ( i >= global_meth_inst_count[type] )
{ /* add it */
if ( global_meth_inst_count[type] >= MAXGLOBINST )
kb_error(1568,"Too many global method instances.\n",DATAFILE_ERROR);
else global_meth_inst[type][global_meth_inst_count[type]++] = inst_num;
}
}
}
/*********************************************************************
*
* function: unapply_method()
*
* purpose: disable a method for an element.
*
*/
void unapply_method(id,inst_num)
element_id id;
int inst_num; /* index in method instance list */
{ struct element *e_ptr;
int i;
int type = id_type(id);
int meth_offset = EXTRAS(type)[web.meth_attr[type]].offset;
int *methlist = (int*)((char*)elptr(id) + meth_offset);
if ( valid_id(id) ) /* individual element */
{ e_ptr = elptr(id);
/* see if already there */
for ( i = 0 ; i < (int)e_ptr->method_count ; i++ )
if ( abs(methlist[i]) == abs(inst_num) )
{ /* delete */
methlist[i] = methlist[--e_ptr->method_count];
break;
}
}
}
/********************************************************************
*
* function: apply_quantity()
*
* purpose: apply quantity methods to element, if appropriate
*/
void apply_quantity(id,quantnum)
element_id id;
int quantnum;
{ struct gen_quant *g = GEN_QUANT(quantnum);
int i;
int count = 0;
if ( g->flags & Q_COMPOUND )
kb_error(2180,"Compound quantity should have individual method instances applied to elements.\n",RECOVERABLE);
for ( i = 0 ; i < g->method_count ; i++ )
{ struct method_instance *mi = METH_INSTANCE(g->meth_inst[i]);
struct gen_quant_method *gm = basic_gen_methods + mi->gen_method;
if ( gm->type == id_type(id) )
{ apply_method_num(id,g->meth_inst[i]);
count++;
}
}
if ( count == 0 )
{ sprintf(errmsg,"Quantity '%s' has no methods applying to this type element.\n",
g->name);
kb_error(1569,errmsg, WARNING);
}
}
/********************************************************************
*
* function: unapply_quantity()
*
* purpose: disable quantity methods to element, if appropriate
*/
void unapply_quantity(id,quantnum)
element_id id;
int quantnum;
{ struct gen_quant *g = GEN_QUANT(quantnum);
int i;
for ( i = 0 ; i < g->method_count ; i++ )
{ struct method_instance *mi = METH_INSTANCE(g->meth_inst[i]);
struct gen_quant_method *gm = basic_gen_methods + mi->gen_method;
if ( gm->type == id_type(id) )
{ unapply_method(id,g->meth_inst[i]);
}
}
}
/*************************************************************************
*
* function: q_info_init()
*
* purpose: allocates q_info arrays
*
*/
void q_info_init(q_info,mode)
struct qinfo *q_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{ int m,i;
int maxgauss = (gauss1D_num > gauss2D_num) ? gauss1D_num : gauss2D_num;
if ( web.dimension >= SOAPFILM )
{
if ( gauss_lagrange[web.dimension][web.gauss2D_order].gnumpts > maxgauss )
maxgauss = gauss_lagrange[web.dimension][web.gauss2D_order].gnumpts;
if ( gauss_lagrange[web.dimension-1][web.gauss1D_order].gnumpts > maxgauss )
maxgauss = gauss_lagrange[web.dimension-1][web.gauss1D_order].gnumpts;
}
else
if ( gauss_lagrange[web.dimension][web.gauss1D_order].gnumpts > maxgauss )
maxgauss = gauss_lagrange[web.dimension][web.gauss1D_order].gnumpts;
if ( web.skel[FACET].ctrlpts > MAXVCOUNT )
kb_error(1570,"Vertices in facet exceed MAXVCOUNT.\n",RECOVERABLE);
memset((char*)q_info,0,sizeof(struct qinfo));
/* set up matrices in qinfo with lots of room */
q_info->xx = dmatrix(0,MAXVCOUNT,0,SDIM);
if ( web.torus_flag )
{ q_info->u = dmatrix(0,MAXVCOUNT,0,SDIM);
if ( (mode == METHOD_GRADIENT) || (mode == METHOD_HESSIAN) )
q_info->ugrad = dmatrix(0,MAXVCOUNT,0,SDIM);
if ( mode == METHOD_HESSIAN )
q_info->uhess = dmatrix4(MAXVCOUNT,MAXVCOUNT,SDIM,SDIM);
}
q_info->sides = dmatrix3(maxgauss,MAXVCOUNT,SDIM);
if ( web.modeltype == LINEAR )
for ( m = 1 ; m < maxgauss ; m++ )
q_info->sides[m] = q_info->sides[0]; /* since all the same */
q_info->ss = dmatrix(0,2*SDIM,0,2*SDIM);
if ( (mode == METHOD_GRADIENT) || (mode == METHOD_HESSIAN) )
q_info->grad = dmatrix(0,MAXVCOUNT,0,SDIM);
q_info->gauss_pt = dmatrix(0,maxgauss,0,2*SDIM); /* extra for point number */
if ( web.torus_flag && (web.representation == SOAPFILM) )
{ /* allocate some working space for facet_volume method */
int ectrl = web.lagrange_order + 1;
q_info->uu[0] = (REAL **)temp_calloc(ectrl*3,sizeof(REAL*));
q_info->uu[1] = q_info->uu[0]+ectrl; q_info->uu[2] = q_info->uu[1]+ectrl;
if ( (mode == METHOD_GRADIENT) || (mode == METHOD_HESSIAN) )
{ q_info->uugrad[0] = (REAL **)temp_calloc(ectrl*3,sizeof(REAL*));
q_info->uugrad[1] = q_info->uugrad[0]+ectrl;
q_info->uugrad[2] = q_info->uugrad[1]+ectrl;
}
if ( mode == METHOD_HESSIAN )
{ q_info->uuhess[0] = (REAL ****)temp_calloc(ectrl*3,sizeof(REAL***));
q_info->uuhess[1] = q_info->uuhess[0]+ectrl;
q_info->uuhess[2] = q_info->uuhess[1]+ectrl;
q_info->uuhess[0][0] = (REAL***)temp_calloc(3*ectrl*ectrl,sizeof(REAL**));
for ( i = 0 ; i < 3 ; i++ )
for ( m = 0 ; m < ectrl ; m++ )
q_info->uuhess[i][m] = q_info->uuhess[0][0] + i*ectrl*ectrl + m*ectrl;
}
}
}
/***********************************************************************
*
* function: q_info_free()
*
* purpose: deallocate all memory allocated to q_info structure.
*
*/
void q_info_free(q_info)
struct qinfo *q_info;
{
free_matrix(q_info->xx);
free_matrix3(q_info->sides);
free_matrix(q_info->ss);
free_matrix(q_info->grad);
free_matrix(q_info->gauss_pt);
if ( q_info->uu[0] )
{ temp_free((char*)q_info->uu[0]);
temp_free((char*)q_info->uugrad[0]);
}
if ( q_info->uuhess[0] )
{ temp_free((char*)q_info->uuhess[0][0]);
temp_free((char*)q_info->uuhess[0]);
}
if ( q_info->u )
{ free_matrix(q_info->u);
free_matrix(q_info->ugrad);
free_matrix4(q_info->uhess);
}
}
/***************************************************************************
*
* function: global_meth_needs()
*
* purpose: find set of q_info needs for active methods. To be called
* by quantity calc functions after inspecting quantities.
*/
int global_meth_needs(type)
int type;
{ int k;
int needs = 0;
for ( k = 0 ; k < global_meth_inst_count[type]; k++ )
{ int mi = global_meth_inst[type][k];
if ( (METH_INSTANCE(mi)->flags & Q_DOTHIS)
&& (METH_INSTANCE(mi)->type == type) )
needs |= basic_gen_methods[METH_INSTANCE(mi)->gen_method].flags;
}
return needs;
}
#ifdef KSR
__shared pthread_mutex_t ksrlock;
int team_id = -1;
int ksr_counter;
int m_next()
{ int val;
M_LOCK(&ksr_counter);
val = ksr_counter++;
M_UNLOCK(&ksr_counter);
return val;
}
void m_fork(func,type,mode)
void (*func)();
int type;
int mode;
{ if ( team_id == -1 )
{ team_id = pr_create_team(NUMPROCS);
pthread_mutex_init(&ksrlock,pthread_mutexattr_default);
}
ksr_counter = 0;
pr_pcall(team_id,func,copyargs(type,mode));
}
#endif
int *v_procnum; /* processors for vertex, index by ord */
#if defined(SHARED_MEMORY)
/************************************************************************
*
* function: make_el_list()
*
* purpose: make element list for processes to step through.
*
* algorithm: sort in top dimension coordinate
*/
long el_list_timestamp[NUMELEMENTS] = { -1,-1,-1,-1,-1 };
/* to see if need remake list */
int vertex_comp(a,b)
vertex_id *a,*b;
{ REAL xa = get_coord(*a)[SDIM-1];
REAL xb = get_coord(*b)[SDIM-1];
if ( xa < xb ) return -1;
if ( xa > xb ) return 1;
return 0;
}
int edge_comp(a,b)
edge_id *a,*b;
{ REAL xa = get_coord(get_edge_tailv(*a))[SDIM-1];
REAL xb = get_coord(get_edge_tailv(*b))[SDIM-1];
if ( xa < xb ) return -1;
if ( xa > xb ) return 1;
return 0;
}
int facet_comp(a,b)
facet_id *a,*b;
{ REAL xa,xb;
if ( web.representation == SIMPLEX )
{ xa = get_coord(get_facet_vertices(*a)[0])[SDIM-1];
xb = get_coord(get_facet_vertices(*b)[0])[SDIM-1];
}
else
{ xa = get_coord(get_fe_tailv(get_facet_fe(*a)))[SDIM-1];
xb = get_coord(get_fe_tailv(get_facet_fe(*b)))[SDIM-1];
}
if ( xa < xb ) return -1;
if ( xa > xb ) return 1;
return 0;
}
void make_el_list(type)
int type; /* element type */
{ element_id id,*tlist;
int pnum,i,bin,end,start;
if ( el_list[type] ) myfree((char*)el_list[type]);
tlist = el_list[type] = (element_id*)mycalloc(web.skel[type].count,
sizeof(element_id));
FOR_ALL_ELEMENTS(type,id)
*(tlist++) = id;
switch(type)
{ case VERTEX:
qsort((char*)(el_list[type]),web.skel[type].count,
sizeof(element_id), FCAST vertex_comp);
/* assign processor numbers */
if ( v_procnum ) myfree((char*)v_procnum);
v_procnum = (int*)mycalloc(web.skel[VERTEX].max_ord+1,sizeof(int));
bin = (web.skel[type].count + nprocs - 1)/nprocs;
for ( pnum = 0 ; pnum < nprocs ; pnum++ )
{ start = pnum*bin;
end = start + bin;
if ( end > web.skel[type].count ) end = web.skel[type].count;
for ( i = start ; i < end ; i++ )
v_procnum[loc_ordinal(el_list[VERTEX][i])] = pnum;
}
break;
case EDGE:
qsort((char*)(el_list[type]),web.skel[type].count,
sizeof(element_id), FCAST edge_comp);
break;
case FACET:
qsort((char*)(el_list[type]),web.skel[type].count,
sizeof(element_id), FCAST facet_comp);
break;
}
el_list_timestamp[type] = top_timestamp;
}
/***********************************************************************
*
* function: multi_calc_quants()
*
* purpose: calculate all values of quantities in parallel.
* This function called in parallel from calc_quants().
* m_next used to parcel out elements to processors.
*
*/
void multi_calc_quants(type)
int type; /* element type */
{
int k;
struct element *e_ptr;
struct gen_quant_method *gm;
int mi;
REAL val;
struct qinfo q_info; /* data passing structure */
int meth_offset = EXTRAS(type)[web.meth_attr[type]].offset;
int me = GET_THREAD_ID; /* which process I am */
int global_needs;
#ifdef THREADS
__int32 multi_calc_quants_elapsed_time[2];
multi_calc_quants_elapsed_time[0] = 0;
multi_calc_quants_elapsed_time[1] = 0;
#endif
#ifdef SIGUSR1
signal(SIGUSR1,catcher); /* to catch user interrupt */
#endif
signal(SIGINT,catcher); /* to catch user interrupt */
m_breakflag[me] = 0;
if ( setjmp(m_jumpbuf[me]) ) { q_info_free(&q_info); return; }
PROF_START(multi_calc_quants)
q_info_init(&q_info,METHOD_VALUE);
global_needs = global_meth_needs(type);
THREAD_FOR_ALL_NEW(type, /* following block is macro argument! */
{ int setup_flag = 0;
int needs; /* particular setup needs for current mode */
q_info.id = *idptr;
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = abs(mm);
if ( (METH_INSTANCE(mi)->flags & Q_DOTHIS)
&& (METH_INSTANCE(mi)->type == type) )
needs |= basic_gen_methods[METH_INSTANCE(mi)->gen_method].flags;
}
for ( k = 0 ; k < global_meth_inst_count[type]; k++ )
{ mi = global_meth_inst[type][k];
if ( (METH_INSTANCE(mi)->flags & Q_DOTHIS)
&& (METH_INSTANCE(mi)->type == type) )
{
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
q_info.method = mi;
gm = basic_gen_methods + METH_INSTANCE(mi)->gen_method;
val = (*gm->value)(&q_info);
if ( METH_INSTANCE(mi)->flags & ELEMENT_MODULUS_FLAG )
val *= *(REAL*)get_extra(q_info.id,METH_INSTANCE(mi)->elmodulus);
METH_INSTANCE(mi)->procvalue[me] += val;
METH_INSTANCE(mi)->procabstotal[me] += fabs(val);
}
}
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
q_info.method = mi = abs(mm);
if ( (METH_INSTANCE(mi)->flags & Q_DOTHIS)
&& (METH_INSTANCE(mi)->type == type) )
{
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
gm = basic_gen_methods + METH_INSTANCE(mi)->gen_method;
val = (*gm->value)(&q_info);
if ( METH_INSTANCE(mi)->flags & ELEMENT_MODULUS_FLAG )
val *= *(REAL*)get_extra(q_info.id,METH_INSTANCE(mi)->elmodulus);
METH_INSTANCE(mi)->procvalue[me] += (mm < 0 ) ? -val : val;
METH_INSTANCE(mi)->procabstotal[me] += fabs(val);
}
}
}
) /* end THREAD_FOR_ALL_NEW macro */
q_info_free(&q_info);
PROF_FINISH(multi_calc_quants)
/*
if ( verbose_flag )
{ PROF_PRINT(multi_calc_quants)
}
*/
}
#endif
/***********************************************************************
*
* function: calc_quants()
*
* purpose: calculate all values of quantities.
* Info passed to methods in global structure
*
*/
REAL calc_quants(mode)
int mode; /* energy, constraint, and/or info flag bits */
{ int k;
struct element *e_ptr;
struct gen_quant *q = NULL;
int type; /* element type */
struct method_instance * mi;
struct gen_quant_method *gm;
REAL energy = 0.0;
struct qinfo q_info; /* data passing structure */
int todo = 0; /* whether any to do */
int global_needs;
#ifdef PROFILING_ENABLED
__int32 value_elapsed_time[2];
#endif
PROF_START(calc_quants);
if ( calc_quant_flag ) return 0.0;
calc_quant_flag = 1; /* so no recursive evaluation */
/* method initialization */
for ( type = 0 ; type < NUMELEMENTS ; type++ ) quant_flags[type] = 0;
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k); /* since some init may move things */
gm = basic_gen_methods + mi->gen_method;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
if ( (!(mi->flags&Q_COMPOUND) && (mi->quant >= 0) &&
((q->modulus == 0.0) || !(q->flags & mode)))
|| (mi->modulus == 0.0) /* || (mi->timestamp == global_timestamp) */ )
{ mi->flags &= ~Q_DOTHIS;
if ( q->flags & mode ) mi->timestamp = global_timestamp;
}
else
{ int kk;
mi->flags |= Q_DOTHIS;
mi->newvalue = 0.0;
for ( kk = 0 ; kk < MAXADDENDS ; kk++ ) mi->value_addends[kk] = 0.0;
mi->abstotal = 0.0;
mi->timestamp = global_timestamp;
quant_flags[basic_gen_methods[mi->gen_method].type] |= mode;
if ( gm->init )
(*gm->init)(METHOD_VALUE,mi);
todo = 1;
}
}
if ( !todo ) goto add_to_quantities;
q_info_init(&q_info,METHOD_VALUE);
for ( type = VERTEX ; type <= BODY ; type++ )
if ( quant_flags[type] & mode )
{ int meth_offset = get_meth_offset(type);
#if defined(SHARED_MEMORY)
if ( (nprocs > 1) || threadflag )
{ int i;
if ( el_list_timestamp[VERTEX] < top_timestamp )
make_el_list(VERTEX); /* need for force */
if ( el_list_timestamp[type] < top_timestamp )
make_el_list(type);
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->procvalue[i] = 0.0;
mi->procabstotal[i] = 0.0;
}
}
for ( i = 0 ; i < nprocs ; i++ ) proc_total_area[i] = 0.0;
#ifdef SGI_MULTI
if ( mpflag == M_INACTIVE ) m_rele_procs(); /* resume parked procs */
mpflag = M_ACTIVE;
m_fork(multi_calc_quants,type,mode);
m_park_procs();
mpflag = M_INACTIVE;
#endif
#ifdef THREADS
m_type = type;
thread_launch(TH_MULTI_CALC_QUANT,type);
#endif
/* sum separate process values */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->newvalue += mi->procvalue[i];
mi->abstotal += mi->procabstotal[i];
}
}
for ( i = 0 ; i < nprocs ; i++ )
web.total_area += proc_total_area[i];
}
else
#endif
{
global_needs = global_meth_needs(type);
FOR_ALL_ELEMENTS(type,q_info.id)
{ int setup_flag = 0;
REAL value;
int needs;
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = METH_INSTANCE(abs(mm));
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
needs |= basic_gen_methods[mi->gen_method].flags;
}
for ( k = 0 ; k < global_meth_inst_count[type] ; k++ )
{ int m = global_meth_inst[type][k];
mi = METH_INSTANCE(m);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ q_info.method = m;
PROF_START(element_setup);
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
PROF_FINISH(element_setup);
mi = METH_INSTANCE(m); /* may have changed */
METHOD_PROFILING_START(mi,value);
gm = basic_gen_methods + mi->gen_method;
value = (*gm->value)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
value *= *(REAL*)get_extra(q_info.id,mi->elmodulus);
binary_tree_add(mi->value_addends,value);
mi->abstotal += fabs(value);
METHOD_PROFILING_END(mi,value);
}
}
for ( k = 0 ; k < (int)e_ptr->method_count ; k++ )
{ int m,mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
m = abs(mm);
q_info.method = m;
mi = METH_INSTANCE(m);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ gm = basic_gen_methods + mi->gen_method;
PROF_START(element_setup);
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
PROF_FINISH(element_setup);
mi = METH_INSTANCE(m);
METHOD_PROFILING_START(mi,value);
value = (*gm->value)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
value *= *(REAL*)get_extra(q_info.id,mi->elmodulus);
if (mm < 0) value = -value;
binary_tree_add(mi->value_addends,value);
mi->abstotal += fabs(value);
METHOD_PROFILING_END(mi,value);
}
}
}
}
}
q_info_free(&q_info);
/* finish off binary tree addition */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ int kk;
mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( kk = 0 ; kk < MAXADDENDS ; kk++ )
mi->newvalue += mi->value_addends[kk];
}
add_to_quantities:
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
mi->value = mi->modulus*mi->newvalue;
}
/* combine methods to quantities */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & mode )
{
#ifdef MPI_EVOLVER
q->value = 0.0;
#else
q->value = q->volconst;
#endif
q->abstotal = 0.0;
q->timestamp = global_timestamp;
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->quant < 0 ) continue;
q = GEN_QUANT(mi->quant);
if ( q->flags & mode )
{ q->value += mi->value;
q->abstotal += mi->abstotal;
}
}
for ( k = compound_quant_list_head ; k >= 0 ; k = q->next_compound )
{ q = GEN_QUANT(k);
if ( (q->flags & mode) && ( q->flags & Q_COMPOUND ) )
{ q->value = eval(&q->expr,NULL,NULLID,NULL);
q->abstotal = 1.0; /* best I can think of for the moment */
}
}
/* set up body volumes */
if ( (mode & Q_FIXED) && web.torus_flag )
{ /* munge fixed volumes modulo torus volume */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( (q->flags & Q_FIXED) && (q->flags & TORUS_MODULO_MUNGE) )
q->value -= web.torusv*
(int)(0.5+(q->value - q->target)/(q->modulus*web.torusv));
}
}
if ( everything_quantities_flag )
{ body_id b_id;
FOR_ALL_BODIES(b_id)
{ q = GEN_QUANT(get_body_volquant(b_id));
if ( q->flags & mode )
set_body_volume(b_id,q->value,SETSTAMP);
}
}
/* multiply by quantity modulus */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & mode )
{
q->value *= q->modulus;
q->abstotal *= fabs(q->modulus);
q->timestamp = global_timestamp;
}
}
/* add to total energy, if needed */
if ( mode & Q_ENERGY )
{
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & Q_ENERGY )
energy += q->value;
}
}
/* take care of any cleanup */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k); /* since some init may move things */
gm = basic_gen_methods + mi->gen_method;
if ( gm->cleanup && mi->flags & Q_DOTHIS ) gm->cleanup();
}
calc_quant_flag = 0;
PROF_FINISH(calc_quants)
return energy;
} /* end calc_quants() */
/********************************************************************
*
* function: quantity_attribute()
*
* purpose: calculate quantity for one element
* Warning: does not do own initialization!
* Uses any initialization left over from calc_quants().
*/
REAL quantity_attribute(id,qnum)
element_id id;
int qnum; /* number of quantity */
{
int k;
struct element *e_ptr;
struct gen_quant *q;
int type = id_type(id); /* element type */
struct method_instance *mi;
struct gen_quant_method *gm;
REAL retval = 0.0,value;
struct qinfo q_info; /* data passing structure */
int meth_offset = EXTRAS(type)[web.meth_attr[type]].offset;
int *methlist = (int*)((char*)elptr(id) + meth_offset);
int needs = 0;
q_info_init(&q_info,METHOD_VALUE); /* terribly inefficient */
q_info.id = id;
e_ptr = elptr(q_info.id);
(*q_setup[type])(NULL,&q_info,needs);
for ( k = 0 ; k < global_meth_inst_count[type] ; k++ )
{ mi = METH_INSTANCE(global_meth_inst[type][k]);
if ( mi->quant != qnum ) continue;
if ( mi->type != type ) continue;
q = GEN_QUANT(mi->quant);
q_info.method = global_meth_inst[type][k];
gm = basic_gen_methods + mi->gen_method;
if ( (gm->flags & ALL_NEEDS) & ~needs )
{ needs |= gm->flags; (*q_setup[type])(NULL,&q_info,needs); }
value = q->modulus*mi->modulus*(*gm->value)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
value *= *(REAL*)get_extra(q_info.id,mi->elmodulus);
retval += value;
}
for ( k = 0 ; k < (int)e_ptr->method_count ; k++ )
{ int mm = methlist[k];
int m = abs(mm);
q_info.method = m;
mi = METH_INSTANCE(m);
if ( mi->quant != qnum ) continue;
if ( mi->type != type ) continue;
q = GEN_QUANT(mi->quant);
gm = basic_gen_methods + mi->gen_method;
if ( (gm->flags & ALL_NEEDS) & ~needs )
{ needs |= gm->flags; (*q_setup[type])(NULL,&q_info,needs); }
value = q->modulus*mi->modulus*(*gm->value)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
value *= *(REAL*)get_extra(q_info.id,mi->elmodulus);
if ( mm < 0 ) retval -= value;
else retval += value;
}
q_info_free(&q_info);
return retval;
}
/********************************************************************
*
* function: instance_attribute()
*
* purpose: calculate method instance for one element
* Warning: does not do own initialization!
* Uses any initialization left over from calc_quants().
*/
REAL instance_attribute(id,qnum)
element_id id;
int qnum; /* number of instance */
{
int k;
struct element *e_ptr;
int type = id_type(id); /* element type */
struct method_instance *mi=NULL;
struct gen_quant_method *gm;
REAL retval = 0.0;
struct qinfo q_info; /* data passing structure */
int meth_offset = EXTRAS(type)[web.meth_attr[type]].offset;
int *methlist = (int*)((char*)elptr(id) + meth_offset);
int needs = 0;
q_info_init(&q_info,METHOD_VALUE); /* terribly inefficient */
q_info.id = id;
e_ptr = elptr(q_info.id);
(*q_setup[type])(NULL,&q_info,needs);
for ( k = 0 ; k < global_meth_inst_count[type] ; k++ )
{ if ( qnum != global_meth_inst[type][k] ) continue;
mi = METH_INSTANCE(global_meth_inst[type][k]);
if ( mi->type != type ) continue;
q_info.method = global_meth_inst[type][k];
gm = basic_gen_methods + mi->gen_method;
if ( (gm->flags & ALL_NEEDS) & ~needs )
{ needs |= gm->flags; (*q_setup[type])(NULL,&q_info,needs); }
retval += mi->modulus*(*gm->value)(&q_info);
break;
}
for ( k = 0 ; k < (int)e_ptr->method_count ; k++ )
{ int mm = methlist[k];
int m = abs(mm);
if ( qnum != m ) continue;
mi = METH_INSTANCE(m);
q_info.method = m;
if ( mi->type != type ) continue;
gm = basic_gen_methods + mi->gen_method;
if ( (gm->flags & ALL_NEEDS) & ~needs )
{ needs |= gm->flags; (*q_setup[type])(NULL,&q_info,needs); }
if ( mm < 0 ) retval -= mi->modulus*(*gm->value)(&q_info);
else retval += mi->modulus*(*gm->value)(&q_info);
break;
}
if ( mi && (mi->flags & ELEMENT_MODULUS_FLAG) )
retval *= *(REAL*)get_extra(id,METH_INSTANCE(qnum)->elmodulus);
q_info_free(&q_info);
return retval;
}
#if defined(SHARED_MEMORY)
/* SGI multiple processor stuff */
void m_fill_grad(struct hess_verlist *, REAL *,int,REAL *);
void m_fill_mixed_entry(vertex_id,vertex_id,REAL**,int);
/***********************************************************************
*
* function: m_calc_quant_grads()
*
* purpose: calculate gradients of quantities
* Called by calc_quant_grads()
*
*/
void m_calc_quant_grads(type)
int type; /* element type */
{ int i,j;
struct element *e_ptr;
struct gen_quant *q;
volgrad *vgptr; /* constraint gradients */
int flag; /* 0 if doing global quantities, 1 for local */
vertex_id v;
struct gen_quant_method *gm;
struct method_instance *mi;
REAL val;
REAL *f;
int inum;
struct qinfo q_info; /* data passing structure */
int meth_offset = get_meth_offset(type);
int me = GET_THREAD_ID;
int global_needs;
#ifdef SIGUSR1
signal(SIGUSR1,catcher); /* to catch user interrupt */
#endif
signal(SIGINT,catcher); /* to catch user interrupt */
m_breakflag[me] = 0;
if ( setjmp(m_jumpbuf[me]) ) { q_info_free(&q_info); return; }
q_info_init(&q_info,METHOD_GRADIENT);
global_needs = global_meth_needs(type);
THREAD_FOR_ALL_NEW(type, /* following block is macro argument! */
{ int k;
int setup_flag = 0;
int needs;
q_info.id = *idptr;
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = METH_INSTANCE(abs(mm));
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
needs |= basic_gen_methods[mi->gen_method].flags;
}
inum = global_meth_inst_count[type];
for ( flag = 0 ; flag < 2 ; flag++,inum = e_ptr->method_count,k=0 )
for ( k = 0 ; k < inum ; k++ )
{ int mm;
int sign = 1;
if ( flag )
{ mm = ((int*)((char*)e_ptr+meth_offset))[k];
q_info.method = abs(mm);
if ( mm < 0 ) sign = -1;
}
else q_info.method = global_meth_inst[type][k];
mi = METH_INSTANCE(q_info.method);
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ REAL c = sign*mi->modulus*q->modulus;
REAL *p;
REAL **pp;
gm = basic_gen_methods + mi->gen_method;
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
for ( i = 0, pp = q_info.grad ; i < q_info.vcount ; i++,pp++ )
for ( j = 0, p = *pp ; j < SDIM ; j++,p++ ) *p = 0.0;
val = (*gm->gradient)(&q_info);
mi = METH_INSTANCE(q_info.method);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
{ REAL emdls = *(REAL*)get_extra(q_info.id,mi->elmodulus);
val *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
q_info.grad[i][j] *= emdls;
}
mi->procvalue[me] += sign*val;
mi->procabstotal[me] += fabs(val);
if ( mi->flags & Q_COMPOUND )
{ if ( q_info.vcount > MAXCOORD+2 )
kb_error(2181,
"Too many vertices in method for compound quantity, due to lazy programmer.\n",
RECOVERABLE);
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
mi->grad[i][j] = q_info.grad[i][j];
}
if ( mi->quant >= 0 && !(mi->flags & Q_COMPOUND) )
for ( i = 0 ; i < q_info.vcount ; i++ )
{
REAL wforce[MAXCOORD]; /* unwrapped forces */
REAL *ff;
v = q_info.v[i];
if ( q_info.wraps[i] )
{ (*sym_form_pullback)(q_info.x[i],wforce,q_info.grad[i],
q_info.wraps[i]);
ff = wforce;
}
else ff = q_info.grad[i];
if ( q->flags & Q_ENERGY )
{ int procnum = v_procnum[loc_ordinal(v)];
if ( procnum == me )
{ /* no conflicts */
f = get_force(v);
vector_add_smul(f,ff,-c, SDIM);
}
else /* have to save */
{ int newp = ptop[me]++;
struct procforce *pf;
if ( newp >= pmax[me] )
{ pbase[me] = (struct procforce *)kb_realloc(
(char*)(pbase[me]),2*pmax[me]*sizeof(struct procforce));
pmax[me] = 2*pmax[me];
}
pf = pbase[me] + newp;
pf->v_id = v;
pf->next = phead[procnum][me];
phead[procnum][me] = newp;
for ( j = 0 ; j < SDIM ; j++ )
pf->f[j] = -c*ff[j];
}
}
else
{ M_LOCK(vgradbase);
vgptr = get_bv_new_vgrad(q->fixnum,v);
vgptr->bb_id = q->b_id;
vgptr->qnum = mi->quant;
vector_add_smul(vgptr->grad,ff, c, SDIM);
M_UNLOCK(vgradbase);
}
}
}
}
}
) /* end of macro */
q_info_free(&q_info);
} /* m_calc_quant_grads */
/***********************************************************************
*
* function: m_fix_grads()
*
* purpose: Processes add forces from other processes to own vertices.
*/
void m_fix_grads()
{ int me = GET_THREAD_ID;
int pnum;
int i,k;
struct procforce *p;
REAL *f;
for ( pnum = 0 ; pnum < nprocs ; pnum++ )
{ for ( k = phead[me][pnum] ; k >= 0 ; k = p->next )
{ p = pbase[pnum] + k;
f = get_force(p->v_id);
for ( i = 0 ; i < SDIM ; i++ ) f[i] += p->f[i];
}
}
}
#endif
/***********************************************************************
*
* function: calc_quant_grads()
*
* purpose: calculate gradients of quantities
* Called by vol_project(), which does all other
* structure initializing and messing around.
* Also calculates quantity values themselves.
*
*/
void calc_quant_grads(mode)
int mode; /* energy or constraint, or Q_COMPOUND for aiding hessian */
{ int i,k;
struct element *e_ptr;
struct gen_quant *q = NULL;
volgrad *vgptr; /* constraint gradients */
int flag; /* 0 if doing global quantities, 1 for local */
vertex_id v;
int type; /* element type */
struct method_instance *mi;
struct gen_quant_method *gm;
int inum;
struct qinfo q_info; /* data passing structure */
int todo = 0; /* whether any to do */
int global_needs;
#ifdef PROFILING_ENABLED
__int32 grad_elapsed_time[2];
#endif
PROF_START(calc_quant_grads);
/* method initialization */
comp_quant_stamp = 0;
for ( type = 0 ; type < NUMELEMENTS ; type++ ) quant_flags[type] = 0;
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k); /* since some init may have moved things */
mi->stamp = 0; /* so only current methods used in eval_all() */
gm = basic_gen_methods + mi->gen_method;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant); else q = NULL;
if ( !q || (q->modulus==0.0) || !(q->flags & mode & ~Q_COMPOUND) ||
(mi->modulus==0.0) )
mi->flags &= ~Q_DOTHIS;
else
{ mi->flags |= Q_DOTHIS;
mi->newvalue = 0.0;
mi->abstotal = 0.0;
mi->timestamp = global_timestamp;
quant_flags[basic_gen_methods[mi->gen_method].type] |= mode;
if ( gm->init )
(*gm->init)(METHOD_GRADIENT,mi);
todo = 1;
}
}
if ( !todo )
{ PROF_FINISH(calc_quant_grads);
return;
}
q_info_init(&q_info,METHOD_GRADIENT);
if ( compound_quant_list_head >= 0 )
{ for ( k=LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_COMPOUND )
{ mi->grad = dmatrix(0,MAXVCOUNT,0,SDIM);
}
}
}
for ( type = VERTEX ; type <= BODY ; type++ )
if ( quant_flags[type] & mode )
{ int meth_offset = get_meth_offset(type);
global_needs = global_meth_needs(type);
#if defined(SHARED_MEMORY)
if ((compound_quant_list_head == -1) && ((nprocs > 1) || threadflag) )
{
if ( el_list_timestamp[VERTEX] < top_timestamp )
make_el_list(VERTEX); /* need for force */
if ( el_list_timestamp[type] < top_timestamp )
make_el_list(type);
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->procvalue[i] = 0.0;
mi->procabstotal[i] = 0.0;
}
}
for ( i = 0 ; i < nprocs ; i++ ) proc_total_area[i] = 0.0;
for ( i = 0 ; i < nprocs ; i++ )
{ int j;
ptop[i] = 0 ;
if ( pbase[i] == NULL )
{ pmax[i] = 1000;
pbase[i] = (struct procforce *)mycalloc(pmax[i],
sizeof(struct procforce));
}
for ( j = 0 ; j < nprocs ; j++ ) phead[i][j] = -1;
}
#ifdef SGI_MULTI
if ( mpflag == M_INACTIVE ) m_rele_procs(); /* resume parked procs */
mpflag = M_ACTIVE;
m_fork(m_calc_quant_grads,type,mode);
m_fork(m_fix_grads,0,0);
m_park_procs();
mpflag = M_INACTIVE;
#endif
#ifdef THREADS
m_type = type;
thread_launch(TH_MULTI_QUANT_GRADS,type);
thread_launch(TH_FIX_GRADS,0);
#endif
/* sum separate process values */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->newvalue += mi->procvalue[i];
mi->abstotal += mi->procabstotal[i];
}
}
for ( i = 0 ; i < nprocs ; i++ )
web.total_area += proc_total_area[i];
}
else
#endif
/* Don't put anything here; non-shared falls through!! */
FOR_ALL_ELEMENTS(type,q_info.id)
{ int j;
int setup_flag = 0;
int needs;
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = METH_INSTANCE(abs(mm));
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
needs |= basic_gen_methods[mi->gen_method].flags;
}
inum = global_meth_inst_count[type];
++comp_quant_stamp;
for ( flag = 0 ; flag < 2 ; flag++,inum = e_ptr->method_count,k=0 )
{ for ( k = 0 ; k < inum ; k++ )
{ int mm;
int sign = 1;
if ( flag )
{ mm = ((int*)((char*)e_ptr+meth_offset))[k];
q_info.method = abs(mm);
if ( mm < 0 ) sign = -1;
}
else q_info.method = global_meth_inst[type][k];
mi = METH_INSTANCE(q_info.method);
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ REAL c = 0; /* net coefficient */
REAL value;
gm = basic_gen_methods + mi->gen_method;
PROF_START(element_setup);
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
PROF_FINISH(element_setup);
mi = METH_INSTANCE(q_info.method);
METHOD_PROFILING_START(mi,grad);
for ( i = 0 ; i < q_info.vcount ; i++ ) /* methods don't know */
for ( j = 0 ; j < SDIM ; j++ ) /* how many */
q_info.grad[i][j] = 0.0;
value = (*gm->gradient)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
{ REAL emdls = *(REAL*)get_extra(q_info.id,mi->elmodulus);
value *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
q_info.grad[i][j] *= emdls;
}
mi->newvalue += sign*value;
mi->abstotal += fabs(value);
if ( mi->flags & Q_COMPOUND )
{
for ( i = 0 ; i < q_info.vcount ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ )
mi->grad[i][j] = mi->modulus*q_info.grad[i][j];
}
mi->stamp = comp_quant_stamp;
}
if ( mi->quant >= 0 )
c = sign*mi->modulus*q->modulus;
for ( i = 0 ; i < q_info.vcount ; i++ )
{
REAL wforce[MAXCOORD]; /* unwrapped forces */
REAL *ff;
v = q_info.v[i];
if ( q_info.wraps[i] )
{ (*sym_form_pullback)(q_info.x[i],wforce,q_info.grad[i],
q_info.wraps[i]);
ff = wforce;
}
else ff = q_info.grad[i];
if ( mi->quant >= 0 && !(mi->flags & Q_COMPOUND) )
{ if ( q->flags & Q_ENERGY & mode )
{ REAL *f = get_force(v);
vector_add_smul(f,ff, -c, SDIM);
}
else if ( q->flags & (Q_FIXED|Q_CONSERVED) & mode )
{ vgptr = get_bv_new_vgrad(q->fixnum,v);
vgptr->bb_id = q->b_id;
vgptr->qnum = mi->quant;
vector_add_smul(vgptr->grad,ff, c, SDIM);
}
}
if ( mode & mi->flags & Q_COMPOUND )
{
vgptr = get_bv_new_vgrad(mi->self_id,v);
vgptr->bb_id = mi->self_id;
vgptr->qnum = mi->self_id;
vector_add_smul(vgptr->grad,ff, mi->modulus, SDIM);
}
}
METHOD_PROFILING_END(mi,grad);
}
}
} /* end calculation of all method instances */
/* check out compound quantities */
for ( k = compound_quant_list_head ; k >= 0 ; k = q->next_compound )
{ q = GEN_QUANT(k);
if ( (q->flags & mode) && (q->flags & Q_COMPOUND) )
{ for ( i = 0 ; i < q_info.vcount ; i++ )
{ REAL dummy,partials[MAXCOORD];
comp_quant_vertex = i; /* so eval_all knows */
eval_all(&q->expr,NULL,SDIM,&dummy,partials,NULLID);
v = q_info.v[i];
if ( q->flags & Q_ENERGY )
{ REAL *f = get_force(v);
vector_add_smul(f,partials, -q->modulus, SDIM);
}
else
{
vgptr = get_bv_new_vgrad(q->fixnum,v);
vgptr->bb_id = q->b_id;
vgptr->qnum = k;
vector_add_smul(vgptr->grad,partials, q->modulus, SDIM);
}
}
}
}
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
{ mi->value = mi->modulus*mi->newvalue;
mi->abstotal *= fabs(mi->modulus);
}
}
/* combine methods to quantities */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & mode )
{ q->value = q->volconst;
q->abstotal = 0.0;
q->timestamp = global_timestamp;
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->quant < 0 ) continue;
q = GEN_QUANT(mi->quant);
if ( q->flags & mode )
{ q->value += q->modulus*mi->value;
q->abstotal += fabs(q->modulus)*mi->abstotal;
}
}
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & mode )
if ( q->flags & Q_COMPOUND )
{ q->value = q->modulus*eval(&q->expr,NULL,NULLID,NULL);
q->abstotal = 1.0;
}
}
if ( (mode & Q_FIXED) && web.torus_flag )
{ /* munge fixed volumes modulo torus volume */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( (q->flags & Q_FIXED)
&& (q->flags & TORUS_MODULO_MUNGE) )
q->value -= q->modulus*web.torusv*
(int)(0.5+(q->value - q->target)/(q->modulus*web.torusv));
}
}
/* take care of any cleanup */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k); /* since some init may move things */
gm = basic_gen_methods + mi->gen_method;
if ( gm->cleanup && mi->flags & Q_DOTHIS ) gm->cleanup();
}
if ( compound_quant_list_head >= 0 )
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_COMPOUND )
{ free_matrix(mi->grad); mi->grad = NULL;
}
}
q_info_free(&q_info);
PROF_FINISH(calc_quant_grads);
} /* end calc_quant_grads() */
/***********************************************************************
*
* function: calc_quant_hess()
*
* purpose: calculate hessians of quantities
*
*/
void calc_quant_hess(S,rhs_mode,hess_mode,rhs)
struct linsys *S; /* to gather hessian */
int rhs_mode; /* whether to do rhs */
int hess_mode; /* 1 for full hessian */
REAL *rhs;
{ int i,ii,k,j,jj,m,n;
struct element *e_ptr;
struct gen_quant *q = NULL;
int flag; /* 0 if doing global quantities, 1 for local */
int type; /* element type */
struct method_instance *mi;
struct gen_quant_method *gm;
int inum;
REAL g[MAXCOORD],*ggg;
REAL **p1,**p2;
struct hess_verlist *va,*vb;
int mode = Q_ENERGY|Q_FIXED|Q_CONSERVED;
REAL coeff; /* net modulus, including pressure if fixed quant */
REAL ccoeff=0.0; /* net modulus */
struct qinfo q_info; /* data passing structure */
int todo = 0;
MAT2D(seconds,2*MAXCOORD,2*MAXCOORD);
int global_needs;
#ifdef PROFILING_ENABLED
__int32 hess_elapsed_time[2];
#endif
PROF_START(calc_quant_hess);
if ( compound_quant_list_head >= 0 )
{
/* get total gradients for compound quantities */
vgrad_end();
vgrad_init(1);
calc_quant_grads(Q_COMPOUND|Q_FIXED|Q_ENERGY|Q_CONSERVED);
if ( quantity_function_sparse_flag )
add_vgrads_to_update(S);
compound_hess_flag = CH_GRADS;
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( !(q->flags & Q_COMPOUND ) ) continue;
if ( q->flags & (Q_ENERGY|Q_FIXED|Q_CONSERVED) )
{ REAL coeff = q->modulus;
if ( q->flags & (Q_FIXED|Q_CONSERVED) ) coeff *= -q->pressure;
if ( quantity_function_sparse_flag )
{ /* second partials of quantity wrt methods */
REAL dummy,partials[2*MAXCOORD];
eval_second(&q->expr,NULL,q->method_count,&dummy,partials,seconds,NULLID);
for ( i = 0 ; i < q->method_count ; i++ )
{ int ii = METH_INSTANCE(q->meth_inst[i])->global_low_rank;
for ( j = 0 ; j < q->method_count ; j++ )
{ int jj = METH_INSTANCE(q->meth_inst[j])->global_low_rank;
S->low_rank_form[ii][jj] += coeff*seconds[i][j];
}
}
}
else /* old dense way */
FOR_ALL_VERTICES(comp_quant_vi)
{ REAL dummy,partials[2*MAXCOORD];
if ( get_vattr(comp_quant_vi) & FIXED ) continue;
FOR_ALL_VERTICES(comp_quant_vj)
{
if ( comp_quant_vi > comp_quant_vj ) continue;
if ( get_vattr(comp_quant_vj) & FIXED ) continue;
eval_second(&q->expr,NULL,2*SDIM,&dummy,partials,seconds,NULLID);
for ( m = 0 ; m < SDIM ; m++ )
for ( n = 0 ; n < SDIM ; n++ )
seconds[m+SDIM][n] *= coeff;
fill_mixed_entry(S,comp_quant_vj,comp_quant_vi,seconds+SDIM);
}
}
}
}
}
compound_hess_flag = 0;
comp_quant_stamp = 0;
/* method initialization */
for ( type = 0 ; type < NUMELEMENTS ; type++ ) quant_flags[type] = 0;
for ( k = LOW_INST ; k < meth_inst_count ;k++ )
{ mi = METH_INSTANCE(k);
mi->stamp = 0; /* so only current methods used in eval_all() */
gm = basic_gen_methods + mi->gen_method;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
if ( (!(mi->flags&Q_COMPOUND) && (mi->quant >= 0) &&
((q->modulus == 0.0) || !(q->flags & mode)))
|| (mi->modulus == 0.0) ||
((mi->quant >= 0) && (q->flags & Q_REDUNDANT)) )
mi->flags &= ~Q_DOTHIS;
else
{ mi->flags |= Q_DOTHIS;
if ( (gm->hessian == NULL) || (gm->hessian == null_q_hess) )
{ sprintf(errmsg,"Method %s has no Hessian available.\n",gm->name);
kb_error(1571,errmsg,RECOVERABLE);
}
mi->newvalue = 0.0;
mi->abstotal = 0.0;
mi->timestamp = global_timestamp;
quant_flags[basic_gen_methods[mi->gen_method].type] |= mode;
if ( gm->init )
(*gm->init)(METHOD_HESSIAN,mi);
todo = 1;
}
}
if ( !todo )
{ PROF_FINISH(calc_quant_hess);
return;
}
/* set up matrices in qinfo with lots of room */
q_info_init(&q_info,METHOD_HESSIAN);
q_info.hess = dmatrix4(MAXVCOUNT,MAXVCOUNT,SDIM,SDIM);
p1 = dmatrix(0,MAXCOORD-1,0,MAXCOORD-1);
p2 = dmatrix(0,MAXCOORD-1,0,MAXCOORD-1);
if ( compound_quant_list_head >= 0 )
{
for ( k=LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_COMPOUND )
{ mi->grad = dmatrix(0,MAXVCOUNT,0,SDIM);
mi->hess = dmatrix4(MAXVCOUNT,MAXVCOUNT,SDIM,SDIM);
}
}
}
for ( type = VERTEX ; type <= BODY ; type++ )
if ( quant_flags[type] & mode )
{ int meth_offset = get_meth_offset(type);
#if defined(SHARED_MEMORY)
if ( (compound_quant_list_head == -1) && ((nprocs > 1) || threadflag) )
{
if ( el_list_timestamp[VERTEX] < top_timestamp )
make_el_list(VERTEX); /* need for force */
if ( el_list_timestamp[type] < top_timestamp )
make_el_list(type);
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->procvalue[i] = 0.0;
mi->procabstotal[i] = 0.0;
}
}
m_hess_mode = hess_mode;
m_rhs_mode = rhs_mode;
#ifdef SGI_MULTI
if ( mpflag == M_INACTIVE ) m_rele_procs(); /* resume parked procs */
mpflag = M_ACTIVE;
m_quanrowstart = S->quanrowstart;
m_bodyrowstart = S->bodyrowstart;
m_fork(m_calc_quant_hess,type,mode,rhs);
m_park_procs();
mpflag = M_INACTIVE;
#endif
#ifdef THREADS
m_type = type;
m_mode = mode;
m_rhs = rhs;
thread_launch(TH_MULTI_QUANT_HESS,type);
#endif
m_fix_hess(S);
/* sum separate process values */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
for ( i = 0 ; i < nprocs ; i++ )
{ mi->newvalue += mi->procvalue[i];
mi->abstotal += mi->procabstotal[i];
}
}
}
else
#endif
{
global_needs = global_meth_needs(type);
FOR_ALL_ELEMENTS(type,q_info.id)
{ int setup_flag = 0;
int needs;
++comp_quant_stamp;
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = METH_INSTANCE(abs(mm));
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
needs |= basic_gen_methods[mi->gen_method].flags;
}
inum = global_meth_inst_count[type];
for ( flag = 0 ; flag < 2 ; flag++,inum = e_ptr->method_count,k=0 )
for ( k = 0 ; k < inum ; k++ )
{ int mm;
int sign = 1;
if ( flag )
{ mm = ((int*)((char*)e_ptr+meth_offset))[k];
q_info.method = abs(mm);
if ( mm < 0 ) sign = -1;
}
else q_info.method = global_meth_inst[type][k];
mi = METH_INSTANCE(q_info.method);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ REAL value;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
PROF_START(element_setup);
if ( !setup_flag )
{ (*q_setup[type])(S,&q_info,needs); setup_flag = 1; }
PROF_FINISH(element_setup);
coeff = sign*q->modulus*mi->modulus;
if ( q->flags & (Q_FIXED|Q_CONSERVED) )
{ ccoeff = coeff; coeff *= -q->pressure; }
mi = METH_INSTANCE(q_info.method);
METHOD_PROFILING_START(mi,hess);
gm = basic_gen_methods + mi->gen_method;
zerohess(&q_info);
if ( hess_mode ) value = (*gm->hessian)(&q_info);
else value = (*gm->gradient)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
{ REAL emdls = *(REAL*)get_extra(q_info.id,mi->elmodulus);
value *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
q_info.grad[i][j] *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( ii = 0 ; ii < q_info.vcount ; ii++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
q_info.hess[i][ii][j][jj] *= emdls;
}
mi->newvalue += sign*value;
mi->abstotal += fabs(value);
/* unwrap */
if ( sym_flags & NEED_FORM_UNWRAPPING )
{ /* gradient */
REAL grad[MAXCOORD];
for ( i = 0 ; i < q_info.vcount ; i++ )
{ if ( q_info.wraps[i] )
{ (*sym_form_pullback)(q_info.x[i],grad,q_info.grad[i],
q_info.wraps[i]);
for ( j = 0 ; j < SDIM ; j++ ) q_info.grad[i][j] = grad[j];
}
}
if ( hess_mode )
{ for ( i = 0 ; i < q_info.vcount ; i++ )
for ( ii = 0 ; ii < q_info.vcount ; ii++ )
{ if ( q_info.wraps[i] )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ REAL tmp[MAXCOORD];
for ( j = 0 ; j < SDIM ; j++ )
tmp[j]=q_info.hess[i][ii][j][jj];
(*sym_form_pullback)(q_info.x[i],grad,tmp,q_info.wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
q_info.hess[i][ii][j][jj] = grad[j];
}
if ( q_info.wraps[ii] )
for ( j = 0 ; j < SDIM ; j++ )
{ (*sym_form_pullback)(q_info.x[ii],grad,
q_info.hess[i][ii][j],q_info.wraps[ii]);
for ( jj = 0 ; jj < SDIM ; jj++ )
q_info.hess[i][ii][j][jj] = grad[jj];
}
}
}
}
if ( mi->flags & Q_COMPOUND )
{ mi->vlist = q_info.v; /* for eval_sec */
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( m = 0 ; m < SDIM ; m++ )
mi->grad[i][m] = mi->modulus*q_info.grad[i][m];
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < q_info.vcount ; j++ )
for ( m = 0 ; m < SDIM ; m++ )
for ( n = 0 ; n < SDIM ; n++ )
mi->hess[i][j][m][n] = mi->modulus*q_info.hess[i][j][m][n];
mi->stamp = comp_quant_stamp;
}
else
{
for ( i = 0 ; i < q_info.vcount ; i++ )
{ REAL grad[MAXCOORD];
va = get_vertex_vhead(q_info.v[i]);
for ( j = 0 ; j < SDIM ; j++ )
grad[j] = coeff*q_info.grad[i][j];
fill_grad(S,va,grad,rhs);
}
/* second derivatives */
if ( hess_mode && (mode & (Q_FIXED|Q_ENERGY|Q_CONSERVED)) )
for ( i = 0 ; i < q_info.vcount ; i++ )
{ va = get_vertex_vhead(q_info.v[i]);
if ( va->freedom == 0 ) continue;
for ( j = i ; j < q_info.vcount ; j++ )
{ vb = get_vertex_vhead(q_info.v[j]);
if ( vb->freedom == 0 ) continue;
for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0 ; m < SDIM ; m++ )
q_info.hess[i][j][m][n] *= coeff;
fill_mixed_entry(S,q_info.v[i],q_info.v[j],q_info.hess[i][j]);
if ( (i != j) && (q_info.v[i] == q_info.v[j]) ) /* also transpose */
{ MAT2D(transpose,MAXCOORD,MAXCOORD);
for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0 ; m < SDIM ; m++ )
transpose[m][n] = q_info.hess[i][j][n][m];
fill_mixed_entry(S,q_info.v[i],q_info.v[j],transpose);
}
} /* end inner vertex loop */
/* fixed quantity gradients for left side */
if ( q->flags & (Q_FIXED|Q_CONSERVED) )
{ /* find entry */
int currentrow;
if ( va->proj )
{ vec_mat_mul(q_info.grad[i],va->proj,g,SDIM,
va->freedom);
ggg = g;
}
else ggg = q_info.grad[i];
currentrow = S->quanrowstart + mi->quant;
for ( m = 0 ; m < va->freedom ; m++ )
{ sp_hash_search(S,va->rownum+m,currentrow,ccoeff*ggg[m]);
}
}
} /* end second derivatives */
} /* end non-compound */
METHOD_PROFILING_END(mi,hess);
} /* end if */
} /* end method instance loop */
/* Here we take care of compound quantities */
for ( k = compound_quant_list_head ; k >= 0 ; k = q->next_compound )
{ q = GEN_QUANT(k);
if ( (q->flags & mode) && (q->flags & Q_COMPOUND) )
{
for ( i = 0 ; i < q_info.vcount ; i++ )
{ REAL dummy,partials[MAXCOORD];
REAL grad[MAXCOORD];
comp_quant_vertex = i; /* so eval_all knows */
comp_quant_type = type;
eval_all(&q->expr,NULL,SDIM,&dummy,partials,NULLID);
va = get_vertex_vhead(q_info.v[i]);
for ( j = 0 ; j < SDIM ; j++ )
grad[j] = q->modulus*partials[j];
fill_grad(S,va,grad,rhs);
/* fixed quantity gradients for left side */
if ( (q->flags & (Q_FIXED|Q_CONSERVED)) && hess_mode )
{ /* find entry */
int currentrow;
if ( va->proj )
{ vec_mat_mul(grad,va->proj,g,SDIM, va->freedom);
ggg = g;
}
else ggg = grad;
currentrow = S->quanrowstart + k;
for ( m = 0 ; m < va->freedom ; m++ )
{ sp_hash_search(S,va->rownum+m,currentrow,q->modulus*ggg[m]);
}
}
}
/* second derivatives */
compound_hess_flag = CH_HESS;
if ( hess_mode )
for ( i = 0 ; i < q_info.vcount ; i++ )
{ REAL dummy[MAXCOORD];
REAL partials[MAXCOORD];
va = get_vertex_vhead(q_info.v[i]);
if ( va->freedom == 0 ) continue;
for ( j = i ; j < q_info.vcount ; j++ )
{ vb = get_vertex_vhead(q_info.v[j]);
if ( vb->freedom == 0 ) continue;
comp_quant_vertexi = i; /* so eval_all knows */
comp_quant_vertexj = j; /* so eval_all knows */
eval_second(&q->expr,NULL,SDIM,dummy,partials,seconds,NULLID);
for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0 ; m < SDIM ; m++ )
q_info.hess[i][j][m][n] = q->modulus*seconds[m][n];
fill_mixed_entry(S,q_info.v[i],q_info.v[j],q_info.hess[i][j]);
if ( (i != j) && (q_info.v[i] == q_info.v[j]) ) /* also transpose */
{ MAT2D(transpose,MAXCOORD,MAXCOORD);
for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0 ; m < SDIM ; m++ )
transpose[m][n] = q_info.hess[i][j][n][m];
fill_mixed_entry(S,q_info.v[i],q_info.v[j],transpose);
}
} /* end inner vertex loop */
} /* end second derivatives */
compound_hess_flag = 0;
}
} /* end compound quantities */
} /* end all element loop */
}
} /* end single thread */
/* free stuff */
free_matrix4(q_info.hess);
free_matrix(p1);
free_matrix(p2);
q_info_free(&q_info);
if ( compound_quant_list_head >= 0 )
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_COMPOUND )
{ free_matrix(mi->grad); mi->grad = NULL;
free_matrix4(mi->hess); mi->hess = NULL;
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_DOTHIS )
{ mi->value = mi->modulus*mi->newvalue;
mi->abstotal *= fabs(mi->modulus);
}
}
/* combine methods to quantities */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & mode )
{ q->value = q->volconst;
q->abstotal = 0.0;
q->timestamp = global_timestamp;
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k);
if ( mi->flags & Q_COMPOUND ) continue;
gm = basic_gen_methods + mi->gen_method;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
if ( (mi->quant >= 0) && (q->flags & mode) )
{ q->value += q->modulus*mi->value;
q->abstotal += fabs(q->modulus)*mi->abstotal;
}
}
for ( k = compound_quant_list_head ; k >= 0 ; k = q->next_compound )
{ q = GEN_QUANT(k);
if ( (q->flags & mode) && ( q->flags & Q_COMPOUND ) )
{ q->value = q->modulus*eval(&q->expr,NULL,NULLID,NULL);
q->abstotal = 1.0;
}
}
if ( (mode & Q_FIXED) && web.torus_flag )
{ /* munge fixed volumes modulo torus volume */
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( (q->flags & Q_FIXED)
&& (q->flags & TORUS_MODULO_MUNGE) )
q->value -= q->modulus*web.torusv*
(int)(0.5+(q->value - q->target)/(q->modulus*web.torusv));
}
}
/* take care of any cleanup */
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ mi = METH_INSTANCE(k); /* since some init may move things */
gm = basic_gen_methods + mi->gen_method;
if ( gm->cleanup && mi->flags & Q_DOTHIS ) gm->cleanup();
}
vgrad_end();
PROF_FINISH(calc_quant_hess);
}
#if defined(SHARED_MEMORY)
/* SGI multiple processor stuff */
/**********************************************************************
Hash list routines for Hessian matrix entries.
Key is (row,col).
**********************************************************************/
#define PRIME 99991
#define hash(row,col) (abs((row)*97+(col)*PRIME))
static int m_max_fill[MAXPROCS]; /* max number of entries until enlarge */
static int m_hashcount[MAXPROCS]; /* current number of entries */
static int m_hash_per_row[MAXPROCS]; /* estimate size of table */
static int m_hash_extraprobes; /* for measuring efficiency */
static int m_bodyrowstart,m_quanrowstart,m_total_rows;
struct hess_entry *m_hashtable[MAXPROCS]; /* the table */
int m_table_size[MAXPROCS]; /* hashtable size */
void m_hess_hash_search(int,int,REAL,int);
void m_hess_hash_init(void);
void m_hess_hash_expand(void);
/********************************************************************
*
* function: m_hess_hash_init()
*
* purpose: Initialize hash table.
*/
void m_hess_hash_init()
{ int i;
int me = GET_THREAD_ID;
if ( m_hash_per_row[me] < 1 ) m_hash_per_row[me] = 1;
m_table_size[me] = m_hash_per_row[me]*SDIM*web.skel[VERTEX].max_ord/nprocs;
m_max_fill[me] = 4*m_table_size[me]/5;
if ( !hessian_quiet_flag )
{ sprintf(msg,"m_Hess init alloc: %d\n",m_table_size[me]);
outstring(msg);
}
m_hashcount[me] = 0;
if ( m_hashtable[me] ) temp_free((char*)m_hashtable[me]);
m_hashtable[me] =
(struct hess_entry *)mycalloc(m_table_size[me],sizeof(struct hess_entry));
for ( i = 0 ; i < m_table_size[me] ; i++ ) m_hashtable[me][i].row = HASHEMPTY;
m_hash_extraprobes = 0;
}
/********************************************************************
*
* function: m_hess_hash_expand()
*
* purpose: Expands hash table
*/
void m_hess_hash_expand()
{ struct hess_entry *newtable,*oldtable;
int i;
int me = GET_THREAD_ID;
struct hess_entry *e;
int newsize;
int oldsize = m_table_size[me];
if ( !m_hashtable[me] ) m_hess_hash_init();
newsize = m_table_size[me]*2;
oldtable = m_hashtable[me];
newtable =
(struct hess_entry *)mycalloc(newsize,sizeof(struct hess_entry));
for ( i = 0 ; i < newsize ; i++ ) newtable[i].row = HASHEMPTY;
m_table_size[me] = newsize;
m_max_fill[me] = 4*m_table_size[me]/5;
m_hashtable[me] = newtable;
/* reinsert */
m_hashcount[me] = 0;
for ( i = 0, e = oldtable ; i < oldsize ; i++,e++ )
if ( e->row != HASHEMPTY )
m_hess_hash_search(e->col,e->row,e->value,me);
myfree((char*)oldtable);
}
/********************************************************************
*
* function: m_hess_hash_search()
*
* purpose: Finds existing entry or allocates entry.
* Installs key values, and adds hessian value.
*/
void m_hess_hash_search(col,row,value,tid)
int row,col; /* meant to do upper triangle */
REAL value; /* value to add */
int tid; /* thread id */
{
struct hess_entry *e;
int spot;
struct hess_entry *hashtab;
int tab_size = m_table_size[tid];
if ( row > col ) return;
if ( m_hashcount[tid] >= m_max_fill[tid] ) m_hess_hash_expand();
hashtab = m_hashtable[tid];
/* search hash table */
spot = hash(row,col) % tab_size;
e = hashtab + spot;
while ( e->row != HASHEMPTY )
{ if ( (e->row == row) && (e->col == col) )
{ e->value += value; return;
}
spot++;
if ( spot >= tab_size ) spot -= tab_size;
e = hashtab + spot;
m_hash_extraprobes++;
}
/* if here, then have empty slot and need to insert */
e->col = col; e->row = row; m_hashcount[tid]++;
e->value = value;
}
/***********************************************************************
*
* function: m_calc_quant_hess()
*
* purpose: calculate hessians of quantities
* Called by calc_quant_hess() per processor
*
*/
void m_calc_quant_hess(type,mode,rhs)
int type; /* element type */
int mode; /* ENERGY, FIXED, or INFO_ONLY */
REAL *rhs;
{ int i,n,j,m,nn;
struct element *e_ptr;
struct gen_quant *q;
int flag; /* 0 if doing global quantities, 1 for local */
struct gen_quant_method *gm;
struct method_instance *mi;
int inum;
struct qinfo q_info; /* data passing structure */
int meth_offset = get_meth_offset(type);
int me = GET_THREAD_ID;
int start,end,bin;
REAL **p1,**p2;
REAL coeff,ccoeff=0.0;
struct hess_verlist *va,*vb;
REAL g[MAXCOORD],*ggg;
int global_needs;
#ifdef SIGUSR1
signal(SIGUSR1,catcher); /* to catch user interrupt */
#endif
signal(SIGINT,catcher); /* to catch user interrupt */
m_breakflag[me] = 0;
if ( setjmp(m_jumpbuf[me]) ) { q_info_free(&q_info); return; }
/* set up matrices in qinfo with lots of room */
q_info_init(&q_info,METHOD_HESSIAN);
q_info.hess = dmatrix4(MAXVCOUNT,MAXVCOUNT,SDIM,SDIM);
p1 = dmatrix(0,MAXCOORD-1,0,MAXCOORD-1);
p2 = dmatrix(0,MAXCOORD-1,0,MAXCOORD-1);
/* initialize local list */
m_hess_hash_init();
global_needs = global_meth_needs(type);
bin = (web.skel[type].count + nprocs - 1)/nprocs;
start = me*bin;
end = start + bin;
if ( end > web.skel[type].count ) end = web.skel[type].count;
for ( nn = start ; nn < end ; nn++ )
{ int k;
int setup_flag = 0;
int needs;
q_info.id = el_list[type][nn];
e_ptr = elptr(q_info.id);
/* get setup flags */
needs = global_needs;
for ( k = 0 ; k < e_ptr->method_count ; k++ )
{ int mm;
mm = ((int*)((char*)e_ptr+meth_offset))[k];
mi = METH_INSTANCE(abs(mm));
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
needs |= basic_gen_methods[mi->gen_method].flags;
}
inum = global_meth_inst_count[type];
for ( flag = 0 ; flag < 2 ; flag++,inum = e_ptr->method_count,k=0 )
for ( k = 0 ; k < inum ; k++ )
{ int mm,ii,jj;
int sign = 1;
REAL value;
if ( flag )
{ mm = ((int*)((char*)e_ptr+meth_offset))[k];
q_info.method = abs(mm);
if ( mm < 0 ) sign = -1;
}
else q_info.method = global_meth_inst[type][k];
mi = METH_INSTANCE(q_info.method);
if ( (mi->flags & Q_DOTHIS) && (mi->type == type) )
{ q = GEN_QUANT(mi->quant);
coeff = sign*q->modulus*mi->modulus;
if ( !setup_flag )
{ (*q_setup[type])(NULL,&q_info,needs); setup_flag = 1; }
if ( q->flags & (Q_FIXED|Q_CONSERVED) )
{ ccoeff = coeff; coeff *= -q->pressure; }
mi = METH_INSTANCE(q_info.method);
gm = basic_gen_methods + mi->gen_method;
zerohess(&q_info);
if ( m_hess_mode ) value = (*gm->hessian)(&q_info);
else value = (*gm->gradient)(&q_info);
if ( mi->flags & ELEMENT_MODULUS_FLAG )
{ REAL emdls = *(REAL*)get_extra(q_info.id,mi->elmodulus);
value *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
q_info.grad[i][j] *= emdls;
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( ii = 0 ; ii < q_info.vcount ; ii++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
q_info.hess[i][ii][j][jj] *= emdls;
}
mi->newvalue += sign*value;
mi->abstotal += fabs(value);
/* unwrap */
if ( sym_flags & NEED_FORM_UNWRAPPING )
{ /* gradient */
int ii,jj;
REAL grad[MAXCOORD];
for ( i = 0 ; i < q_info.vcount ; i++ )
{
if ( q_info.wraps[i] )
{ (*sym_form_pullback)(q_info.x[i],grad,q_info.grad[i],
q_info.wraps[i]);
for ( j = 0 ; j < SDIM ; j++ ) q_info.grad[i][j] = grad[j];
}
}
if ( m_hess_mode )
for ( i = 0 ; i < q_info.vcount ; i++ )
for ( ii = 0 ; ii < q_info.vcount ; ii++ )
{ if ( q_info.wraps[i] )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ REAL tmp[MAXCOORD];
for ( j = 0 ; j < SDIM ; j++ )
tmp[j]=q_info.hess[i][ii][j][jj];
(*sym_form_pullback)(q_info.x[i],grad,tmp,q_info.wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
q_info.hess[i][ii][j][jj] = grad[j];
}
if ( q_info.wraps[ii] )
for ( j = 0 ; j < SDIM ; j++ )
{
(*sym_form_pullback)(q_info.x[ii],grad,q_info.hess[i][ii][j],
q_info.wraps[ii]);
for ( jj = 0 ; jj < SDIM ; jj++ )
q_info.hess[i][ii][j][jj] = grad[jj];
}
}
}
for ( i = 0 ; i < q_info.vcount ; i++ )
{ REAL grad[MAXCOORD];
va = get_vertex_vhead(q_info.v[i]);
for ( j = 0 ; j < SDIM ; j++ )
grad[j] = coeff*q_info.grad[i][j];
m_fill_grad(va,grad,me,rhs);
}
/* second derivatives */
if ( m_hess_mode )
for ( i = 0 ; i < q_info.vcount ; i++ )
{ va = get_vertex_vhead(q_info.v[i]);
if ( va->freedom == 0 ) continue;
for ( j = i ; j < q_info.vcount ; j++ )
{ vb = get_vertex_vhead(q_info.v[j]);
if ( vb->freedom == 0 ) continue;
for ( n = 0 ; n < SDIM ; n++ )
for ( m = 0 ; m < SDIM ; m++ )
q_info.hess[i][j][m][n] *= coeff;
m_fill_mixed_entry(q_info.v[i],q_info.v[j],
q_info.hess[i][j],me);
if ( (i != j) && (q_info.v[i] == q_info.v[j]) )
m_fill_mixed_entry(q_info.v[i],q_info.v[j],
q_info.hess[i][j],me);
} /* end inner vertex loop */
/* fixed quantity gradients for left side */
if ( q->flags & (Q_FIXED|Q_CONSERVED) )
{ /* find entry */
int currentrow;
if ( va->proj )
{ vec_mat_mul(q_info.grad[i],va->proj,g,SDIM,
va->freedom);
ggg = g;
}
else ggg = q_info.grad[i];
currentrow = m_quanrowstart + mi->quant;
for ( m = 0 ; m < va->freedom ; m++ )
{
m_hess_hash_search(currentrow,va->rownum+m,
ccoeff*ggg[m],me);
}
}
} /* end second derivatives */
} /* end if */
} /* end method instance loop */
} /* end all element loop */
/* free stuff */
free_matrix4(q_info.hess);
free_matrix(p1);
free_matrix(p2);
q_info_free(&q_info);
}
/*************************************************************************
*
* function: m_fill_grad()
*
* purpose: Process gradient of function at constraint
* Just stores in local list for future processing.
*/
void m_fill_grad(v,grad,tid,rhs)
struct hess_verlist *v;
REAL *grad;
REAL *rhs;
int tid; /* thread id */
{ REAL g[MAXCOORD];
int k,a,b;
if ( rhs_flag )
{ M_LOCK(rhs);
if ( v->proj )
{ vec_mat_mul(grad,v->proj,g,SDIM,v->freedom);
for ( k = 0 ; k < v->freedom ; k++ )
rhs[v->rownum+k] -= g[k];
}
else
for ( k = 0 ; k < v->freedom ; k++ )
rhs[v->rownum+k] -= grad[k];
M_UNLOCK(rhs);
}
if ( hess_flag && v->conhess )
{
for ( a = 0 ; a < v->freedom ; a++ )
for ( b = 0 ; b <= a ; b++ )
{
m_hess_hash_search(v->rownum+a,v->rownum+b,
SDIM_dot(grad,v->conhess[a][b]),tid);
}
}
}
/*************************************************************************
*
* function: m_fill_mixed_entry()
*
* purpose: fill proper hessian matrix spot for mixed vertex second derivs
* For multi-proc, just stores in local list.
*/
void m_fill_mixed_entry(v_id1,v_id2,mixed,tid)
vertex_id v_id1,v_id2;
REAL **mixed; /* full dim values */
int tid; /* thread id */
{ int k,j;
REAL **oo;
MAT2D(temp_mat,MAXCOORD,MAXCOORD);
MAT2D(temp_mat2,MAXCOORD,MAXCOORD);
struct hess_verlist *v1,*v2;
v1 = get_vertex_vhead(v_id1);
v2 = get_vertex_vhead(v_id2);
if ( v1->proj )
{ tr_mat_mul(v1->proj,mixed,temp_mat,SDIM,v1->freedom,SDIM);
oo = temp_mat;
}
else oo = mixed;
if ( v2->proj )
{ mat_mult(oo,v2->proj,temp_mat2,v1->freedom,SDIM,v2->freedom);
oo = temp_mat2;
}
if ( v1->rownum < v2->rownum )
for ( j = 0 ; j < v1->freedom ; j++ )
for ( k = 0 ; k < v2->freedom ; k++ )
m_hess_hash_search(v2->rownum+k,v1->rownum+j,oo[j][k],tid);
else
for ( j = 0 ; j < v1->freedom ; j++ )
for ( k = 0 ; k < v2->freedom ; k++ )
m_hess_hash_search(v1->rownum+j,v2->rownum+k,oo[j][k],tid);
}
/*******************************************************************
*
* function: m_fix_hess()
*
* purpose: stores local lists into regular hessian list.
* THis version still serial!!
*/
void m_fix_hess(S)
struct linsys *S;
{ int p,i;
for ( p = 0 ; p < nprocs ; p++ )
{ struct hess_entry *e;
int end = m_table_size[p];
for ( i = 0, e = m_hashtable[p] ; i < end ; i++,e++ )
if ( e->row != HASHEMPTY )
sp_hash_search(S,e->row,e->col,e->value);
myfree((char*)(m_hashtable[p])); m_hashtable[p] = NULL;
m_hash_per_row[p] = 1 + (5*m_hashcount[p])/(4*SDIM*web.skel[VERTEX].max_ord);
/* for next time */
if ( !hessian_quiet_flag )
{ sprintf(msg,"m_hashcount[%d]: %d m_table_size[%d]: %d\n",
p,m_hashcount[p],p,m_table_size[p]);
outstring(msg);
}
}
if ( !hessian_quiet_flag )
{ sprintf(msg,"m_hash_extraprobes: %d\n",m_hash_extraprobes);
outstring(msg);
}
}
#endif
/*******************************************************************
*
* function: q_vertex_setup()
*
* purpose: calculate vertex attributes needed for quantities.
*/
void q_vertex_setup(S,v_info,needs)
struct linsys *S;
struct qinfo *v_info;
int needs; /* particular setup needs for current mode */
{ /* struct vertex *v_ptr = (struct vertex *)elptr(v_info->id); */
int i,j;
vertex_id q_id;
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
v_info->S = S;
q_id = v_info->id;
v_info->vcount = 1;
v_info->v[0] = v_info->id;
v_info->x[0] = get_coord(v_info->v[0]);
if ( needs & NEED_WINGS ) /* pair of adjacent vertices */
{ facetedge_id right_fe;
edge_id e_id[3];
right_fe = get_vertex_fe(v_info->id);
if ( !valid_id(right_fe) ) goto vset_exit;
v_info->vcount++;
v_info->v[1] = get_fe_headv(right_fe);
e_id[1] = get_fe_edge(right_fe);
e_id[2] = get_next_tail_edge(e_id[1]);
/* get incoming first, outgoing second, if possible */
if ( positive_id(e_id[1]) && !positive_id(e_id[2]) )
{ edge_id etmp = e_id[1];
e_id[1] = e_id[2];
e_id[2] = etmp;
}
if ( !equal_id(e_id[1],e_id[2]) )
{ v_info->vcount++;
v_info->v[2] = get_edge_headv(e_id[2]);
}
for ( i = 1 ; i < v_info->vcount ; i++ )
{
v_info->x[i] = get_coord(v_info->v[i]);
if ( web.symmetry_flag )
{ (*sym_wrap)(v_info->x[i],v_info->xx[i],get_edge_wrap(e_id[i]));
v_info->x[i] = v_info->xx[i];
}
for ( j = 0 ; j < SDIM ; j++ )
v_info->sides[0][i-1][j] = v_info->x[i][j] - v_info->x[0][j];
}
}
if ( needs & NEED_MARKED_WINGS )
{ /* pair of marked edge vertices
for sqcurve_string_marked */
edge_id thise,starte;
edge_id e_id[3];
starte = get_vertex_edge(v_info->id);
i = 1;
thise = starte;
do
{
if ( !valid_id(thise) ) goto vset_exit;
if ( (marked_edge_attr>0) && *EINT(thise,marked_edge_attr) )
{
e_id[i] = thise;
v_info->vcount++;
v_info->v[i] = get_edge_headv(e_id[i]);
i++;
if ( i >= 3 ) break;
}
thise = get_next_tail_edge(thise);
} while ( !equal_id(thise,starte) );
for ( i = 1 ; i < v_info->vcount ; i++ )
{
v_info->x[i] = get_coord(v_info->v[i]);
if ( web.symmetry_flag )
{ (*sym_wrap)(v_info->x[i],v_info->xx[i],get_edge_wrap(e_id[i]));
v_info->x[i] = v_info->xx[i];
}
for ( j = 0 ; j < SDIM ; j++ )
v_info->sides[0][i-1][j] = v_info->x[i][j] - v_info->x[0][j];
}
}
if ( needs & (NEED_FULL_STAR|NEED_PART_STAR) ) /* ring of facets */
{ facetedge_id fe,startfe,next_fe;
edge_id e_id;
int k=0;
if ( get_vattr(q_id) & BARE_NAKED ) goto nostar;
fe = get_vertex_fe(q_id);
if ( !valid_id(fe) ) goto nostar;
if ( inverted(get_fe_facet(fe)) )
fe = inverse_id(get_prev_edge(fe));
startfe = fe;
if ( get_vattr(q_id) & AXIAL_POINT )
{ /* want to walk around outside ring */
facetedge_id fa,next_fe;
WRAPTYPE wrap = get_fe_wrap(fe);
WRAPTYPE wrap0 = wrap;
REAL *y;
v_info->axial_order = 0;
next_fe = fa = get_next_edge(fe);
do
{ v_info->v[k+1] = get_fe_tailv(next_fe);
v_info->wraps[k+1] = wrap;
y = get_coord(v_info->v[k+1]);
(*sym_wrap)(y,v_info->sides[0][k],wrap);
for ( j = 0 ; j < SDIM ; j++ )
v_info->sides[0][k][j] -= v_info->x[0][j];
v_info->vcount++;
k++;
if ( k >= MAXVCOUNT-1 )
{ sprintf(errmsg,
"quantity_setup: More than %d vertices around vertex %s.\n",
MAXVCOUNT-1, ELNAME(v_info->id));
kb_error(1337,errmsg,RECOVERABLE);
}
wrap = (*sym_compose)(wrap,get_fe_wrap(next_fe));
next_fe = get_next_edge(next_fe);
next_fe = inverse_id(get_next_facet(next_fe));
next_fe = get_next_edge(next_fe);
if ( next_fe == fa ) v_info->axial_order++;
} while ( (next_fe != fa) || (*sym_compose)((*sym_inverse)(wrap),wrap0));
v_info->flags &= ~INCOMPLETE_STAR;
}
else
{ /* normal vertex star */
/* first, see if we have partial star, and if so, start at one end */
fe = startfe;
v_info->flags &= ~INCOMPLETE_STAR;
do
{ next_fe = get_next_facet(fe);
if ( equal_id(next_fe,fe) )
{ /* have end of star */
startfe = fe;
v_info->flags |= INCOMPLETE_STAR;
if ( needs & NEED_FULL_STAR )
{ sprintf(errmsg,"Vertex %s does not have a complete star (as needed by some method instance).\n",ELNAME(v_info->id));
kb_error(1573,errmsg,RECOVERABLE);
}
break;
}
fe = inverse_id(get_prev_edge(next_fe));
}
while ( !equal_id(fe,startfe) );
/* now do the actual work */
do
{
e_id = get_fe_edge(fe);
v_info->v[k+1] = get_edge_headv(e_id);
if(web.symmetry_flag) v_info->wraps[k+1] = get_edge_wrap(e_id);
get_edge_side(e_id,v_info->sides[0][k]);
v_info->vcount++;
k++;
if ( k >= MAXVCOUNT-1 )
{ sprintf(errmsg,
"quantity_setup: More than %d vertices around vertex %s.\n",
MAXVCOUNT-1, ELNAME(v_info->id));
kb_error(1572,errmsg,RECOVERABLE);
}
if ( !equal_id(fe,startfe) && equal_id(fe,get_next_facet(fe)) )
break; /* found end of partial star */
fe = get_prev_edge(fe);
next_fe = get_next_facet(fe);
fe = inverse_id(next_fe);
} while ( !equal_id(fe,startfe) );
}
nostar: ;
}
vset_exit: ;
}
/*******************************************************************
*
* function: q_edge_setup()
*
* purpose: calculate edge attributes needed for quantities.
*/
void q_edge_setup(S,e_info,needs)
struct linsys *S;
struct qinfo *e_info;
int needs; /* particular setup needs for current mode */
{ int i,j;
if ( web.modeltype == QUADRATIC )
{ q_edge_setup_q(e_info,needs); return; }
if ( web.modeltype == LAGRANGE )
{ q_edge_setup_lagrange(e_info,needs); return; }
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
e_info->S = S;
e_info->vcount = (web.representation == SIMPLEX) ? web.dimension : 2;
e_info->v[0] = get_edge_tailv(e_info->id);
e_info->v[1] = get_edge_headv(e_info->id);
e_info->x[0] = get_coord(e_info->v[0]);
e_info->x[1] = get_coord(e_info->v[1]);
if ( web.symmetry_flag )
{ WRAPTYPE wrap = get_edge_wrap(e_info->id);
(*sym_wrap)(e_info->x[1],e_info->xx[1],wrap);
e_info->x[1] = e_info->xx[1];
e_info->wraps[1] = wrap;
}
if ( needs & NEED_SIDE )
for ( i = 0 ; i < SDIM ; i++ )
e_info->sides[0][0][i] = e_info->x[1][i] - e_info->x[0][i];
if ( needs & NEED_WINGS )
{ facetedge_id fe,left_fe,right_fe;
e_info->vcount = 4; /* need wing vertices, also */
fe = get_edge_fe(e_info->id);
left_fe = inverse_id(get_prev_edge(fe));
right_fe = inverse_id(get_prev_edge(get_next_facet(fe)));
e_info->v[2] = get_fe_headv(left_fe);
e_info->v[3] = get_fe_headv(right_fe);
if ( web.symmetry_flag )
{ e_info->wraps[2] = get_edge_wrap(get_fe_edge(left_fe));
e_info->wraps[3] = get_edge_wrap(get_fe_edge(right_fe));
}
for ( i = 2 ; i <= 3 ; i++ )
{
e_info->x[i] = get_coord(e_info->v[i]);
if ( web.symmetry_flag )
{ (*sym_wrap)(e_info->x[i],e_info->xx[i],e_info->wraps[i]);
e_info->x[i] = e_info->xx[i];
}
for ( j = 0 ; j < SDIM ; j++ )
e_info->sides[0][i-1][j] = e_info->x[i][j] - e_info->x[0][j];
}
}
if ( needs & NEED_STRING_STAR )
{ edge_id e_id1,e_id2 = e_info->id,e_id3;
/* careful of weird packaging */
e_info->vcount = 4; /* need vertices of adjacent edges also */
e_id1 = inverse_id(get_next_tail_edge(e_id2));
e_id3 = inverse_id(get_next_head_edge(e_id2));
/* have to leave first two vertices in place for other methods */
e_info->v[2] = get_edge_tailv(e_id1);
e_info->v[3] = get_edge_headv(e_id3);
for ( j = 0 ; j < 4 ; j++ ) e_info->x[j] = get_coord(e_info->v[j]);
for ( j = 0 ; j < SDIM ; j++ )
{
e_info->sides[0][0][j] = e_info->x[1][j] - e_info->x[0][j];
e_info->sides[0][1][j] = e_info->x[0][j] - e_info->x[2][j];
e_info->sides[0][2][j] = e_info->x[3][j] - e_info->x[1][j];
}
}
if ( needs & NEED_GAUSS )
{ int m;
for ( m = 0 ; m < gauss1D_num ; m++ )
for ( i = 0 ; i < SDIM ; i++ )
e_info->gauss_pt[m][i] = gauss1poly[0][m]*e_info->x[0][i]
+ gauss1poly[1][m]*e_info->x[1][i];
}
}
/*******************************************************************
*
* function: q_edge_setup_q()
*
* purpose: calculate edge attributes needed for quantities.
* For quadratic model.
*/
void q_edge_setup_q(e_info,needs)
struct qinfo *e_info;
int needs; /* particular setup needs for current mode */
{ int i,j;
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
e_info->vcount = (web.representation == SIMPLEX) ? web.dimension : 3;
e_info->v[0] = get_edge_tailv(e_info->id);
e_info->v[1] = get_edge_midv(e_info->id);
e_info->v[2] = get_edge_headv(e_info->id);
e_info->x[0] = get_coord(e_info->v[0]);
e_info->x[1] = get_coord(e_info->v[1]);
e_info->x[2] = get_coord(e_info->v[2]);
if ( web.symmetry_flag )
{ WRAPTYPE wrap = get_edge_wrap(e_info->id);
(*sym_wrap)(e_info->x[2],e_info->xx[2],wrap);
e_info->x[2] = e_info->xx[2];
e_info->wraps[2] = wrap;
}
if ( needs & NEED_SIDE )
{ /* tangent vectors at gauss points */
int m;
REAL t;
for ( m = 0 ; m < gauss1D_num ; m++ )
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0, t = 0.0 ; j < edge_ctrl ; j++ )
t += gauss1polyd[j][m]*e_info->x[j][i];
e_info->sides[m][0][i] = t;
}
}
if ( needs & NEED_WINGS )
{ kb_error(1575,"Can't do quadratic model with edge WINGS (needed for some method instance).\n",RECOVERABLE);
}
if ( needs & NEED_GAUSS )
{ int m;
REAL t;
for ( m = 0 ; m < gauss1D_num ; m++ )
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0, t = 0.0 ; j < edge_ctrl ; j++ )
t += gauss1poly[j][m]*e_info->x[j][i];
e_info->gauss_pt[m][i] = t;
}
}
}
/*******************************************************************
*
* function: q_edge_setup_lagrange()
*
* purpose: calculate edge attributes needed for quantities.
* For Lagrange model.
*/
void q_edge_setup_lagrange(e_info,needs)
struct qinfo *e_info;
int needs; /* particular setup needs for current mode */
{ int i;
int ctrl = web.skel[EDGE].ctrlpts;
int dim = (web.representation==STRING) ? 1 : web.dimension - 1 ;
struct gauss_lag *gl = &gauss_lagrange[dim][web.gauss1D_order];
vertex_id *v;
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
e_info->vcount = ctrl;
v = get_edge_vertices(e_info->id);
if ( inverted(e_info->id) )
for ( i = 0 ; i < ctrl ; i++ )
{ e_info->v[i] = v[ctrl-i-1];
e_info->x[i] = get_coord(v[ctrl-i-1]);
}
else
for ( i = 0 ; i < ctrl ; i++ )
{ e_info->v[i] = v[i];
e_info->x[i] = get_coord(v[i]);
}
if ( web.symmetry_flag )
{ WRAPTYPE wrap = get_edge_wrap(e_info->id);
(*sym_wrap)(e_info->x[ctrl-1],e_info->xx[ctrl-1],wrap);
e_info->x[ctrl-1] = e_info->xx[ctrl-1];
e_info->wraps[ctrl-1] = wrap;
}
if ( needs & NEED_SIDE )
{ /* tangent vectors at gauss points */
int m;
for ( m = 0 ; m < gl->gnumpts ; m++ )
mat_mult(gl->gpolypart[m],e_info->x,e_info->sides[m],dim,ctrl,SDIM);
}
if ( needs & NEED_WINGS )
{ kb_error(1576,
"Can't do Lagrange model with WINGS (needed for some method instance).\n",
RECOVERABLE);
}
if ( needs & NEED_GAUSS )
mat_mult(gl->gpoly,e_info->x,e_info->gauss_pt,gl->gnumpts,ctrl,SDIM);
}
/*******************************************************************
*
* function: q_facet_setup()
*
* purpose: calculate facet attributes needed for quantities.
*/
void q_facet_setup(S,f_info,needs)
struct linsys *S;
struct qinfo *f_info;
int needs; /* particular setup needs for current mode */
{ facetedge_id fe_id;
int i,j;
f_info->S = S;
if ( web.modeltype == QUADRATIC )
{ q_facet_setup_q (f_info,needs); return; }
if ( web.modeltype == LAGRANGE )
{ q_facet_setup_lagrange(f_info,needs); return;}
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
f_info->vcount = web.dimension+1;
if ( web.representation == SIMPLEX )
{ vertex_id *vv = get_facet_vertices(f_info->id);
for ( i = 0 ; i <= web.dimension ; i++ )
{ f_info->v[i] = vv[i];
f_info->x[i] = f_info->xx[i];
}
}
else
{
fe_id = get_facet_fe(f_info->id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
f_info->v[i] = get_fe_tailv(fe_id);
f_info->x[i] = f_info->xx[i];
fe_id = get_next_edge(fe_id);
}
}
get_facet_verts(f_info->id,f_info->x,f_info->wraps); /* in tail order */
/* fan of sides from v0 */
if ( needs & NEED_SIDE )
{ for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->sides[0][i][j] = f_info->x[i+1][j] - f_info->x[0][j];
}
if ( needs & NEED_NORMAL )
{ cross_prod(f_info->sides[0][0],f_info->sides[0][1],f_info->normal);
}
if ( needs & NEED_GAUSS )
mat_mult(gpoly,f_info->x,f_info->gauss_pt,gauss2D_num,ctrl_num,SDIM);
}
/*******************************************************************
*
* function: q_facet_setup_q()
*
* purpose: calculate facet attributes needed for quantities.
* Quadratic model.
*/
void q_facet_setup_q(f_info,needs)
struct qinfo *f_info;
int needs; /* particular setup needs for current mode */
{ facetedge_id fe_id;
int i,m;
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
f_info->vcount = 6;
fe_id = get_facet_fe(f_info->id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
f_info->v[2*i] = get_fe_tailv(fe_id);
f_info->x[2*i] = f_info->xx[2*i];
f_info->v[2*i+1] = get_fe_midv(fe_id);
f_info->x[2*i+1] = f_info->xx[2*i+1];
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_info->id,f_info->x,f_info->wraps); /* in tail order */
/* tangents at gauss points */
for ( m = 0 ; m < gauss2D_num ; m++ )
mat_mult(gpolypartial[m],f_info->x,f_info->sides[m],
web.dimension,FACET_CTRL,SDIM);
/* if ( needs & NEED_NORMAL ) */
if ( needs & NEED_GAUSS )
mat_mult(gpoly,f_info->x,f_info->gauss_pt,gauss2D_num,FACET_CTRL,SDIM);
}
/*******************************************************************
*
* function: q_facet_setup_lagrange()
*
* purpose: calculate facetedge attributes needed for quantities.
* For Lagrange model.
*/
void q_facet_setup_lagrange(f_info,needs)
struct qinfo *f_info;
int needs; /* particular setup needs for current mode */
{ int i,j;
int ctrl = web.skel[FACET].ctrlpts;
int dim = web.dimension;
struct gauss_lag *gl = &gauss_lagrange[dim][web.gauss2D_order];
vertex_id *v;
/* W A R N I N G */
/* Be sure to place all data consistently for all methods !!! */
f_info->vcount = ctrl;
v = get_facet_vertices(f_info->id);
if ( inverted(f_info->id) ) /* invert orientation of vertices */
for ( j = 0 ; j <= web.lagrange_order ; j++ )
for ( i = 0 ; i+j <= web.lagrange_order ; i++ )
{ f_info->v[j*(web.lagrange_order+1)-j*(j-1)/2+i] =
v[i*(web.lagrange_order+1)-i*(i-1)/2+j];
f_info->x[j*(web.lagrange_order+1)-j*(j-1)/2+i] =
f_info->xx[i*(web.lagrange_order+1)-i*(i-1)/2+j];
}
else
for ( i = 0 ; i < ctrl ; i++ )
{ f_info->v[i] = v[i];
f_info->x[i] = f_info->xx[i];
}
get_facet_verts(f_info->id,f_info->x,f_info->wraps);
if ( needs & NEED_SIDE )
{ /* tangent vectors at gauss points */
int m;
for ( m = 0 ; m < gl->gnumpts ; m++ )
mat_mult(gl->gpolypart[m],f_info->x,f_info->sides[m],dim,ctrl,SDIM);
}
/* always need gauss */
mat_mult(gl->gpoly,f_info->x,f_info->gauss_pt,gl->gnumpts,ctrl,SDIM);
}
/*******************************************************************
*
* function: q_body_setup()
*
* purpose: calculate body attributes needed for quantities.
*/
void q_body_setup(S,b_info,needs)
struct linsys *S;
struct qinfo *b_info;
int needs; /* particular setup needs for current mode */
{
}
/*******************************************************************
*
* function: q_facetedge_setup()
*
* purpose: calculate facetedge attributes needed for quantities.
*/
void q_facetedge_setup(S,fe_info,needs)
struct linsys *S;
struct qinfo *fe_info;
int needs; /* particular setup needs for current mode */
{
}
/*****************************************************************8
*
* functions: null_q_value(), null_q_grad(), null_q_hess()
*
* purpose: traps for undefined quantity methods.
*/
REAL null_q_value(q_info)
struct qinfo *q_info;
{ sprintf(errmsg,"Method value function not implemented for %s.\n",
basic_gen_methods[METH_INSTANCE(q_info->method)->gen_method].name);
kb_error(1577,errmsg,RECOVERABLE);
return 0.0;
}
REAL null_q_grad(q_info)
struct qinfo *q_info;
{ sprintf(errmsg,"Method gradient function not implemented for %s.\n",
basic_gen_methods[METH_INSTANCE(q_info->method)->gen_method].name);
kb_error(1578,errmsg,RECOVERABLE);
return 0.0;
}
REAL null_q_hess(q_info)
struct qinfo *q_info;
{ sprintf(errmsg,"Quantity hessian function not implemented for %s.\n",
basic_gen_methods[METH_INSTANCE(q_info->method)->gen_method].name);
kb_error(1579,errmsg,RECOVERABLE);
return 0.0;
}
/* handy for zeroing out gradient and hessian */
void zerohess(q_info)
struct qinfo *q_info;
{ int m,i,j,k;
for ( m = 0 ; m < q_info->vcount ; m++ )
for ( j = 0 ; j < SDIM ; j++ )
q_info->grad[m][j] = 0.0;
for ( m = 0 ; m < q_info->vcount ; m++ )
for ( i = 0 ; i < q_info->vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
q_info->hess[m][i][j][k] = 0.0;
}
/*********************************************************************
Phase space evolution - film with inertia.
Coordinates represent position and velocity.
Requested by Jeremy Ackerman
**********************************************************************/
/***********************************************************************
*
* function: ackerman_init()
*
* purpose: initial checks for inertial motion
*/
void ackerman_init(mode,mi)
int mode;
struct method_instance *mi;
{ int sdim2=2*SDIM;
if ( 2*SDIM > MAXCOORD )
kb_error(1580,"ackerman method: Dimension too high for phase space motion.\n",RECOVERABLE);
expand_attribute(VERTEX,V_COORD_ATTR,&sdim2);
expand_attribute(VERTEX,V_OLDCOORD_ATTR,&sdim2);
expand_attribute(VERTEX,V_FORCE_ATTR,&sdim2);
expand_attribute(VERTEX,V_VELOCITY_ATTR,&sdim2);
ackerman_flag = 1;
}
/***********************************************************************
*
* function: ackerman_energy()
*
* purpose: dummy energy
*/
REAL ackerman_energy(v_info)
struct qinfo *v_info;
{ return 0.0;
}
/***********************************************************************
*
* function: ackerman_forces()
*
* purpose: forces in phase space
*/
REAL ackerman_forces(v_info)
struct qinfo *v_info;
{ REAL *f = get_force(v_info->id);
REAL *x = get_coord(v_info->id);
/* REAL star = get_vertex_star(v_info->id); */
int i;
/* modify first order forces to second order */
for ( i = 0 ; i < SDIM ; i++ )
{
f[i+SDIM] = f[i];
f[i] = 0.0;
v_info->grad[0][i] = -x[i+SDIM];
}
return 0.0;
}
/************************************************************************
*
* function: add_vgrads_to_update()
*
* purpose: add method gradients to low rank update part of hessian.
*/
void add_vgrads_to_update(S)
struct linsys *S;
{ vertex_id v_id;
FOR_ALL_VERTICES(v_id)
{ struct hess_verlist *v1 = get_vertex_vhead(v_id);
struct volgrad *vgptr = get_vertex_vgrad(v_id);
for ( ; vgptr ; vgptr = vgptr->chain )
{ struct method_instance *mi;
int j;
if ( !(vgptr->qnum & METHBASE ) ) continue;
mi = METH_INSTANCE(vgptr->qnum - METHBASE);
if ( v1->proj )
{ REAL tempvec[MAXCOORD];
vec_mat_mul(vgptr->grad,v1->proj,tempvec,SDIM,v1->freedom);
for ( j = 0 ; j < v1->freedom ; j++ )
S->low_rank_vectors[mi->global_low_rank][v1->rownum+j]
+= tempvec[j];
}
else
{ for ( j = 0 ; j < SDIM ; j++ )
S->low_rank_vectors[mi->global_low_rank][v1->rownum+j]
+= vgptr->grad[j];
}
}
}
}
evolver-2.30c.dfsg/src/utility.c 0000644 0001753 0001753 00000356332 11410765113 017100 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: utility.c
*
* Purpose: Various utility routines.
*/
#include "include.h"
/**************************************************************
*
* Function: catcher()
*
* Purpose: User interrupt catcher. Sets breakflag so
* anybody in a long loop can test to see if
* user wants to break out.
*/
#ifdef WIN32
#define write(a,b,c) erroutstring(b)
#endif
void catcher(sig)
int sig;
{
#ifdef SIGALRM
if ( sig == SIGALRM )
signal(SIGALRM,catcher);
#endif
if ( sig == SIGINT )
{ signal(SIGINT,catcher);
#ifdef SGI_MULTI
if ( mpflag == M_ACTIVE )
{ if ( m_breakflag[GET_THREAD_ID] )
longjmp(m_jumpbuf[GET_THREAD_ID],1);
else m_breakflag[GET_THREAD_ID] = BREAKFULL;
if ( GET_THREAD_ID == 0 )
write(2,"\nWill break after iteration.\n",29);
breakflag = BREAKFULL;
iterate_flag = 0;
}
else
if ( GET_THREAD_ID > 0 ) {}
else
#endif
if ( iterate_flag == 1 )
{ write(2,"\nWill break after iteration.\n",29);
breakflag = BREAKFULL;
iterate_flag = 0;
}
else if ( iterate_flag == 2 ) /* graphing or something */
{ write(2,"\nWill abort operation.\n",24);
breakflag = BREAKFULL;
iterate_flag = 0;
}
else
{ write(2,"\nAborting operation.\n",22);
if ( TRY_GRAPH_MUTEX(IMMEDIATE_TIMEOUT) )
ABORT_GRAPH_MUTEX
else
erroutstring("In GRAPH_MUTEX. May be deadlocked with graphics thread.\n");
#ifdef WIN32
/* separate thread for signal handler, so can't longjmp out of error */
erroutstring("Can't nicely abort command in WIN32. Hang in there, or\n");
erroutstring("use Task Manager to kill Evolver if you think it's hung.\n");
#elif defined(MAC_OS_X)
if ( iterate_flag > 2 )
erroutstring("Haven't figured out how to handle this yet.\n");
#else
kb_error(1357,"",RECOVERABLE_QUIET);
#endif
}
while ( commandfd && (commandfd != stdin) )
pop_commandfd();
quiet_flag = 0;
}
#ifdef SIGTERM
if ( sig == SIGTERM ) /* for outside kill and dump */
{ sprintf(errmsg,"Caught SIGTERM. proc %d ",getpid());
erroutstring(errmsg);
do_dump(NULL); /* dump to default */
my_exit(1);
}
#endif
#ifdef SIGHUP
if ( sig == SIGHUP ) /* for outside kill and dump */
{
do_dump(NULL); /* dump to default */
my_exit(1);
}
#endif
#ifdef SIGPIPE
else if ( sig == SIGPIPE )
{ signal(SIGPIPE,catcher);
write(2,"Broken pipe signal.\n",20);
broken_pipe_flag = 1;
}
#endif
}
/***********************************************************************
************************************************************************
Memory allocation routines
************************************************************************/
/* Header structure for each block */
struct memhead { struct memhead *prev, *next; /* doubly linked list */
size_t size;
int type; /* see below */
#ifdef MEMSTRINGS
char file[28];
int line;
#endif
};
/* Memory block list heads */
struct memhead *perm_block_head;
struct memhead *temp_block_head;
struct memhead *graph_block_head;
struct memhead *eternal_block_head;
/***********************************************************************
*
* function: kb_checksum()
*
* purpose: to calculate a simple checksum on a block of memory.
*/
int kb_checksum(mem,size)
char *mem;
int size;
{
int sum = 0;
int *a,*b;
b = (int *)mem;
a = b + size/sizeof(int);
do { sum += *a; } while ( --a != b);
return sum;
}
/********************************************************************
*********************************************************************
Memory allocation routines. These put my own
headers on memory blocks, and keep linked lists
for easy garbage collection. To start with, there
are surface-permanent and command-temporary lists,
but there could be more, for example of info that
needs to be distributed on a network implementation,
instead of the present dymem.
********************************************************************/
void mem_sanity_check ARGS((void));
/********************************************************************
*
* function: mem_sanity_check()
*
* purpose: Checks all lists.
*/
void mem_sanity_check()
{ struct memhead *head;
int blocktype;
THREADBLOCK(blocktype);
#if defined(_WIN32) && defined(_HEAPOK)
#ifndef _HEAPINFO
#define _HEAPINFO _heapinfo
#endif
if ( _heapchk() != _HEAPOK )
kb_error(2580,"Internal error: Corrupt heap! Memory is trashed.\n",RECOVERABLE);
#endif
for ( head = eternal_block_head; head ; head = head->next )
{ if ( head->type != ETERNAL_BLOCK )
kb_error(2581,"Bad eternal memory block chain!\n",RECOVERABLE);
}
for ( head = perm_block_head ; head ; head = head->next )
{ if ( head->type != PERM_BLOCK )
kb_error(2460,"Bad permanent memory block chain!\n",RECOVERABLE);
}
if ( blocktype == TEMP_BLOCK )
for ( head = temp_block_head ; head ; head = head->next )
{ if ( head->type != TEMP_BLOCK )
kb_error(3208,"Bad temporary memory block chain!\n",RECOVERABLE);
}
if ( blocktype == GRAPH_BLOCK )
for ( head = graph_block_head ; head ; head = head->next )
{ if ( head->type != GRAPH_BLOCK )
kb_error(2461,"Bad graphics memory block chain!\n",RECOVERABLE);
}
}
/********************************************************************
*
* function: mem_list_summary()
*
* purpose: Prints summary stats of memory lists.
*/
void mem_list_summary()
{ struct memhead *head;
size_t total=0,subtotal;
size_t count=0,subcount;
for ( head = eternal_block_head, subcount=subtotal=0 ; head ; head = head->next )
{ if ( head->type != ETERNAL_BLOCK )
kb_error(2462,"Bad eternal memory block chain!\n",RECOVERABLE);
else { subtotal += head->size; subcount++; }
}
if ( verbose_flag )
{ sprintf(errmsg,"Session: %7d blocks, %10d bytes \n",subcount,subtotal);
outstring(errmsg);
}
total += subtotal; count += subcount;
for ( head = perm_block_head, subcount=subtotal=0 ; head ; head = head->next )
{ if ( head->type != PERM_BLOCK )
kb_error(2463,"Bad permanent memory block chain!\n",RECOVERABLE);
else { subtotal += head->size; subcount++; }
}
if ( verbose_flag )
{ sprintf(errmsg,"Permanent: %5d blocks, %10d bytes \n",subcount,subtotal);
outstring(errmsg);
}
total += subtotal; count += subcount;
for ( head = temp_block_head, subcount=subtotal=0 ; head ; head = head->next )
{ if ( head->type != TEMP_BLOCK )
kb_error(2464,"Bad temporary memory block chain!\n",RECOVERABLE);
else { subtotal += head->size; subcount++; }
}
for ( head = graph_block_head ; head ; head = head->next )
{ if ( head->type != GRAPH_BLOCK )
kb_error(3210,"Bad graphics memory block chain!\n",RECOVERABLE);
else { subtotal += head->size; subcount++; }
}
if ( verbose_flag )
{ sprintf(errmsg,"Temporary: %5d blocks, %10d bytes\n",subcount,subtotal);
outstring(errmsg);
}
total += subtotal; count += subcount;
if ( verbose_flag )
sprintf(errmsg,"Total data memory: %d blocks, %d bytes.\n",count,total);
else
sprintf(errmsg,"Total data memory: %d bytes.\n",total);
outstring(errmsg);
#ifdef LINUX
if ( verbose_flag )
{ FILE *fd;
int i,vmem=0,mempages=0;
char procname[100];
sprintf(procname,"/proc/%d/stat",getpid());
fd = fopen(procname,"r");
if ( fd == NULL ) perror(procname);
for ( i = 0 ; i < 22 ; i++ ) fscanf(fd,"%s",msg);
fscanf(fd,"%d",&vmem);
sprintf(errmsg,"Virtual memory: %d\n",vmem);
outstring(errmsg);
fscanf(fd,"%d",&mempages);
sprintf(errmsg,"Resident memory: %d\n",mempages*getpagesize());
outstring(errmsg);
}
#endif
}
/********************************************************************
*
* function: mem_list_dump()
*
* purpose: Prints details of memory lists.
*/
void mem_list_dump()
{ struct memhead *head;
size_t subcount;
#ifdef MEMSTRINGS
outstring("\nEternal memory blocks:\n");
for ( head = eternal_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p; %28s line %4d\n",
subcount,head->size,head,head->file,head->line);
outstring(msg);
}
outstring("\nPermanent memory blocks:\n");
for ( head = perm_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p; %28s line %4d\n",
subcount,head->size,head,head->file,head->line);
outstring(msg);
}
outstring("\nTemporary memory blocks:\n");
for ( head = temp_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p; %28s line %4d\n",
subcount,head->size,head,head->file,head->line);
outstring(msg);
}
outstring("\nGraph memory blocks:\n");
for ( head = graph_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p; %28s line %4d\n",
subcount,head->size,head,head->file,head->line);
outstring(msg);
}
#else
outstring("\nEternal memory blocks:\n");
for ( head = eternal_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p\n",
subcount,head->size,head);
outstring(msg);
}
outstring("\nPermanent memory blocks:\n");
for ( head = perm_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p\n",
subcount,head->size,head);
outstring(msg);
}
outstring("\nTemporary memory blocks:\n");
for ( head = temp_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p\n",
subcount,head->size,head);
outstring(msg);
}
outstring("\nGraph memory blocks:\n");
for ( head = graph_block_head, subcount=0 ; head ; head = head->next )
{ subcount++;
sprintf(msg,"%5d. %10d bytes at %p\n",
subcount,head->size,head);
outstring(msg);
}
#endif
}
/********************************************************************
Generic list calloc,realloc,free routines.
*********************************************************************/
/********************************************************************
*
* function: list_calloc()
*
* purpose: allocate memory block on desired list.
*/
#ifdef MEMSTRINGS
char *list_calloc(num,size,type,file,line)
size_t num; /* number of chunks */
size_t size; /* size of chunks */
int type; /* memory list type */
char *file;
size_t line;
#else
char *list_calloc(num,size,type)
size_t num; /* number of chunks */
size_t size; /* size of chunks */
int type; /* memory list type */
#endif
{ struct memhead **listhead=NULL;
struct memhead *ptr;
switch(type)
{ case PERM_BLOCK: listhead = &perm_block_head; break;
case TEMP_BLOCK: listhead = &temp_block_head; break;
case GRAPH_BLOCK: listhead = &graph_block_head; break;
case ETERNAL_BLOCK: listhead = &eternal_block_head; break;
default: kb_error(2452,"Internal error: illegal memory block type.\n",
RECOVERABLE);
}
ptr = (struct memhead *)calloc(sizeof(struct memhead)+num*size,1);
if ( ptr == NULL )
{
mem_sanity_check();
sprintf(errmsg,"Internal error: Cannot allocate memory size %d*%d = %d.\n",
num,size,num*size);
kb_error(2550,errmsg, RECOVERABLE);
}
/* fill in header */
ENTER_MEM_MUTEX
ptr->next = *listhead;
if ( *listhead )
(*listhead)->prev = ptr;
*listhead = ptr;
LEAVE_MEM_MUTEX
ptr->size = num*size;
ptr->type = type;
#ifdef MEMSTRINGS
strncpy(ptr->file,file,sizeof(ptr->file)-1);
ptr->line = line;
#endif
if ( memdebug ) mem_sanity_check();
return (char*)(ptr+1);
}
/************************************************************************
*
* function: list_realloc()
*
* purpose: reallocate memory block on a list.
*
*/
#ifdef MEMSTRINGS
char *list_realloc(ptr,size,type,file,line)
char *ptr; /* old block */
size_t size; /* new size */
int type; /* of list */
char *file;
size_t line;
#else
char *list_realloc(ptr,size,type)
char *ptr; /* old block */
size_t size; /* new size */
int type; /* of list */
#endif
{ struct memhead **listhead=NULL;
struct memhead *newhead;
struct memhead *oldhead;
char *newptr;
size_t oldsize;
switch(type)
{ case PERM_BLOCK: listhead = &perm_block_head; break;
case TEMP_BLOCK: listhead = &temp_block_head; break;
case GRAPH_BLOCK: listhead = &graph_block_head; break;
case ETERNAL_BLOCK: listhead = &eternal_block_head; break;
default: kb_error(2453,"Internal error: illegal memory block type.\n",
RECOVERABLE);
}
#ifdef MEMSTRINGS
if ( ptr == NULL ) return list_calloc(size,1,type,file,line);
#else
if ( ptr == NULL ) return list_calloc(size,1,type);
#endif
oldhead = (struct memhead *)ptr - 1;
if ( oldhead->type != type )
{ sprintf(errmsg,"Internal error: Trying to realloc memory block to different list.\n");
#ifdef MEMSTRINGS
sprintf(errmsg+strlen(errmsg),"File %s, line %d; original alloc %s:%d\n",
file,line,oldhead->file,oldhead->line);
#endif
kb_error(2448,errmsg,RECOVERABLE);
}
oldsize = oldhead->size;
ENTER_MEM_MUTEX /* since manipulating shared variables */
/* delete from my list */
if ( oldhead->next ) oldhead->next->prev = oldhead->prev;
if ( oldhead->prev ) oldhead->prev->next = oldhead->next;
else *listhead = oldhead->next;
newhead =
(struct memhead *)realloc((char*)oldhead,sizeof(struct memhead)+size);
if ( newhead == NULL )
{ sprintf(errmsg,
"Internal error: Cannot reallocate memory from old size %d to new %d.\n",
oldsize,size);
kb_error(1360,errmsg,RECOVERABLE);
}
/* fill in header */
newhead->next = *listhead;
newhead->prev = NULL;
if ( *listhead )
(*listhead)->prev = newhead;
*listhead = newhead;
LEAVE_MEM_MUTEX
newhead->size = size;
newhead->type = type;
#ifdef MEMSTRINGS
strncpy(newhead->file,file,sizeof(newhead->file)-1);
newhead->line = line;
#endif
newptr = (char*)(newhead+1);
if (oldsize < size ) memset(newptr+oldsize,0,size-oldsize);
if ( memdebug ) mem_sanity_check();
return newptr;
} /* end of list_realloc() */
/**************************************************************************
*
* function: list_free()
*
* purpose: free one block on a memory list.
*/
void list_free(ptr,type)
char *ptr;
int type; /* of memory list */
{ struct memhead *head;
struct memhead **listhead=NULL;
if ( !ptr )
{ if ( memdebug ) erroutstring("\n");
return;
}
if ( memdebug ) mem_sanity_check();
switch(type)
{ case PERM_BLOCK: listhead = &perm_block_head; break;
case TEMP_BLOCK: listhead = &temp_block_head; break;
case GRAPH_BLOCK: listhead = &graph_block_head; break;
case ETERNAL_BLOCK: listhead = &eternal_block_head; break;
default: kb_error(2454,"Internal error: illegal memory block type.\n",
RECOVERABLE);
}
head = (struct memhead *)ptr - 1;
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(msg," allocated from %s:%d\n",head->file,head->line);
#else
sprintf(msg,"\n");
#endif
erroutstring(msg);
}
if ( head->type != type )
{ switch ( head->type )
{ case ETERNAL_BLOCK: case TEMP_BLOCK: case PERM_BLOCK:
case GRAPH_BLOCK:
#ifdef MEMSTRINGS
sprintf(errmsg,"Internal error: Trying to free memory block from wrong type list.\nAllocated from %s:%d\n",
head->file,head->line);
#else
sprintf(errmsg,"Internal error: Trying to free memory block from wrong type list.\n");
#endif
kb_error(2465,errmsg,RECOVERABLE);
default:
#ifdef MEMSTRINGS
sprintf(errmsg,"Internal error: Trying to free corrupt memory block.\nAllocated from %s:%d\n",
head->file,head->line);
kb_error(2466,errmsg,RECOVERABLE);
#else
kb_error(3209,
"Internal error: trying to free corrupt memory block.\n",
RECOVERABLE);
#endif
}
}
/* delete from my list */
ENTER_MEM_MUTEX
if ( head->next ) head->next->prev = head->prev;
if ( head->prev ) head->prev->next = head->next;
else *listhead = head->next;
LEAVE_MEM_MUTEX
free((char*)head);
if ( memdebug ) mem_sanity_check();
}
/**************************************************************************
*
* function: list_free_all()
*
* purpose: free all blocks on a list.
*/
void list_free_all(type)
int type; /* of list */
{ struct memhead **listhead=NULL;
struct memhead *head,*nexthead;
switch(type)
{ case PERM_BLOCK: listhead = &perm_block_head; break;
case TEMP_BLOCK: listhead = &temp_block_head; break;
case GRAPH_BLOCK: listhead = &graph_block_head; break;
case ETERNAL_BLOCK: listhead = &eternal_block_head; break;
default: kb_error(2455,"Internal error: illegal memory block type.\n",
RECOVERABLE);
}
ENTER_MEM_MUTEX
for ( head = *listhead; head ; head = nexthead )
{ if ( head->type != type )
kb_error(3905,"Internal error: corrupt memory list.\n",RECOVERABLE);
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(msg,"Freeing %p, %d bytes, allocated at %s:%d\n",head+1,
head->size,head->file,head->line);
#else
sprintf(msg,"Freeing %p, %d bytes\n",head+1,head->size);
#endif
erroutstring(msg);
}
nexthead = head->next;
free((char*)head);
}
*listhead = NULL;
LEAVE_MEM_MUTEX
} /* end list_free_all */
/********************************************************************
Permanent memory allocation. These blocks
will be automatically freed at the start of
a new surface, eliminating a lot of clean-up
drudgery.
********************************************************************/
/*********************************************************************
*
* function: kb_calloc
*
* purpose: memory allocation with error detection
* Also memory debugging.
* Called by macro mycalloc(num,size).
*/
#ifdef MEMSTRINGS
char *kb_calloc(num,size,file,line)
size_t num,size;
char *file;
size_t line;
#else
char *kb_calloc(num,size)
size_t num,size;
#endif
{ char *ptr;
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(errmsg,"mycalloc %30.30s %5d: %10d ",file,line,num*size);
erroutstring(errmsg);
#else
sprintf(errmsg,"mycalloc %d*%d = %d bytes ",num,size,num*size);
erroutstring(errmsg);
#endif
}
#ifdef MEMSTRINGS
ptr = list_calloc(num,size,PERM_BLOCK,file,line);
#else
ptr = list_calloc(num,size,PERM_BLOCK);
#endif
if ( memdebug )
{ sprintf(errmsg,"at %p\n",ptr); erroutstring(errmsg);
mem_sanity_check();
}
return ptr;
} /* end kb_calloc */
/*********************************************************************
*
* function: KB_realloc
*
* purpose: memory re-allocation with error detection
* Called through macro kb_realloc for optional memory debug.
*/
#ifdef MEMSTRINGS
char *KB_realloc(ptr,size,file,line)
char *ptr;
size_t size;
char *file; size_t line;
#else
char *KB_realloc(ptr,size)
char *ptr;
size_t size;
#endif
{ char *newptr;
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(errmsg,"%30.30s %4d: realloc old %p size %d to size %d \n",
file,line,ptr, (ptr ? ((struct memhead *)ptr)[-1].size:0) ,size);
#else
sprintf(errmsg,"realloc old %p size %d to size %d \n",ptr,
(ptr ? ((struct memhead *)ptr)[-1].size:0 ) ,size);
#endif
erroutstring(errmsg);
}
#ifdef MEMSTRINGS
if ( ptr == NULL ) newptr = kb_calloc(size,1,file,line);
else newptr = list_realloc(ptr,size,PERM_BLOCK,file,line);
#else
if ( ptr == NULL ) newptr = mycalloc(size,1);
else newptr = list_realloc(ptr,size,PERM_BLOCK);
#endif
if ( memdebug )
{ sprintf(errmsg,"at %p\n",newptr); erroutstring(errmsg);
mem_sanity_check();
}
return newptr;
} /* end kb_realloc() */
/********************************************************************
*
* function: myfree()
*
* purpose: Freeing memory. Common call for permanent memory freeing.
*
*/
void myfree(ptr)
char *ptr;
{
if ( memdebug )
{
sprintf(errmsg,"free %p ",ptr);
erroutstring(errmsg);
}
list_free(ptr,PERM_BLOCK);
}
/********************************************************************
Temporary memory allocation. These blocks
will be automatically freed at the end of
each command, although subroutines should
practice good memory hygeine and free all
their own memory. Mostly intended in case
of error recovery.
********************************************************************/
/********************************************************************
*
* function: kb_temp_calloc()
*
* purpose: memory allocation that can be undone by longjmp at error.
*
*/
#ifdef MEMSTRINGS
char *kb_temp_calloc(num,size,file,line)
size_t num,size;
char *file;
size_t line;
#else
char *kb_temp_calloc(num,size)
size_t num,size;
#endif
{ char *ptr;
int blocktype = TEMP_BLOCK;
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(errmsg,"%30.30s %4d: ",file,line);
erroutstring(errmsg);
#endif
sprintf(errmsg,"temp_calloc %9d bytes ",num*size);
erroutstring(errmsg);
}
THREADBLOCK(blocktype);
#ifdef MEMSTRINGS
ptr = list_calloc(num,size,blocktype,file,line);
#else
ptr = list_calloc(num,size,blocktype);
#endif
if ( memdebug )
{ sprintf(errmsg,"at %p \n",ptr); erroutstring(errmsg);
mem_sanity_check();
}
return ptr;
}
/********************************************************************
*
* function: temp_realloc()
*
* purpose: Changing size of temporary memory allocation.
*
*/
#ifdef MEMSTRINGS
char * kb_temp_realloc(ptr,size,file,line)
char *ptr;
size_t size;
char *file;
size_t line;
#else
char * kb_temp_realloc(ptr,size)
char *ptr;
size_t size;
#endif
{
char *newptr;
int blocktype = TEMP_BLOCK;
if ( memdebug )
{
#ifdef MEMSTRINGS
sprintf(errmsg,"%30.30s %4d: temp_realloc\n old size %9d at %p to size %9d",
file,line, (ptr ? ((struct memhead *)ptr)[-1].size:0),ptr ,size);
#else
sprintf(errmsg,"temp_realloc old %p size %9d to size %9d",ptr,
(ptr ? ((struct memhead *)ptr)[-1].size:0 ) ,size);
#endif
erroutstring(errmsg);
}
THREADBLOCK(blocktype);
#ifdef MEMSTRINGS
newptr = list_realloc(ptr,size,blocktype,file,line);
#else
newptr = list_realloc(ptr,size,blocktype);
#endif
if ( memdebug )
{ sprintf(errmsg," at %p \n",newptr); erroutstring(errmsg);
mem_sanity_check();
}
return newptr;
}
/********************************************************************
*
* function: temp_free()
*
* purpose: Usual freeing of temporary memory allocation.
*
*/
void temp_free(ptr)
char *ptr;
{
int blocktype = TEMP_BLOCK;
if ( memdebug )
{
sprintf(errmsg,"temp_free %p ",ptr);
erroutstring(errmsg);
}
THREADBLOCK(blocktype);
list_free(ptr,blocktype);
} /* end temp_free */
/********************************************************************
*
* function: temp_free_all()
*
* purpose: Freeing of all temporary memory in case of error.
*
*/
void temp_free_all()
{
int blocktype = 0;
#ifdef _DEBUGXX
int oldmemdebug = memdebug;
memdebug=1;
#endif
if ( memdebug )
erroutstring("Entering temp_free_all\n");
THREADBLOCK(blocktype);
list_free_all(blocktype);
#ifdef MPI_EVOLVER
if ( this_task == 0 && blocktype != GRAPH_BLOCK )
mpi_temp_free_all();
#endif
#ifdef _DEBUGXX
memdebug = oldmemdebug;
#endif
/* pointers to be annulled in main thread */
if ( blocktype == TEMP_BLOCK )
{
saved.coord = NULL;
vhead = NULL;
pressures = NULL;
conrhs = NULL;
vgradbase = NULL;
rightside = NULL;
vpressures = NULL;
e_curve = NULL;
v_curve = NULL;
}
}
/********************************************************************
Memory allocation routines for the block of memory holding
dynamic structures of surface description. Enables
exporting surface info to multiple processors.
Returns are offsets from start of dynamic region.
*********************************************************************/
#define ALIGNSIZE 8
struct dy_head { int size; /* bytes in block, including structures */
int state; /* see defines; also used as magic number */
DY_OFFSET prev; /* linear block list */
DY_OFFSET next;
DY_OFFSET prevfree; /* disordered free block list */
DY_OFFSET nextfree;
};
#define DY_FREE 0xCCAA
#define DY_USED 0xDDBB
#define DY_STARTSIZE 0x1000
int dy_minfrag = 2*sizeof(struct dy_head);
int dy_overhead = sizeof(struct dy_head);
DY_OFFSET dy_firstblock;
DY_OFFSET dy_lastblock;
DY_OFFSET dy_calloc(num,size)
int num;
int size;
{ struct dy_head *ptr,*newptr,*lastptr;
DY_OFFSET off;
int needed;
int surplus;
int asize;
int i;
if ( dymemsize == 0 ) /* initial allocation */
{ if ( sizeof(struct dy_head) % ALIGNSIZE )
{ sprintf(errmsg,
"Internal error: sizeof(struct dy_head) %d not multiple of ALIGNSIZE %d\n",
sizeof(struct dy_head),ALIGNSIZE);
kb_error(1364,errmsg,UNRECOVERABLE);
}
dymem = mycalloc(DY_STARTSIZE,1);
dymemsize = DY_STARTSIZE;
strcpy(dymem,"DY_MEM"); /* so looks pretty in debugger */
dy_firstblock = sizeof(struct dy_head);
ptr = (struct dy_head *)dymem+1; /* so offset 0 not used */
ptr->size = DY_STARTSIZE-sizeof(struct dy_head);
ptr->state = DY_FREE;
ptr->next = 0;
ptr->prev = 0;
dy_lastblock = sizeof(struct dy_head);
dy_freestart = sizeof(struct dy_head);
ptr->prevfree = 0; /* first in list */
ptr->nextfree = 0; /* last in list */
}
/* size of needed block */
asize = ((num*size + ALIGNSIZE - 1)/ALIGNSIZE)*ALIGNSIZE;
if ( asize <= dy_minfrag ) asize = dy_minfrag;
needed = sizeof(struct dy_head) + asize;
if ( memdebug )
{ sprintf(errmsg,"dy_alloc %d*%d = %d bytes.\n",num,size,asize);
erroutstring(errmsg);
}
retry_alloc:
/* look for first fit in free block list */
if ( dy_freestart )
for ( off = dy_freestart ; off > 0 ; off = ptr->nextfree )
{
ptr = (struct dy_head *)(dymem + off);
/* check size */
if ( needed > ptr->size )
{ if ( ptr->nextfree == 0 ) break;
else continue;
}
surplus = ptr->size - needed;
if ( surplus > dy_minfrag )
{ /* divide block */
newptr = (struct dy_head *)(dymem + off + needed);
newptr->size = ptr->size - needed;
newptr->state = DY_FREE;
newptr->next = ptr->next;
newptr->prev = off;
if ( newptr->next )
((struct dy_head *)(dymem + newptr->next))->prev =
off + needed;
else
dy_lastblock = off + needed;
newptr->nextfree = ptr->nextfree;
newptr->prevfree = ptr->prevfree;
ptr->size = needed;
ptr->next = off + needed;
if (ptr->prevfree )
((struct dy_head *)(dymem + ptr->prevfree))->nextfree = off + needed;
else dy_freestart = off + needed;
if ( ptr->nextfree )
((struct dy_head *)(dymem + ptr->nextfree))->prevfree = off + needed;
}
else
{ /* remove from freelist */
if ( ptr->prevfree )
((struct dy_head *)(dymem + ptr->prevfree))->nextfree
= ptr->nextfree;
else dy_freestart = ptr->nextfree;
if ( ptr->nextfree )
((struct dy_head *)(dymem + ptr->nextfree))->prevfree
= ptr->prevfree;
ptr->nextfree = 0;
ptr->prevfree = 0;
}
ptr->state = DY_USED;
#ifdef _DEBUG
dy_check();
#endif
/* some handy debugging equivalences */
Globals = globals(0);
for ( i = 0 ; i < NUMELEMENTS ; i++ )
Extras[i] = EXTRAS(i);
return off + sizeof(struct dy_head);
}
/* if here, then no block big enough */
if ( memdebug ) erroutstring ("expanding dymem.\n");
ENTER_GRAPH_MUTEX
dymem = kb_realloc(dymem,2*dymemsize);
LEAVE_GRAPH_MUTEX
lastptr = (struct dy_head *)(dymem + dy_lastblock);
if ( lastptr->state == DY_FREE )
{ /* combine with last block */
lastptr->size += dymemsize;
}
else
{ /* put in free block list at head */
ptr = (struct dy_head *)(dymem + dymemsize);
ptr->size = dymemsize;
ptr->state = DY_FREE;
ptr->prev = dy_lastblock;
ptr->next = 0;
lastptr = (struct dy_head *)(dymem + dy_lastblock);
dy_lastblock = dymemsize;
lastptr->next = dymemsize;
ptr->prevfree = 0;
ptr->nextfree = dy_freestart;
if ( dy_freestart )
((struct dy_head *)(dymem+dy_freestart))->prevfree = dymemsize;
dy_freestart = dymemsize;
}
dymemsize = 2*dymemsize;
goto retry_alloc;
}
DY_OFFSET dy_realloc(old,newnum,newsize)
DY_OFFSET old;
int newnum;
int newsize;
{ DY_OFFSET newspot;
struct dy_head *ptr;
int i;
if ( memdebug )
{ erroutstring("dy_realloc "); }
ENTER_GRAPH_MUTEX
newspot = dy_calloc(newnum,newsize);
if ( old )
{ ptr = (struct dy_head *)(dymem + old) - 1;
if ( ptr->size < newnum*newsize )
memcpy(dymem+newspot,dymem+old,ptr->size);
else memcpy(dymem+newspot,dymem+old,newnum*newsize);
dy_free(old);
}
LEAVE_GRAPH_MUTEX
/* some handy debugging equivalences */
Globals = globals(0);
for ( i = 0 ; i < NUMELEMENTS ; i++ )
Extras[i] = EXTRAS(i);
#ifdef _DEBUG
dy_check();
#endif
return newspot;
}
void dy_free(spot)
DY_OFFSET spot;
{ DY_OFFSET off = spot - sizeof(struct dy_head);
struct dy_head *ptr = (struct dy_head *)(dymem + off);
struct dy_head *prevhead,*nexthead;
if ( ptr->state != DY_USED )
kb_error(1366,"Internal error: Trying to dy_free unallocated block.\n",
RECOVERABLE);
memset(dymem+spot,0,ptr->size - dy_overhead);
ptr->nextfree = dy_freestart;
ptr->prevfree = 0;
if ( dy_freestart )
((struct dy_head *)(dymem + dy_freestart))->prevfree = off;
dy_freestart = off;
ptr->state = DY_FREE;
/* see if can combine with nbrs */
/* check preceding block */
if ( ptr->prev )
{ prevhead = (struct dy_head *)(dymem + ptr->prev);
if ( prevhead->state == DY_FREE )
{ /* combine */
prevhead->size += ptr->size;
prevhead->next = ptr->next;
if ( ptr->next )
{ nexthead = (struct dy_head *)(dymem + ptr->next);
nexthead->prev = ptr->prev;
}
if ( off == dy_lastblock )
dy_lastblock = ptr->prev;
/* remove from freelist */
if ( ptr->nextfree )
((struct dy_head*)(dymem+ptr->nextfree))->prevfree = ptr->prevfree;
if ( ptr->prevfree )
((struct dy_head*)(dymem+ptr->prevfree))->nextfree = ptr->nextfree;
else dy_freestart = ptr->nextfree;
memset((char*)ptr,0,sizeof(struct dy_head));
ptr = prevhead; /* ready for next stage of combining */
}
}
/* check following block */
if ( ptr->next )
{ nexthead = (struct dy_head *)(dymem + ptr->next);
if ( nexthead->state == DY_FREE )
{ /* combine */
if ( ptr->next == dy_lastblock )
dy_lastblock = nexthead->prev;
prevhead = ptr; ptr = nexthead;
prevhead->size += ptr->size;
prevhead->next = ptr->next;
if ( ptr->next )
{ nexthead = (struct dy_head *)(dymem + ptr->next);
nexthead->prev = ptr->prev;
}
/* remove from freelist */
if ( ptr->nextfree )
((struct dy_head*)(dymem+ptr->nextfree))->prevfree = ptr->prevfree;
if ( ptr->prevfree )
((struct dy_head*)(dymem+ptr->prevfree))->nextfree = ptr->nextfree;
else dy_freestart = ptr->nextfree;
memset((char*)ptr,0,sizeof(struct dy_head));
}
}
#ifdef _DEBUG
dy_check();
#endif
}
void dy_check()
{
struct dy_head *head,*nexthead;
int freeblocks = 0;
int usedblocks = 0;
int freebytes = 0;
int usedbytes = 0;
DY_OFFSET off;
for ( off = dy_firstblock ; off != 0 ; off = head->next )
{ head = (struct dy_head *)(dymem + off);
switch ( head->state )
{ case DY_FREE: freeblocks++; freebytes += head->size; break;
case DY_USED: usedblocks++; usedbytes += head->size; break;
default: kb_error(2468,"Internal error: Corrupt dy_mem; bad state.\n",
RECOVERABLE);
return;
}
if ( head->next )
{ nexthead = (struct dy_head *)(dymem + head->next);
if ( off != nexthead->prev )
kb_error(2469,"Internal error: Corrupt dy_mem; bad prev.\n",RECOVERABLE);
}
}
if ( memdebug )
{ sprintf(errmsg,"Dymem arena: %d\n",dymemsize);
erroutstring(errmsg);
sprintf(errmsg,"Dymem free blocks: %d free bytes: %d\n",freeblocks,freebytes);
erroutstring(errmsg);
sprintf(errmsg,"Dymem used blocks: %d used bytes: %d\n",usedblocks,usedbytes);
erroutstring(errmsg);
}
/* check freelist integrity */
for ( off = dy_freestart ; (off != 0) && freeblocks ; off = head->nextfree )
{ head = (struct dy_head *)(dymem + off);
if ( head->state != DY_FREE )
kb_error(2555,"Internal error: Corrupt dy_mem nextfree.\n",RECOVERABLE);
if ( head->nextfree )
{ nexthead = (struct dy_head *)(dymem + head->nextfree);
if ( off != nexthead->prevfree )
kb_error(2470,"Internal error: Corrupt dy_mem prevfree.\n",RECOVERABLE);
}
freeblocks--;
}
if ( freeblocks || (off != 0) )
kb_error(2471,"Internal error: Corrupt dy_mem free list.\n",RECOVERABLE);
} /* end dy_check() */
/********* end of dynamic memory stuff **************************/
/**************************************************************
*
* Function: calc_edge()
*
* Purpose: Calculate the length of an edge from its endpoint
* coordinates. Puts result into edge structure.
*
*/
void calc_edge(e_id)
edge_id e_id;
{
REAL len=0.0;
REAL s[MAXCOORD];
REAL midx[MAXCOORD];
int i,j,k;
vertex_id tv = get_edge_tailv(e_id);
REAL *xt=get_coord(tv);
REAL euclidean;
if ( everything_quantities_flag )
{ instance_attribute(e_id,length_method_number);
/* legitimate methods set edge length */
return;
}
get_edge_side(e_id,s);
euclidean = SDIM_dot(s,s);
if ( klein_metric_flag )
{ for ( i = 0 ; i < SDIM ; i++ ) midx[i] = xt[i] + s[i];/*unwrap head*/
len = klein_length(xt,midx);
}
else if ( web.metric_flag )
{
/* energy due to linear tension, metric evaluated at midpoint */
for ( k = 0, len = 0.0 ; k < gauss1D_num ; k++ )
{ REAL sum;
for ( i = 0 ; i < SDIM ; i++ )
midx[i] = gauss1Dpt[k]*s[i] + xt[i];
if ( web.conformal_flag )
{ REAL gg = eval(&web.metric[0][0],midx,NULLID,NULL);
len += gauss1Dwt[k]*sqrt(gg*euclidean);
}
else
{ for ( sum = 0.0, i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
sum += s[i]*s[j]*eval(&web.metric[i][j],midx,NULLID,NULL);
len += gauss1Dwt[k]*sqrt(sum);
}
}
}
else
{
switch (web.modeltype)
{ case LINEAR: len = sqrt(euclidean); break;
case QUADRATIC:
{ MAT2D(x,3,MAXCOORD);
REAL tang[MAXCOORD];
int m;
len = 0;
get_edge_verts(e_id,x,NULL);
for ( m = 0 ; m < gauss1D_num ; m++ )
{ for ( j = 0 ; j < SDIM ; j ++ )
{ tang[j] = 0.0;
for ( k = 0 ; k < edge_ctrl ; k++ )
tang[j] += gauss1polyd[k][m]*x[k][j];
}
len += gauss1Dwt[m]*sqrt(SDIM_dot(tang,tang));
}
} break;
case LAGRANGE:
{ /* tangent vectors at gauss points */
int m;
MAT2D(x,20,MAXCOORD);
REAL tang[MAXCOORD];
int ctrl = web.skel[EDGE].ctrlpts;
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
len = 0.0;
get_edge_verts(e_id,x,NULL);
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ vec_mat_mul(gl->gpolypart[m][0],x,tang,ctrl,SDIM);
len += gl->gausswt[m]*sqrt(SDIM_dot(tang,tang));
}
}
break;
} /* end switch */
}
set_edge_length(e_id,len);
}
/************************************************************
*
* get_edge_side()
*
* Purpose: calculate the vector of an edge
*
* Input: edge_id e_id - specifies edge
* REAL *x; - 3 components of vector
*
* Output: x[] has side components
*/
void get_edge_side(e_id,x)
edge_id e_id;
REAL *x;
{
REAL *y,*z;
int i;
REAL w[MAXCOORD];
y = get_coord(get_edge_tailv(e_id));
z = get_coord(get_edge_headv(e_id));
if ( web.symmetry_flag )
{
(*sym_wrap)(z,w,get_edge_wrap(e_id));
z = w;
}
for ( i = 0 ; i < SDIM ; i++ )
x[i] = z[i] - y[i];
}
/************************************************************
*
* get_edge_tail_tangent()
*
* Purpose: Calculate the tangent vector of an edge at the tail.
* Magnitude of tangent equal to length, pretty much.
*
* Input: edge_id e_id - specifies edge
* REAL *x; - 3 components of vector
*
* Output: x[] has side components
*/
void get_edge_tail_tangent(e_id,x)
edge_id e_id;
REAL *x;
{
int i,n;
REAL w[MAXCOORD],ww[MAXCOORD];
if ( web.lagrange_order == 1 )
{
REAL *y,*z;
y = get_coord(get_edge_tailv(e_id));
z = get_coord(get_edge_headv(e_id));
if ( web.symmetry_flag )
{
(*sym_wrap)(z,w,get_edge_wrap(e_id));
z = w;
}
for ( i = 0 ; i < SDIM ; i++ )
x[i] = z[i] - y[i];
return;
}
if ( web.modeltype == QUADRATIC )
{ vertex_id v[3];
REAL *xx[3];
v[0] = get_edge_tailv(e_id);
v[1] = get_edge_midv(e_id);
v[2] = get_edge_headv(e_id);
xx[0] = get_coord(v[0]);
xx[1] = get_coord(v[1]);
xx[2] = get_coord(v[2]);
if ( web.symmetry_flag )
{ WRAPTYPE wrap = get_edge_wrap(e_id);
(*sym_wrap)(xx[2],w,wrap);
xx[2] = w;
if ( inverted(e_id) )
{ (*sym_wrap)(xx[1],ww,wrap);
xx[1] = ww;
}
}
if ( circular_arc_flag )
{ REAL dx1 = xx[1][0] - xx[0][0];
REAL dx2 = xx[2][0] - xx[1][0];
REAL dy1 = xx[1][1] - xx[0][1];
REAL dy2 = xx[2][1] - xx[1][1];
REAL denom1 = sqrt(dx1*dx1+dy1*dy1);
REAL denom2 = sqrt(dx2*dx2+dy2*dy2);
REAL chord,sinth,costh,angle,length;
if (denom1*denom2 == 0.0) {x[0] = x[1] = 0.0; return ;}
chord = sqrt((dx1+dx2)*(dx1+dx2)+(dy1+dy2)*(dy1+dy2));
sinth = (dx1*dy2 - dy1*dx2)/denom1/denom2;
costh = (dx1*dx2 + dy1*dy2)/denom1/denom2;
angle = atan2(sinth,costh);
if ( sinth == 0.0 )
{ for ( i = 0 ; i < SDIM ; i++ )
x[i] = xx[2][i] - xx[0][i];
return;
}
length = chord*angle/sinth;
x[0] = length*(costh*(dx1+dx2) + sinth*(dy1+dy2))/chord;
x[1] = length*(costh*(dy1+dy2) - sinth*(dx1+dx2))/chord;
return;
}
else
{ /* regular quadratic */
for ( i = 0 ; i < SDIM ; i++ )
x[i] = -3*xx[0][i] + 4*xx[1][i] - xx[2][i];
}
return;
}
if ( web.modeltype == LAGRANGE )
{ struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
int ctrl = web.skel[EDGE].ctrlpts;
int spot = inverted(e_id) ? ctrl-1 : 0;
vertex_id *v;
REAL *xx[MAXLAGRANGE+1];
v = get_edge_vertices(e_id);
for ( i = 0 ; i < ctrl ; i++ )
xx[i] = get_coord(v[i]);
if ( web.symmetry_flag )
{ WRAPTYPE wrap = get_edge_wrap(e_id);
(*sym_wrap)(xx[ctrl-1],w,wrap);
xx[ctrl-1] = w;
}
for ( i = 0 ; i < SDIM ; i++ )
{ x[i] = 0;
for ( n = 0 ; n < ctrl ; n++ )
x[i] += gl->lpolypart[spot][0][n]*xx[n][i];
x[i] *= ctrl; /* scaling to length of edge */
if ( inverted(e_id) )
x[i] = -x[i];
}
}
}
/*************************************************************
*
* function: get_edge_adjust()
*
* purpose: adjust a side vector for torus wrap.
* used only in torvol.c.
*
*/
void get_edge_adjust(e_id,w)
edge_id e_id;
REAL *w;
{
REAL x[MAXCOORD];
int i ;
for ( i = 0 ; i < SDIM ; i++ ) x[i] = 0.0;
(*sym_wrap)(x,w,get_edge_wrap(e_id));
}
/***************************************************************
*
* Function: get_vertex_evalence
*
* Purpose: return number of edges around vertex
*
*/
int get_vertex_evalence(v_id)
vertex_id v_id;
{
int n = 0;
edge_id e_id;
edge_id next_e;
int attr = get_vattr(v_id);
if ( attr & (Q_MIDPOINT|Q_MIDEDGE) ) return 1;
e_id = get_vertex_edge(v_id);
if ( !valid_element(e_id) ) return 0;
next_e = e_id;
do
{ n++;
next_e = get_next_tail_edge(next_e);
if ( n > 2*web.skel[EDGE].count )
{ sprintf(errmsg,
"Internal error: vertex_evalence() in infinite loop on vertex %s.\n",
ELNAME(v_id));
kb_error(2482,errmsg,RECOVERABLE);
}
}
while ( !equal_id(next_e,e_id) );
return n;
}
/***************************************************************
*
* Function: get_edge_valence
*
* Purpose: return number of facets around edge
*
*/
int get_edge_valence(e_id)
edge_id e_id;
{
int n = 0,m=0;
facetedge_id fe = get_edge_fe(e_id);
facetedge_id next_fe = fe;
if ( !valid_id(fe) ) return 0;
do
{ if ( valid_id(get_fe_facet(fe)) ) n++;
next_fe = get_next_facet(next_fe);
m++; /* infinite loop preventer */
if ( m > web.skel[FACETEDGE].count )
{ sprintf(errmsg,
"Internal error: edge_valence() in infinite loop on edge %s.\n",
ELNAME(e_id));
kb_error(2480,errmsg,RECOVERABLE);
}
}
while ( next_fe != fe );
return n;
}
/***************************************************************
*
* Function: get_facet_valence
*
* Purpose: return number of edges around facet
*
*/
int get_facet_valence(f_id)
facet_id f_id;
{
int n = 0;
facetedge_id fe = get_facet_fe(f_id);
facetedge_id next_fe = fe;
if ( !valid_id(fe) ) return 0;
do
{ n++;
next_fe = get_next_edge(next_fe);
if ( n > 2*web.skel[EDGE].count )
{ sprintf(errmsg,
"Internal error: facet_valence() in infinite loop on facet %s.\n",
ELNAME(f_id));
kb_error(2481,errmsg,RECOVERABLE);
}
}
while ( valid_id(next_fe) && (next_fe != fe) );
return n;
}
/***************************************************************
*
* Function: get_body_valence
*
* Purpose: return number of facets around a body
*
*/
int get_body_valence(b_id)
body_id b_id;
{
int n = 0;
facet_id f_id = get_body_facet(b_id);
facet_id next_f = f_id;
if ( !valid_id(f_id) ) return 0;
if ( web.representation == STRING ) return get_facet_valence(f_id);
/*
if ( bfacet_timestamp < top_timestamp )
{ make_bfacet_lists();
bfacet_timestamp = top_timestamp;
}
*/
do
{ n++;
next_f = get_next_body_facet(next_f);
}
while ( (next_f != f_id) && (n < 3*web.skel[FACET].count) );
return n;
}
/*********************************************************************
*
* function: set_facet_vertices()
*
* purpose: Fill in vertex lists of facets.
*/
void set_facet_vertices ARGS((void));
void set_facet_vertices()
{
/* have to make expandable v list for quadratic mode */
}
/****************************************************************
*
* function: begin_normal_motion()
*
* purpose: calculates vertex normals as volume gradients, normalized to
* unit length.
*
*/
void begin_normal_motion()
{
vertex_id v_id;
facetedge_id fe;
MAT2D(normals,MAXCOORD,MAXCOORD);
int i;
pt_type *vn;
int normcount;
if ( vertex_normals != NULL ) myfree((char*)vertex_normals);
vertex_normals = (pt_type *)mycalloc(
web.skel[VERTEX].max_ord+1,sizeof(pt_type));
FOR_ALL_VERTICES(v_id)
{ REAL mag;
fe = get_vertex_fe(v_id);
if ( !valid_id(fe) ) continue;
normcount = new_calc_vertex_normal(v_id,normals);
project_vertex_normals(v_id,normals,normcount);
vn = vertex_normals + loc_ordinal(v_id);
mag = sqrt(dot(normals[0],normals[0],SDIM));
if ( mag != 0.0 )
for ( i = 0 ; i < SDIM ; i++ )
(*vn)[i] = normals[0][i]/mag;
}
normal_motion_flag = 1;
}
/*****************************************************************
*
* function: end_normal_motion()
*
* purpose: free memory used in normal motion mode
*
*/
void end_normal_motion()
{
if ( vertex_normals != NULL ) myfree((char*)vertex_normals);
vertex_normals = NULL;
normal_motion_flag = 0;
}
/***********************************************************
*
* Function: vertex_total_vol_grad()
*
* Purpose: Calculate the gradient of combined body volume at a vertex.
* Meant for triple lines and such in surface diffusion.
*
* Input: vertex id
* norm - pointer to place for normal vector
*
*
* Output: Average normal, normalized to unit length.
*
* Return value: Length of original normal, i.e. volume gradient.
*/
REAL vertex_total_vol_grad(v_id,norm)
vertex_id v_id;
REAL *norm;
{
int i,j;
REAL y[MAXCOORD],z[MAXCOORD];
REAL fnorm[MAXCOORD];
facetedge_id fe_id,first_fe;
REAL size;
/* check for string */
if ( web.representation == STRING )
{ edge_id e_id,start_e;
norm[0] = norm[1] = 0.0;
start_e = e_id = get_vertex_edge(v_id);
do
{ facetedge_id fe,fe2;
facet_id f_id;
get_edge_side(e_id,y);
fe = get_edge_fe(e_id);
if ( valid_id(fe) )
{ fe2 = get_next_facet(fe);
if ( equal_id(fe,fe2) )
{ /* valence 1, so count it according to facet orientation */
f_id = get_fe_facet(fe);
if ( inverted(f_id) )
{ norm[0] -= y[1];
norm[1] += y[0];
}
else
{ norm[0] += y[1];
norm[1] -= y[0];
}
}
}
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(e_id,start_e) );
goto normalize;
}
/* Get here only for soapfilm model. */
first_fe = fe_id = get_vertex_first_facet(v_id);
for ( i = 0 ; i < SDIM ; i++ ) norm[i] = 0.0;
do
{ facet_id f_id = get_fe_facet(fe_id);
body_id b_id = get_facet_body(f_id);
body_id bb_id = get_facet_body(invert(f_id));
if ( valid_id(b_id) != valid_id(bb_id) )
{ /* one-sided, so count it */
get_fe_side(fe_id,z);
get_fe_side(get_prev_edge(fe_id),y);
cross_prod(y,z,fnorm);
if ( valid_id(b_id) )
for ( i = 0 ; i < SDIM ; i++ ) norm[i] += fnorm[i];
else
for ( i = 0 ; i < SDIM ; i++ ) norm[i] -= fnorm[i];
}
fe_id = get_next_vertex_facet(v_id,fe_id);
} while ( !equal_id(fe_id,first_fe) );
normalize:
if ( get_vattr(v_id) & CONSTRAINT )
{
conmap_t * conmap = get_v_constraint_map(v_id);
int oncount = 0,hitcount;
struct constraint *con[MAXCONPER];
int conlist[MAXCONPER];
REAL perp[MAXCOORD];
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
{
if ( conmap[j] & CON_HIT_BIT )
{ conlist[oncount] = conmap[j];
con[oncount++] = get_constraint(conmap[j]);
}
}
hitcount = constr_proj(TANGPROJ,oncount,con,get_coord(v_id),
norm,perp,conlist,DETECT,v_id);
if ( hitcount != oncount )
{ clear_v_constraint_status(v_id);
for ( j = 0 ; j < hitcount ; j++ )
set_v_constraint_status(v_id,conlist[j]);
}
for ( j = 0 ; j < SDIM ; j++ )
norm[j] -= perp[j];
}
size = sqrt(SDIM_dot(norm,norm));
if ( size <= 0.0 ) return 0.0;
for ( i = 0 ; i < SDIM ; i++ ) norm[i] /= size;
return size/web.simplex_factorial;
}
/***********************************************************
*
* Function: calc_vertex_normal
*
* Purpose: Calculate average normal of facets around a vertex.
* Only does the facets
* in the same face as given facet; will not cross
* multiple edges.
*
* Input: vertex id
* facet-edge id - with tail at vertex, for defining face
* norm - pointer to place for normal vector
*
*
* Output: Average normal, normalized to unit length.
*
* Return value: Length of original normal, i.e. volume gradient.
*/
REAL calc_vertex_normal(v_id,fe,norm)
vertex_id v_id;
facetedge_id fe;
REAL *norm;
{
int i,j;
REAL y[MAXCOORD],z[MAXCOORD];
REAL fnorm[MAXCOORD];
facetedge_id sidea;
struct boundary *bdry; /* to check staying on same boundary */
REAL size;
/* check for string */
if ( web.representation == STRING )
{ edge_id e_id,ee_id;
e_id = get_vertex_edge(v_id);
ee_id = get_next_tail_edge(e_id);
get_edge_side(e_id,z);
get_edge_side(ee_id,y);
if ( equal_id(e_id,ee_id) ) { norm[0] = y[1]; norm[1] = -y[0]; }
else { norm[0] = y[1] - z[1]; norm[1] = z[0] - y[0]; }
if (inverted(e_id)) { norm[0] = -norm[0]; norm[1] = -norm[1];}
goto normalize;
}
if ( !valid_id(fe) )
{ fe = get_vertex_fe(v_id);
if ( !valid_id(fe) )
{ for ( i = 0 ; i < SDIM ; i++ ) norm[i] = 0.0;
return 0.0;
}
}
for ( i = 0 ; i < SDIM ; i++ ) norm[i] = 0.0;
bdry = get_facet_boundary(get_fe_facet(fe)); /* original boundary */
/* go around one way to edge of face */
sidea = fe;
do
{
get_fe_side(sidea,z);
get_fe_side(get_prev_edge(sidea),y);
cross_prod(y,z,fnorm);
for ( i = 0 ; i < SDIM ; i++ ) norm[i] += fnorm[i];
/* go to next facet */
sidea = get_prev_edge(sidea);
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* edge */
sidea = fe_inverse(get_next_facet(sidea));
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
if ( equal_id(sidea,fe) ) goto onormalize; /* went all the way around */
}
while ( equal_id(get_next_facet(sidea),get_prev_facet(sidea)) );
/* go around the other way */
sidea = fe;
while ( equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
{
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* edge */
sidea = fe_inverse(get_next_facet(sidea));
sidea = get_next_edge(sidea);
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
get_fe_side(sidea,z);
get_fe_side(get_prev_edge(sidea),y);
cross_prod(y,z,fnorm);
for ( i = 0 ; i < SDIM ; i++ ) norm[i] += fnorm[i];
}
/* orient */
onormalize:
if ( inverted(get_fe_facet(fe)) )
for ( i = 0 ; i < SDIM ; i++ ) norm[i] = -norm[i];
normalize:
if ( get_vattr(v_id) & CONSTRAINT )
{
conmap_t * conmap = get_v_constraint_map(v_id);
int oncount = 0,hitcount;
struct constraint *con[MAXCONPER];
int conlist[MAXCONPER];
REAL perp[MAXCOORD];
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
{
if ( conmap[j] & CON_HIT_BIT )
{ conlist[oncount] = conmap[j];
con[oncount++] = get_constraint(conmap[j]);
}
}
hitcount = constr_proj(TANGPROJ,oncount,con,get_coord(v_id),
norm,perp,conlist,DETECT,v_id);
if ( hitcount != oncount )
{ clear_v_constraint_status(v_id);
for ( j = 0 ; j < hitcount ; j++ )
set_v_constraint_status(v_id,conlist[j]);
}
for ( j = 0 ; j < SDIM ; j++ )
norm[j] -= perp[j];
}
size = sqrt(SDIM_dot(norm,norm));
if ( size <= 0.0 ) return 0.0;
for ( i = 0 ; i < SDIM ; i++ ) norm[i] /= size;
return size/web.simplex_factorial;
}
/***********************************************************
*
* Function: calc_vertex_smooth_normal
*
* Purpose: Calculate average normal of facets around a vertex
* for grapics normal interpolation. Only does the facets
* in the same face as given facet; will not cross
* multiple edges, or boundary or constraint edges
* when different from facet. Only uses first 3 dimensions.
* Does not project normal to constraints.
*
* Input: vertex id
* facet-edge id - with tail at vertex, for defining face
* norm - pointer to place for normal vector
*
*
* Output: Average normal, normalized to unit length.
*
* Return value: none.
*/
void calc_vertex_smooth_normal(v_id,fe,norm)
vertex_id v_id;
facetedge_id fe;
REAL *norm;
{
int i;
REAL y[MAXCOORD],z[MAXCOORD];
REAL fnorm[MAXCOORD];
facetedge_id sidea;
facet_id f_id = get_fe_facet(fe);
struct boundary *bdry; /* to check staying on same boundary */
REAL size;
/* check for string */
if ( web.representation != SOAPFILM )
{ kb_error(2208,"Internal error: Using calc_vertex_smooth_normal() on non-soapfilm surface.\n",
RECOVERABLE);
}
if ( !valid_id(fe) )
kb_error(2209,"Internal error: Invalid fe in calc_vertex_smooth_normal().\n",RECOVERABLE);
bdry = get_facet_boundary(f_id); /* original boundary */
get_facet_normal(f_id,norm); /* starter normal */
/* go around one way to edge of face */
sidea = fe;
for(;;)
{ edge_id e_id;
/* go to next facet */
sidea = get_prev_edge(sidea);
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* valence 1 */
if ( !equal_id(get_next_facet(sidea),get_prev_facet(sidea)) ) break;
e_id = get_fe_edge(sidea);
if ( !equal_constr(f_id,e_id) ) break;
if ( bdry != get_edge_boundary(e_id) ) break;
sidea = fe_inverse(get_next_facet(sidea));
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
if ( equal_id(sidea,fe) ) goto snormalize; /* went all the way around */
get_fe_side(sidea,z);
get_fe_side(get_prev_edge(sidea),y);
cross_prod(y,z,fnorm);
for ( i = 0 ; i < SDIM ; i++ ) norm[i] += fnorm[i]/2;
}
/* go around the other way */
sidea = fe;
while ( equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
{ edge_id e_id;
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* edge */
e_id = get_fe_edge(sidea);
if ( !equal_constr(f_id,e_id) ) break;
if ( bdry != get_edge_boundary(e_id) ) break;
sidea = fe_inverse(get_next_facet(sidea));
sidea = get_next_edge(sidea);
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
get_fe_side(sidea,z);
get_fe_side(get_prev_edge(sidea),y);
cross_prod(y,z,fnorm);
for ( i = 0 ; i < SDIM ; i++ ) norm[i] += fnorm[i]/2;
}
snormalize:
size = sqrt(SDIM_dot(norm,norm));
if ( size <= 0.0 ) return;
for ( i = 0 ; i < SDIM ; i++ ) norm[i] /= size;
}
/***************************************************************************
*
* function: lagrange_edge_normal()
*
* purpose: compute geometric normal space at a lagrange point of an edge.
*/
int lagrange_edge_normal ARGS((vertex_id,edge_id,REAL**));
int lagrange_edge_normal(v_id,e_id,norm)
vertex_id v_id;
edge_id e_id;
REAL **norm;
{
MAT2D(vx,MAXVCOUNT,MAXCOORD);
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
vertex_id *v = get_edge_vertices(e_id);
int k,m,i;
int ctrl = web.skel[EDGE].ctrlpts;
REAL tang[MAXCOORD],*t=tang;
get_edge_verts(e_id,vx,NULL);
for ( k = 0 ; k < ctrl ; k++ ) if ( v[k] == v_id ) break;
#ifdef VOLUMEGRAD
/* volume gradient */
norm[0] = norm[1] = 0.0;
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL y,dx;
for ( y = 0.0, dx = 0.0, j = 0 ; j < ctrl ; j++ )
{ y += gl->gpoly[m][j]*vx[j][1];
dx += gl->gpolypart[m][0][j]*vx[j][0];
}
norm[0] -= gl->gausswt[m]*y*gl->gpolypart[m][0][k];
norm[1] -= gl->gausswt[m]*dx*gl->gpoly[m][k];
}
#else
/* geometric normal */
for ( i = 0 ; i < SDIM ; i++ ) tang[i] = 0.0;
for ( m = 0 ; m < ctrl ; m++ )
{ REAL prime;
prime = gl->lpolypart[k][0][m];
for ( i = 0 ; i < SDIM ; i++ )
tang[i] += prime*vx[m][i];
}
return kernel_basis_rows(&t,norm,1,SDIM);
#endif
}
/***************************************************************************
*
* function: lagrange_facet_normal()
*
* purpose: compute geometric normal at a lagrange point of a facet.
*/
int lagrange_facet_normal ARGS((vertex_id,facet_id,REAL**));
int lagrange_facet_normal(v_id,f_id, norm)
vertex_id v_id;
facet_id f_id;
REAL **norm;
{
vertex_id *v = get_facet_vertices(f_id);
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
MAT2D(sides,MAXCOORD,MAXCOORD);
MAT2D(vx,MAXVCOUNT,MAXCOORD);
int ctrl = web.skel[FACET].ctrlpts;
int i,j,k,kk;
get_facet_verts(f_id,vx,NULL);
for ( k = 0 ; k < ctrl ; k++ ) if ( v[k] == v_id ) break;
if ( k >= ctrl )
{ sprintf(errmsg,
"Internal error: Can't find vertex %s in facet %s.\n",ELNAME(v_id),
ELNAME1(f_id));
kb_error(2210,errmsg,RECOVERABLE);
}
for ( j = 0 ; j < SDIM ; j++ ) sides[0][j] = 0.0;
for ( i = 1 ; i <= web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( kk = 0, sides[i][j] = 0.0 ; kk < ctrl ; kk++ )
sides[i][j] += gl->lpolypart[k][i-1][kk]*vx[kk][j];
if ( inverted(f_id) )
for ( j = 0 ; j < SDIM ; j++ ) sides[1][j] = -sides[1][j];
return kernel_basis_rows(sides+1,norm,web.dimension,SDIM);
}
/***************************************************************************
*
* function: quadratic_edge_normal()
*
* purpose: compute geometric normal space at a point of a quadratic edge.
*/
REAL quad_tang_coeffs[3][3] = { { -1.5,2.0,-0.5},
{-0.5,0.0,0.5},{ 0.5,-2.0,1.5}};
int quadratic_edge_normal ARGS((vertex_id,edge_id,REAL**));
int quadratic_edge_normal(v_id,e_id,norm)
vertex_id v_id;
edge_id e_id;
REAL **norm;
{
MAT2D(vx,MAXVCOUNT,MAXCOORD);
vertex_id *v = get_edge_vertices(e_id);
int k,m,i;
int ctrl = web.skel[EDGE].ctrlpts; /* should be 3 */
REAL tang[MAXCOORD],*t=tang;
get_edge_verts(e_id,vx,NULL); /* has midv in vx[1] */
for ( k = 0 ; k < ctrl ; k++ ) if ( v[k] == v_id ) break;
if ( k != 0 ) k = 3 - k; /* switch vertices 1 and 2 compared to lagrange */
/* geometric normal */
for ( i = 0 ; i < SDIM ; i++ ) tang[i] = 0.0;
for ( m = 0 ; m < ctrl ; m++ )
{ REAL prime;
prime = quad_tang_coeffs[k][m];
for ( i = 0 ; i < SDIM ; i++ )
tang[i] += prime*vx[m][i];
}
return kernel_basis_rows(&t,norm,1,SDIM);
}
/***************************************************************************
*
* function: quadratic_facet_normal()
*
* purpose: compute geometric normal at a lagrange point of a facet.
*/
int qlconvert[6] = { 0, 1, 2, 4, 5, 3}; /* index conversion */
int lqconvert[6] = { 0, 1, 2, 5, 3, 4}; /* index conversion */
int quadratic_facet_normal ARGS((vertex_id,facet_id,REAL**));
int quadratic_facet_normal(v_id,f_id, norm)
vertex_id v_id;
facet_id f_id;
REAL **norm;
{
vertex_id v[6];
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
MAT2D(sides,MAXCOORD,MAXCOORD);
MAT2D(vx,MAXVCOUNT,MAXCOORD);
int ctrl = web.skel[FACET].ctrlpts;
int i,j,k,kk;
facetedge_id fe_id;
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ v[qlconvert[2*i]] = get_fe_tailv(fe_id);
v[qlconvert[2*i+1]] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_id,vx,NULL);
for ( k = 0 ; k < ctrl ; k++ ) if ( v[k] == v_id ) break;
if ( k >= ctrl )
{ sprintf(errmsg,"Internal error: Can't find vertex %s in facet %s.\n",
ELNAME(v_id), ELNAME1(f_id));
kb_error(2211,errmsg,RECOVERABLE);
}
for ( j = 0 ; j < SDIM ; j++ ) sides[0][j] = 0.0;
for ( i = 1 ; i <= web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( kk = 0, sides[i][j] = 0.0 ; kk < ctrl ; kk++ )
sides[i][j] += gl->lpolypart[k][i-1][kk]*vx[lqconvert[kk]][j];
return kernel_basis_rows(sides+1,norm,web.dimension,SDIM);
}
/***********************************************************
*
* Function: new_calc_vertex_normal
*
* Purpose: Calculate subspace normal to surface for purposes
* of Hessian normal or normal motion. Normal space
* is essentially that spanned by the volume normals
* of all adjacent bodies. Idea is to rule out
* purely tangential motions.
*
* Input: vertex id
* norm - pointer to place for normal basis
*
*
* Output: Basis for normal space if not full dimension
* Return value: Dimension of normal
*/
int new_calc_vertex_normal(v_id,norm)
vertex_id v_id;
REAL **norm; /* returned basis */
{
int i,j,kk;
REAL y[MAXCOORD],z[MAXCOORD];
MAT2D(fnorm,MAXCOORD,MAXCOORD);
MAT2D(a,2,MAXCOORD);
facetedge_id sidea,sideb,ffe;
struct boundary *bdry; /* to check staying on same boundary */
REAL size;
int retval = 0;
facetedge_id fe;
int valence,bares=0,singles=0,doubles=0,triples=0,bareflag=0;
int vattr;
if (web.representation == SIMPLEX ) return simplex_vertex_normal(v_id,norm);
vattr = get_vattr(v_id);
if ( hessian_special_normal_flag )
{
REAL *x = get_coord(v_id);
for ( i = 0 ; i < SDIM ; i++ )
norm[0][i] = eval(hessian_special_normal_expr+i,x,v_id,NULL);
size = sqrt(SDIM_dot(norm[0],norm[0]));
if ( size == 0.0 )
{ sprintf(errmsg, "hessian_special_normal_vector is zero at vertex %s.\n",
ELNAME(v_id));
kb_error(2212,errmsg,RECOVERABLE);
}
for ( i = 0 ; i < SDIM ; i++ ) norm[0][i] = norm[0][i]/size;
return 1; /* one-dimensional normal only */
}
if ( hessian_normal_one_flag )
{ MAT2D(mat,MAXCOORD,MAXCOORD);
facet_id f_id;
edge_id e_id, starte;
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
mat[i][j] = 0.0;
if ( web.representation == SOAPFILM )
{ facetedge_id fe_id,startfe;
fe_id = startfe = get_vertex_first_facet(v_id);
do
{ f_id = get_fe_facet(fe_id);
get_facet_normal(f_id,fnorm[0]);
size = SDIM_dot(fnorm[0],fnorm[0]);
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
mat[i][j] += fnorm[0][i]*fnorm[0][j]/size;
fe_id = get_next_vertex_facet(v_id,fe_id);
} while ( !equal_element(fe_id,startfe) );
}
else if ( web.representation == STRING )
{
e_id = starte = get_vertex_edge(v_id);
do
{ get_edge_side(e_id,fnorm[0]);
mat[0][0] += fnorm[0][1]*fnorm[0][1];
mat[0][1] -= fnorm[0][1]*fnorm[0][0];
mat[1][0] -= fnorm[0][0]*fnorm[0][1];
mat[1][1] += fnorm[0][0]*fnorm[0][0];
e_id = get_next_tail_edge(e_id);
} while ( !equal_element(e_id,starte) );
}
/* find eigenvector */
for ( kk = 0 ; kk < 10 ; kk++ )
{ matvec_mul(mat,fnorm[0],y,SDIM,SDIM);
matvec_mul(mat,y,fnorm[0],SDIM,SDIM);
}
size = sqrt(SDIM_dot(fnorm[0],fnorm[0]));
for ( i = 0 ; i < SDIM ; i++ ) norm[0][i] = fnorm[0][i]/size;
return 1;
} /* end hessian_normal_one_flag */
if ( vattr & Q_MIDFACET )
{ /* Lagrange model */
facet_id f_id = get_vertex_facet(v_id);
retval = lagrange_facet_normal(v_id,f_id,norm);
goto ncn_exit;
}
/* Want to check for bare edges in SOAPFILM model */
/* so can handle same way as string edges */
if ( web.representation == SOAPFILM )
{ edge_id e_id,start_e;
e_id = get_vertex_edge(v_id);
if ( !valid_id(e_id) ) goto full_dim; /* bare point */
start_e = e_id;
do
{ valence = get_edge_valence(e_id);
if ( valence == 0 ) bares++;
if ( valence == 1 ) singles++;
if ( valence == 2 ) doubles++;
if ( valence >= 3 ) triples++;
if ( vattr & (Q_MIDPOINT|Q_MIDEDGE) ) break;
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(e_id,start_e) );
if ( triples >= SDIM ) goto full_dim;
if ( singles >= SDIM ) goto full_dim;
if ( bares >= SDIM ) goto full_dim;
if ( bares && (singles+doubles+triples) ) goto full_dim;
if ( triples >= 1 )
{ if ( vattr & (Q_MIDPOINT|Q_MIDEDGE) ) bareflag = 1; /* effectively */
else goto tripletest;
}
if ( (singles==0) && (doubles==0) )
bareflag = 1;
}
if ( (vattr & Q_MIDEDGE) && (bareflag || (web.representation == STRING)) )
{
edge_id e_id = get_vertex_edge(v_id);
retval = lagrange_edge_normal(v_id,e_id,norm);
goto ncn_exit;
}
if ( (vattr & Q_MIDPOINT) && (bareflag || (web.representation == STRING)) )
{
edge_id e_id = get_vertex_edge(v_id);
retval = quadratic_edge_normal(v_id,e_id,norm);
goto ncn_exit;
}
/* check for string */
if ( web.representation == STRING )
{ /* Must be endpoint of string edge */
edge_id e_id,ee_id,eee_id;
e_id = get_vertex_edge(v_id);
if ( !valid_id(e_id) ) goto full_dim;
ee_id = get_next_tail_edge(e_id);
eee_id = get_next_tail_edge(ee_id);
if ( !equal_id(e_id,eee_id) )
goto full_dim; /* triple vertex at least */
if ( (web.modeltype == LAGRANGE) && (web.lagrange_order >= 2) )
retval = lagrange_edge_normal(v_id,e_id,norm);
else if ( web.modeltype == QUADRATIC )
{ MAT2D(vx,3,MAXCOORD);
REAL *t = y;
get_edge_verts(e_id,vx,NULL);
for ( i = 0 ; i < SDIM ; i++ )
y[i] = -1.5*vx[0][i] + 2*vx[1][i] - 0.5*vx[2][i];
retval = kernel_basis_rows(&t,norm,1,SDIM);
}
else
{ REAL *t = y;
get_edge_side(e_id,y);
if ( !equal_id(e_id,ee_id ) )
{ get_edge_side(ee_id,z);
for ( i = 0 ; i < SDIM ; i++ ) y[i] -= z[i];
}
retval = kernel_basis_rows(&t,norm,1,SDIM);
}
if ( inverted(e_id) )
for ( i = 0 ; i < SDIM ; i++ ) norm[0][i] = -norm[0][i];
goto ncn_exit;
}
/* now have 2D facet */
fe = get_vertex_fe(v_id);
if ( !valid_id(fe) )
goto full_dim;
bdry = get_facet_boundary(get_fe_facet(fe)); /* original boundary */
sidea = fe;
if ( vattr & Q_MIDPOINT )
{ /* quadratic model */
/* already tested for bare or triple edges, so one or two facets */
/* If two, combine normals */
MAT2D(norm2,MAXCOORD,MAXCOORD);
facet_id f_id = get_fe_facet(sidea);
if ( inverted(f_id) )
sidea = inverse_id(sidea);
if ( !equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
goto tripletest;
retval = quadratic_facet_normal(v_id,get_fe_facet(sidea),norm);
sideb = get_next_facet(sidea);
if ( equal_id(sidea,sideb) ) goto ncn_exit;
sideb = inverse_id(sideb);
retval = quadratic_facet_normal(v_id,get_fe_facet(sideb),norm2);
for ( i = 0 ; i < retval ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
norm[i][j] += norm2[i][j];
goto ncn_exit;
}
if ( vattr & Q_MIDEDGE )
{ /* Lagrange model */
MAT2D(norm2,MAXCOORD,MAXCOORD);
facet_id f_id = get_fe_facet(sidea);
if ( inverted(f_id) )
sidea = inverse_id(sidea);
if ( !equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
goto tripletest;
retval = lagrange_facet_normal(v_id,get_fe_facet(sidea),norm);
sideb = get_next_facet(sidea);
if ( equal_id(sidea,sideb) ) goto ncn_exit;
sideb = inverse_id(sideb);
retval = lagrange_facet_normal(v_id,get_fe_facet(sideb),norm2);
for ( i = 0 ; i < retval ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
norm[i][j] += norm2[i][j];
goto ncn_exit;
}
/* usual case of facet in N dim */
/* if get here, know no triple lines */
{ for ( j = 0 ; j < SDIM ; j++ )
for ( i = 0 ; i < SDIM ; i++ ) norm[j][i] = 0.0;
/* go around one way to edge of face */
do
{
if ( vattr & AXIAL_POINT )
{ get_fe_side(sidea,z);
get_fe_side(get_next_edge(sidea),y);
cross_prod(y,z,fnorm[1]);
retval = 1;
}
else
{
switch ( web.modeltype )
{ case LINEAR:
get_fe_side(sidea,a[0]);
get_fe_side(inverse_id(get_prev_edge(sidea)),a[1]);
if ( SDIM == 3 )
{ cross_prod(a[0],a[1],fnorm[0]);
retval = 1;
}
else
retval = kernel_basis_rows(a,fnorm,2,SDIM);
break;
case QUADRATIC:
retval = quadratic_facet_normal(v_id,get_fe_facet(sidea),fnorm);
break;
case LAGRANGE:
retval = lagrange_facet_normal(v_id,get_fe_facet(sidea),fnorm);
break;
}
}
for ( j = 0 ; j < retval ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
norm[j][i] += fnorm[j][i];
/* go to next facet */
sidea = get_prev_edge(sidea);
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* edge */
sidea = fe_inverse(get_next_facet(sidea));
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
if ( equal_id(sidea,fe) )
{ if ( inverted(get_fe_facet(sidea)) )
for ( i = 0 ; i < SDIM ; i++ ) norm[0][i] = -norm[0][i];
goto ncn_exit; /* went all the way around */
}
}
while ( equal_id(get_next_facet(sidea),get_prev_facet(sidea)) );
}
/* go around the other way */
sidea = fe;
while ( equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
{
if ( equal_id(sidea,get_next_facet(sidea)) ) break; /* edge */
sidea = fe_inverse(get_next_facet(sidea));
sidea = get_next_edge(sidea);
if ( bdry != get_facet_boundary(get_fe_facet(sidea)) ) break;
get_fe_side(sidea,z);
if ( get_vattr(v_id) & AXIAL_POINT )
{ REAL *u = fnorm[0];
switch ( web.modeltype )
{ case LINEAR: get_fe_side(get_next_edge(sidea),y);
cross_prod(y,z,fnorm[0]); break;
case QUADRATIC:
quadratic_facet_normal(v_id,get_fe_facet(sidea),&u);
break;
case LAGRANGE:
lagrange_facet_normal(v_id,get_fe_facet(sidea),&u);
break;
}
}
else
{
switch ( web.modeltype )
{ case LINEAR:
get_fe_side(sidea,a[0]);
get_fe_side(inverse_id(get_prev_edge(sidea)),a[1]);
if ( SDIM == 3 )
{ cross_prod(a[0],a[1],fnorm[0]);
retval = 1;
}
else
retval = kernel_basis_rows(a,fnorm,2,SDIM);
break;
case QUADRATIC:
retval = quadratic_facet_normal(v_id,get_fe_facet(sidea),fnorm);
break;
case LAGRANGE:
retval = lagrange_facet_normal(v_id,get_fe_facet(sidea),fnorm);
break;
}
}
for ( j = 0 ; j < retval ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
norm[j][i] += fnorm[j][i];
}
if ( !equal_id(get_next_facet(sidea),get_prev_facet(sidea)) )
goto tripletest;
if( inverted(get_fe_facet(sidea)) )
for ( i = 0 ; i < SDIM ; i++ ) norm[0][i] = -norm[0][i];
goto ncn_exit;
tripletest:
/* if get here, know there are one or two triple edges into vertex */
{ /* triple line */
REAL *t = fnorm[0];
int triple_count = 0;
facetedge_id start_e;
edge_id e_id;
for ( i = 0 ; i < SDIM ; i++ ) fnorm[0][i] = 0.;
start_e = e_id = get_vertex_edge(v_id);
do
{ int valence = get_edge_valence(e_id);
if ( valence >= 3 )
{ if ( web.modeltype==QUADRATIC )
{ retval = quadratic_edge_normal(v_id,e_id,norm);
goto ncn_exit; /* lazy; just use first triple */
}
if ( web.modeltype==LAGRANGE )
{ retval = lagrange_edge_normal(v_id,e_id,norm);
goto ncn_exit; /* lazy; just use first triple */
}
/* accumulate tangents */
ffe = get_edge_fe(e_id);
if ( !equal_id(get_next_facet(ffe),get_prev_facet(ffe)) )
{ /* triple again */
triple_count++;
get_fe_side(ffe,z);
switch ( triple_count )
{ case 1:
for ( i = 0 ; i < SDIM ; i++ ) fnorm[0][i] += z[i]; break;
case 2:
for ( i = 0 ; i < SDIM ; i++ ) fnorm[0][i] -= z[i]; break;
default: goto full_dim; /* more than 2 */
}
}
}
e_id = get_next_tail_edge(e_id);
} while ( !equal_element(start_e,e_id) );
retval = kernel_basis_rows(&t,norm,1,SDIM);
}
goto ncn_exit;
ncn_exit:
return retval;
full_dim:
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ )
norm[i][j] = 0.0;
norm[i][i] = 1.0;
}
return SDIM;
}
/*************************************************************************
*
* Function: project_vertex_normals()
*
* Purpose: Take incoming normal basis, project to constraints,
* and orthonormalize. Meant to be called after
* new_calc_vertex_normal().
*
* Return: Number of independent basis vectors.
* Basis vectors altered in place.
*/
int project_vertex_normals(v_id,normals,normcount)
vertex_id v_id;
REAL **normals;
int normcount;
{ conmap_t *conmap;
int oncount;
MAT2D(grads,MAXCOORD,MAXCOORD);
MAT2D(pp,MAXCOORD,MAXCOORD);
MAT2D(qq,MAXCOORD,MAXCOORD);
REAL dummy;
int i,j,n;
conmap = get_v_constraint_map(v_id);
oncount = 0;
if ( conmap[0] )
{ /* calculate projection matrix to fewer degrees of freedom */
for ( j = 1; j <= (int)conmap[0] ; j++ )
{ struct constraint *constr;
if ( !(conmap[j] & CON_HIT_BIT) ) continue;
constr = get_constraint(conmap[j]);
eval_all(constr->formula,get_coord(v_id),SDIM,
&dummy, grads[oncount],v_id);
oncount++;
}
if ( oncount > 0 )
{
/* project basis to constraints */
oncount = gram_schmidt(grads,oncount,SDIM);
mat_mul_tr(grads,normals,qq,oncount,SDIM,normcount);
tr_mat_mul(grads,qq,pp,oncount,SDIM,normcount);
for ( j = 0 ; j < normcount ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
normals[j][i] -= pp[i][j];
}
/* orthonormalize */
for ( i = 0 ; i < normcount ; i++ )
{ /* subtract previous components */
REAL sum;
for ( j = 0 ; j < i ; j++ )
{ sum = dot(normals[i],normals[j],SDIM);
for ( n = 0 ; n < SDIM ; n++ )
normals[i][n] -= sum*normals[j][n];
}
/* normalize */
sum = dot(normals[i],normals[i],SDIM);
sum = sqrt(sum);
if ( sum > hessian_epsilon )
for ( n = 0 ; n < SDIM ; n++ ) normals[i][n] /= sum;
else /* have to skip this direction */
{ for ( n = 0 ; n < SDIM ; n++ )
normals[i][n] = normals[normcount-1][n];
normcount--;
i--;
}
}
}
return normcount;
}
/***************************************************************
*
* Function: get_facet_normal()
*
* Purpose: find facet normal (length = area).
* 3D only
*
*/
void get_facet_normal(f_id,normal)
facet_id f_id;
REAL *normal;
{ facetedge_id fe;
REAL side1[MAXCOORD],side2[MAXCOORD];
int i;
if ( web.representation == SIMPLEX )
kb_error(1368,"Internal error: Trying to take normal in simplex model.\n",
RECOVERABLE);
if ( web.modeltype == LINEAR ) /* better for strange symmetries */
{ MAT2D(x,FACET_VERTS,MAXCOORD);
get_facet_verts(f_id,x,NULL); /* in tail order */
for ( i = 0 ; i < SDIM ; i++ )
{ side1[i] = x[1][i] - x[0][i];
side2[i] = x[2][i] - x[1][i];
}
}
else
{ fe = get_facet_fe(f_id);
get_edge_side(get_fe_edge(fe),side1);
fe = get_next_edge(fe);
get_edge_side(get_fe_edge(fe),side2);
}
cross_prod(side1,side2,normal);
for ( i = 0 ; i < SDIM ; i++ )
normal[i] /= 2; /* triangle factor */
}
#ifdef NEWFACETNORMAL
attempt to do normal at arbitrary point in facet. Incomplete
/***************************************************************
*
* Function: new_get_facet_normal()
*
* Purpose: find facet normal (length = area).
* Any dimension, linear, quadratic, or Lagrange model.
* Needs barycentric coords for quadratic or Lagrange.
*
*/
void new_get_facet_normal(f_id,normal,b)
facet_id f_id;
REAL *normal;
REAL *b; /* barycentric coords */
{ facetedge_id fe;
MAT2D(x,MAXCOORD+1,MAXCOORD);
int i;
int m;
MAT2D(sides,MAXCOORD,MAXCOORD);
normal[i] /= 2; /* triangle factor */
if ( web.modeltype == LINEAR )
{
get_facet_verts(f_id,x,NULL); /* in tail order */
/* fan of sides from v0 */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
sides[i][j] = x[i+1][j] - x[0][j];
kernel_basis_rows(sides,&normal,web.dimension,SDIM);
}
else if ( web.modeltype == QUADRATIC )
{
get_facet_verts(f_id,x,NULL); /* in tail order */
/* tangents at point */
mat_mult(gpolypartial[m],x,sides,web.dimension,FACET_CTRL,SDIM);
kernel_basis_rows(sides,&normal,web.dimension,SDIM);
}
else if ( web.modeltype == LAGRANGE )
{
int ctrl = web.skel[FACET].ctrlpts;
int dim = web.dimension;
struct gauss_lag *gl = &gauss_lagrange[dim][web.gauss2D_order];
get_facet_verts(f_id,x,NULL);
/* tangent vectors at gauss points */
mat_mult(gl->gpolypart[m],x,sides,dim,ctrl,SDIM);
kernel_basis_rows(sides,&normal,web.dimension,SDIM);
}
}
#endif
/***************************************************************
*
* Function: get_edge_verts()
*
* Purpose: to get all vertices of an edge, nicely
* displaced relative to first vertex of edge in case of symmetry gp
* NOTE: Quadratic model: midv in verts[1]
*
*/
void get_edge_verts(e_id,verts,wraps)
edge_id e_id;
REAL **verts; /* third spot NULL if don't want midpts in quadratic */
WRAPTYPE *wraps; /* wraps of vertices; NULL if not wanted */
{
int j,k;
WRAPTYPE wrap = 0;
REAL *x;
if ( web.representation == SIMPLEX )
kb_error(1369,"Internal error: Can't do get_edge_verts for simplex model.\n",RECOVERABLE);
if ( web.modeltype == LAGRANGE )
{ vertex_id *v = get_edge_vertices(e_id);
int n = web.skel[EDGE].ctrlpts;
if ( web.symmetry_flag )
{
wrap = get_edge_wrap(e_id);
}
for ( j = 0 ; j < n ; j++ )
{ x = get_coord(v[j]);
if ( wrap && (j > 0) && (inverted(e_id) || (j==n-1)))
(*sym_wrap)(x,verts[j],wrap);
else
for ( k = 0 ; k < SDIM ; k++ )
verts[j][k] = x[k];
}
return;
}
if ( web.symmetry_flag )
{
x = get_coord(get_edge_tailv(e_id));
for ( j = 0 ; j < SDIM ; j++ ) verts[0][j] = x[j];
wrap = get_edge_wrap(e_id);
if ( (web.modeltype == QUADRATIC) && verts[2] )
{ if ( wraps ){wraps[0] = 0; wraps[2] = wrap; }
x = get_coord(get_edge_headv(e_id));
(*sym_wrap)(x,verts[2],wrap);
x = get_coord(get_edge_midv(e_id));
if ( inverted(e_id) )
{ if ( wraps ) wraps[1] = wrap;
(*sym_wrap)(x,verts[1],wrap);
}
else
{ for ( j = 0 ; j < SDIM ; j++ ) verts[1][j] = x[j];
if ( wraps ) wraps[1] = 0;
}
}
else
{ if ( wraps ){wraps[0] = 0; wraps[1] = wrap; }
x = get_coord(get_edge_headv(e_id));
(*sym_wrap)(x,verts[1],wrap);
}
}
else
{ x = get_coord(get_edge_tailv(e_id));
for ( j = 0 ; j < SDIM ; j++ ) verts[0][j] = x[j];
x = get_coord(get_edge_headv(e_id));
if ( (web.modeltype == QUADRATIC) && verts[2] )
{ for ( j = 0 ; j < SDIM ; j++ ) verts[2][j] = x[j];
x = get_coord(get_edge_midv(e_id));
for ( j = 0 ; j < SDIM ; j++ ) verts[1][j] = x[j];
}
else
for ( j = 0 ; j < SDIM ; j++ ) verts[1][j] = x[j];
}
}
/***************************************************************
*
* Function: get_facet_verts()
*
* Purpose: to get all three vertices of a facet, nicely
* displaced relative to first vertex of facet in case of symmetry gp
*
*/
void get_facet_verts(f_id,verts,wraps)
facet_id f_id;
REAL **verts; /* fourth spot NULL if don't want midpts in quadratic */
WRAPTYPE *wraps; /* wraps of vertices; NULL if not wanted */
{
facetedge_id fe;
int i,j;
WRAPTYPE wrap,fewrap;
REAL *x;
if ( web.modeltype == LAGRANGE )
{ vertex_id *v = get_facet_vertices(f_id);
int ctrlpts = web.skel[FACET].ctrlpts;
int n = web.lagrange_order;
f_id = positive_id(f_id); /* since vertices in particular order */
for ( i = 0 ; i < ctrlpts ; i++ )
{
x = get_coord(v[i]);
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
}
if ( web.symmetry_flag )
{
if ( wraps )
for ( j = 0 ; j < ctrlpts ; j++ ) wraps[j] = 0;
/* gotta go through the 3 edges */
/* first edge */
fe = get_facet_fe(f_id);
wrap = get_fe_wrap(fe);
if ( wrap && inverted(get_fe_edge(fe)) )
for ( j = 1 ; j < n ; j++ )
{ (*sym_wrap)(get_coord(v[j]),verts[j],wrap);
if ( wraps ) wraps[j] = wrap;
}
if ( wrap )
{ (*sym_wrap)(get_coord(v[n]),verts[n],wrap);
if ( wraps ) wraps[n] = wrap ;
}
/* second edge */
fe = get_next_edge(fe);
if ( wrap && !inverted(get_fe_edge(fe)) )
for ( j = 1 ; j < n ; j++ )
{ int m = n*(j+1) - j*(j-1)/2;
(*sym_wrap)(get_coord(v[m]),verts[m],wrap);
if ( wraps ) wraps[m] = wrap;
}
fewrap = get_fe_wrap(fe);
wrap = (*sym_compose)(wrap,fewrap);
if ( wrap && inverted(get_fe_edge(fe)) )
for ( j = 1 ; j < n ; j++ )
{ int m = n*(j+1) - j*(j-1)/2;
(*sym_wrap)(get_coord(v[m]),verts[m],wrap);
if ( wraps ) wraps[m] = wrap;
}
if ( wrap )
{ int m = n*(n+3)/2;
(*sym_wrap)(get_coord(v[m]),verts[m],wrap);
if ( wraps ) wraps[m] = wrap;
}
/* third edge */
fe = get_next_edge(fe);
if ( wrap && !inverted(get_fe_edge(fe)) )
for ( j = 1 ; j < n ; j++ )
{ int m = n*j + j*(3-j)/2;
(*sym_wrap)(get_coord(v[m]),verts[m],wrap);
if ( wraps ) wraps[m] = wrap;
}
fewrap = get_fe_wrap(fe);
wrap = (*sym_compose)(wrap,fewrap);
if ( wrap && inverted(get_fe_edge(fe)) )
for ( j = 1 ; j < n ; j++ )
{ int m = n*j + j*(3-j)/2;
(*sym_wrap)(get_coord(v[m]),verts[m],wrap);
if ( wraps ) wraps[m] = wrap;
}
}
return;
}
if ( (web.modeltype == QUADRATIC) && verts[3] )
{ get_facet_verts_q(f_id,verts,wraps); return; }
if ( web.representation == SIMPLEX )
{ vertex_id *v = get_facet_vertices(f_id);
for ( i = 0 ; i <= web.dimension ; i++ )
{ x = get_coord(v[i]);
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
}
return;
}
fe = get_facet_fe(f_id);
if ( web.symmetry_flag )
{ wrap = 0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
x = get_coord(get_fe_tailv(fe));
if ( wraps ) wraps[i] = wrap;
(*sym_wrap)(x,verts[i],wrap);
fewrap = get_fe_wrap(fe);
wrap = (*sym_compose)(wrap,fewrap);
fe = get_next_edge(fe);
}
}
else for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vertex_id v_id = get_fe_tailv(fe);
x = get_coord(v_id);
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
fe = get_next_edge(fe);
}
}
/***************************************************************
*
* Function: get_facet_verts_special()
*
* Purpose: to get all three vertices of a facet, nicely
* displaced to fundamental cell in case of symmetry group.
* Extra work to get them to come out close to origin.
*
*/
void get_facet_verts_special(f_id,verts,wraps)
facet_id f_id;
REAL **verts; /* fourth spot NULL if don't want midpts in quadratic */
WRAPTYPE *wraps; /* wraps of vertices; NULL if not wanted */
{
facetedge_id fe;
int i,j,ii;
WRAPTYPE wrap,fewrap;
REAL *x;
if ( web.modeltype == LAGRANGE )
{ vertex_id *v = get_facet_vertices(f_id);
int k = web.skel[FACET].ctrlpts;
for ( i = 0 ; i < k ; i++ )
{ x = get_coord(v[i]);
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
}
return;
}
if ( (web.modeltype == QUADRATIC) && verts[3] )
{ get_facet_verts_q(f_id,verts,wraps); return; }
if ( web.representation == SIMPLEX )
{ vertex_id *v = get_facet_vertices(f_id);
for ( i = 0 ; i <= web.dimension ; i++ )
{ x = get_coord(v[i]);
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
}
return;
}
fe = get_facet_fe(f_id);
if ( web.symmetry_flag )
{
/* start with point closest to origin */
if ( !(sym_flags & HAS_FIXED_PTS) )
{ REAL dd,mindd;
int mini=0;
facetedge_id minfe=fe;
mindd = 1e40;
for ( i = 0 ; i < FACET_VERTS ; i++, fe = get_next_edge(fe) )
{ x = get_coord(get_fe_tailv(fe));
dd = SDIM_dot(x,x);
if ( dd < 0.9*mindd ) { mindd = dd; mini = i; minfe = fe;}
}
i = mini;
fe = minfe;
}
else { i = 0; }
wrap = 0;
for ( ii = 0 ; ii < FACET_VERTS ; ii++ )
{ int jj = (i+ii)%FACET_VERTS;
x = get_coord(get_fe_tailv(fe));
if ( wraps ) wraps[jj] = wrap;
(*sym_wrap)(x,verts[jj],wrap);
fewrap = get_fe_wrap(fe);
wrap = (*sym_compose)(wrap,fewrap);
fe = get_next_edge(fe);
}
}
else for ( i = 0 ; i < FACET_VERTS ; i++ )
{ x = get_coord(get_fe_tailv(fe));
for ( j = 0 ; j < SDIM ; j++ )
verts[i][j] = x[j];
fe = get_next_edge(fe);
}
}
/***************************************************************
*
* Function: get_facet_verts_q()
*
* Purpose: to get all vertices of a facet, nicely
* displaced to fundamental cell in case of symmetry group.
* Quadratic model. Midpoints interleaved with corners.
*
*/
void get_facet_verts_q(f_id,verts,wraps)
facet_id f_id;
REAL **verts;
WRAPTYPE *wraps; /* NULL if not wanted */
{
facetedge_id fe;
int i,j,ii;
WRAPTYPE wrap,fewrap;
REAL *x;
if ( web.representation == SIMPLEX )
{ kb_error(1370,"No quadratic model with simplices.\n",RECOVERABLE);
}
fe = get_facet_fe(f_id);
if ( web.symmetry_flag )
{
i = 0;
wrap = 0;
for ( ii = 0 ; ii < FACET_VERTS ; ii++ )
{ int jj = (i+ii)%FACET_VERTS;
x = get_coord(get_fe_tailv(fe));
if ( wraps ) wraps[2*jj] = wrap;
(*sym_wrap)(x,verts[2*jj],wrap);
x = get_coord(get_fe_midv(fe));
if ( !inverted(get_fe_edge(fe)) )
{ if ( wraps ) wraps[2*jj+1] = wrap;
(*sym_wrap)(x,verts[2*jj+1],wrap);
}
fewrap = get_fe_wrap(fe);
wrap = (*sym_compose)(wrap,fewrap);
if ( inverted(get_fe_edge(fe)) )
{ if ( wraps ) wraps[2*jj+1] = wrap;
(*sym_wrap)(x,verts[2*jj+1],wrap);
}
fe = get_next_edge(fe);
}
}
else for ( i = 0 ; i < FACET_VERTS ; i++ )
{ x = get_coord(get_fe_tailv(fe));
for ( j = 0 ; j < SDIM ; j++ )
verts[2*i][j] = x[j];
x = get_coord(get_fe_midv(fe));
for ( j = 0 ; j < SDIM ; j++ )
verts[2*i+1][j] = x[j];
fe = get_next_edge(fe);
}
}
/*****************************************************************
*
* Function: path_open()
*
* Purpose: Open file for reading on EVOLVERPATH
*/
#ifdef __WIN32__
FILE *path_open(char *name,int mode) /* else TC++ has conniptions */
#else
FILE *path_open(name,mode)
char *name;
int mode; /* NOTDATAFILENAME or SETDATAFILENAME */
#endif
{
char path[PATHSIZE];
size_t len;
FILE *fd = NULL;
char *env;
#ifdef MPI_EVOLVER
/* use filename as format string to generate various file names */
char taskpath[PATHSIZE];
sprintf(taskpath,name,this_task);
name = taskpath;
#endif
env = getenv("EVOLVERPATH");
#if defined(WIN32) && !defined(__BORLANDC__)
/* Using wildcards! */
/* try given name */
strncpy(path,name,sizeof(path));
for(;;)
{ /* try paths in EVOLVERPATH */
intptr_t ret;
struct _finddata_t finddata;
ret = _findfirst(path,&finddata);
if ( ret != -1 )
{ /* finddata.name only has filename, not path stuff */
char *slash = strrchr(path,'/');
if ( !slash ) slash = strrchr(path,'\\');
if ( slash ) slash++;
else slash = path;
strncpy(slash,finddata.name,sizeof(path)-(slash-path));
fd = fopen(path,"r");
_findclose(ret);
break;
}
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
/* try .fe extension */
if ( fd == NULL)
{
env = getenv("EVOLVERPATH");
strncpy(path,name,sizeof(path));
strcat(path,".fe");
for ( ;; )
{
intptr_t ret;
struct _finddata_t finddata;
ret = _findfirst(path,&finddata);
if ( ret != -1 )
{ char *slash = strrchr(path,'/');
if ( !slash ) slash = strrchr(path,'\\');
if ( slash ) slash++;
else slash = path;
strncpy(slash,finddata.name,sizeof(path)-(slash-path));
fd = fopen(path,"r");
_findclose(ret);
/* scrape the ".fe" off the end of the path since user didn't give it */
path[strlen(path)-3] = 0;
break;
}
/* try paths in EVOLVERPATH */
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
strcat(path,".fe");
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
}
#elif defined(_GLOB_H)
/* Using wildcards! */
/* try given name */
strncpy(path,name,sizeof(path));
for(;;)
{ /* try paths in EVOLVERPATH */
int ret;
glob_t globdata;
memset(&globdata,0,sizeof(globdata));
ret = glob(path,0,NULL,&globdata);
if ( ret == 0 ) /* success */
{
strncpy(path,globdata.gl_pathv[0],sizeof(path));
fd = fopen(path,"r");
globfree(&globdata);
break;
}
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
/* try .fe extension */
if ( fd == NULL)
{
env = getenv("EVOLVERPATH");
strncpy(path,name,sizeof(path));
strcat(path,".fe");
for ( ;; )
{ glob_t globdata;
int ret;
ret = glob(path,0,NULL,&globdata);
if ( ret == 0 ) /* success */
{
strncpy(path,globdata.gl_pathv[0],sizeof(path));
fd = fopen(path,"r");
globfree(&globdata);
/* scrape the ".fe" off the end of the path since user didn't give it */
path[strlen(path)-3] = 0;
break;
}
/* try paths in EVOLVERPATH */
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
strcat(path,".fe");
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
}
#else
/* try given name */
strncpy(path,name,sizeof(path));
while ( (fd = fopen(path,"r")) == NULL)
{ /* try paths in EVOLVERPATH */
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
/* try .fe extension */
if ( fd == NULL)
{
env = getenv("EVOLVERPATH");
strncpy(path,name,sizeof(path));
strcat(path,".fe");
while ( (fd = fopen(path,"r")) == NULL)
{ /* try paths in EVOLVERPATH */
if ( env == NULL ) break;
len = strcspn(env,ENVPATHCHAR);
if ( len == 0 ) break;
strncpy(path,env,len);
path[len] = PATHCHAR;
strncpy(path+len+1,name,sizeof(path)-len-2);
strcat(path,".fe");
if ( env[len] == 0 ) env = NULL; /* end of EVOLVERPATH */
else env += len+1;
}
}
#endif
if ( fd && (mode==SETDATAFILENAME) )
{ /* has to be set so repeat open works */
/* copy from end, getting same number of directories */
char *found; /* from findfile() */
char *user; /* user input search string */
found = path + strlen(path) - 1;
user = name + strlen(name) - 1;
while ( user >= name )
{ while ( (*user != PATHCHAR) && (*user != '\\') && (user >= name) )
user--;
while ( (*found != PATHCHAR) && (*found != '\\') && (found >= path) )
found--;
if ( user >= name ) user--; else break;
if ( found >= path ) found--; else break;
}
strncpy(datafilename,found+1,PATHSIZE);
}
return fd;
}
/**************************************************************************
*
* function: calc_view_transform_gens()
*
* purpose: evaluate expressions in view_transform_gens
*
* return: 1 if anything changed; 0 else.
*/
int calc_view_transform_gens()
{ int n,i,j,nmax;
REAL value;
int change = 0;
nmax = web.torus_flag ? transform_gen_count - SDIM : transform_gen_count;
for ( n = 0 ; n < nmax ; n++ )
for ( i = 0 ; i <= SDIM ; i++ )
for ( j = 0 ; j <= SDIM ; j++ )
{ value = eval(&view_transform_gens_expr[n][i][j],NULL,NULLID,NULL);
if ( value != view_transform_gens[n][i][j] )
{ view_transform_gens[n][i][j] = value;
change = 1;
}
}
return change;
}
/*******************************************************************
*
* function: calc_periods()
*
* purpose: calculate torus periods from expressions
*/
void calc_periods(mode)
int mode; /* NO_ADJUST_VOLUMES or ADJUST_VOLUMES */
{ int i,j;
REAL value;
REAL old_torusv = web.torusv;
MAT2D(invper,MAXCOORD,MAXCOORD); /* so don't have temporary bad values
in web.inverse_periods since graphgen() may be using it */
int k;
if ( torus_period_expr[0][0].start )
{ for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ )
{ value = eval(&torus_period_expr[i][j],NULL,NULLID,NULL);
invper[j][i] = web.torus_period[i][j] = value;
}
}
web.torusv = det_adjoint(invper,SDIM);
if ( web.torusv == 0.0 )
kb_error(1377,"Degenerate torus unit cell.\n",RECOVERABLE);
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
web.inverse_periods[i][j] = invper[i][j]/web.torusv;
}
if ( web.torus_display_period )
{ REAL det;
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ )
{ value = eval(&torus_display_period_expr[i][j],NULL,NULLID,NULL);
invper[j][i] = web.torus_display_period[i][j] = value;
}
}
det = det_adjoint(invper,SDIM);
if ( det == 0.0 )
kb_error(3377,"Degenerate display periods.\n",RECOVERABLE);
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
web.inverse_display_periods[i][j] = invper[i][j]/det;
}
/* if change in periods, adjust volumes and volconsts */
if ( (mode == ADJUST_VOLUMES) && (old_torusv != 0.0) && !web.pressure_flag)
{ body_id b_id;
value = web.torusv/old_torusv;
FOR_ALL_BODIES(b_id)
{ set_body_volume(b_id,value*(get_body_volume(b_id)),SETSTAMP);
save_body_volume(b_id);
if ( get_battr(b_id) & FIXEDVOL )
set_body_fixvol(b_id,value*(get_body_fixvol(b_id)));
set_body_volconst(b_id,value*(get_body_volconst(b_id)));
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(b_id));
q->value *= value;
q->target *= value;
q->volconst *= value;
}
}
}
/* adjust view transform generators for automatic torus symmetries */
if ( web.torus_flag )
{
if ( view_transform_gens == NULL )
{ view_transform_gens = dmatrix3(SDIM,SDIM+1,SDIM+1);
transform_gen_count = SDIM;
}
if ( transform_gen_swap == NULL )
transform_gen_swap = (int*)mycalloc(SDIM,sizeof(int));
for ( j=transform_gen_count-SDIM, k=0 ; j n ) x[m-1] = 0.5;
}
/****************************************************************
*
* function: binom_coeff()
*
* purpose: calculate binomial coefficient (small numbers only)
*
*/
int binom_coeff(n,k)
int n,k;
{ int i, c;
if ( n < k ) return 0;
if ( (n-k) < k ) k = n - k;
for ( i = 0, c = 1 ; i < k ; i++ )
{ c *= n - i; c /= i+1; }
return c;
}
/**********************************************************************
*
* function: set_e_phase_density()
*
* purpose: calculate edge density from phases of neighboring facets.
*/
void set_e_phase_density(e_id)
edge_id e_id;
{ facetedge_id fe = get_edge_fe(e_id);
int i = get_f_phase(get_fe_facet(fe));
int j = get_f_phase(get_fe_facet(get_next_facet(fe)));
set_edge_density(e_id,phase_data[i][j]);
}
/**********************************************************************
*
* function: set_f_phase_density()
*
* purpose: calculate facet density from phases of neighboring bodies.
*/
void set_f_phase_density(f_id)
facet_id f_id;
{
int i = get_b_phase(get_facet_body(f_id));
int j = get_b_phase(get_facet_body(inverse_id(f_id)));
set_attr(f_id,DENSITY);
set_facet_density(f_id,phase_data[i][j]);
}
/**********************************************************************
*
* function: make_vedge_lists()
*
* purpose: construct from scratch edge lists aound vertices.
* These are singly linked circular lists with links residing
* in edge structures.
*/
void make_vedge_lists()
{ vertex_id v_id;
edge_id e_id;
if ( web.representation == SIMPLEX ) return;
/* clear out all old data */
MFOR_ALL_EDGES(e_id)
{ set_next_tail_edge(e_id,NULLID);
set_next_tail_edge(inverse_id(e_id),NULLID);
}
MFOR_ALL_VERTICES(v_id)
{ if ( !(get_vattr(v_id) & (Q_MIDEDGE|Q_MIDFACET|Q_MIDPOINT)) )
set_vertex_edge(v_id,NULLID);
}
/* now splice in all edges */
MFOR_ALL_EDGES(e_id)
{ insert_vertex_edge(get_edge_tailv(e_id),e_id);
insert_vertex_edge(get_edge_headv(e_id),inverse_id(e_id));
}
vedge_timestamp = top_timestamp;
}
/**********************************************************************
*
* function: make_vfacet_lists()
*
* purpose: construct from scratch facet lists aound vertices.
* These are singly linked circular lists with links residing
* in facet structures.
*
* Should only be used currently with SIMPLEX model, since others
* use edge links around vertex.
*/
void make_vfacet_lists()
{ vertex_id v_id;
facet_id f_id, ff_id,fff_id;
int i;
int facet_verts;
/* set all facet vertices */
facet_verts = web.skel[FACET].ctrlpts;
expand_attribute(FACET,F_NEXT_VFACET_ATTR,&facet_verts);
if ( web.representation == SOAPFILM ) /* set up facet vertex lists */
{ if ( web.modeltype != LAGRANGE )
FOR_ALL_FACETS(f_id)
{ facetedge_id fe = get_facet_fe(f_id);
vertex_id *fv = get_facet_vertices(f_id);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
v_id = get_fe_tailv(fe);
fv[i] = v_id;
fe = get_next_edge(fe);
if ( web.modeltype == QUADRATIC )
fv[i+FACET_VERTS] = get_edge_midv(get_fe_edge(fe));
}
}
}
else if ( web.representation == STRING )
{ edge_id e_id;
FOR_ALL_EDGES(e_id)
{ facetedge_id fe = get_edge_fe(e_id);
if ( !valid_id(fe) )
continue;
f_id = get_fe_facet(fe);
if ( !valid_id(f_id) )
continue;
set_vertex_facet(get_edge_tailv(e_id),f_id);
set_vertex_facet(get_edge_headv(e_id),f_id);
}
}
else if ( web.representation == SIMPLEX )
FOR_ALL_FACETS(f_id) /* simplex vertex to facet links */
{ vertex_id *fv = get_facet_vertices(f_id);
for ( i = 0 ; i < facet_verts ; i++ )
{
set_vertex_facet(fv[i],f_id);
}
}
/* start by making one-element loops on facets */
FOR_ALL_VERTICES(v_id)
{
f_id = get_vertex_facet(v_id);
if ( valid_id(f_id) )
{ set_next_vertex_facet(v_id,f_id,f_id);
set_vertex_facet(v_id,f_id);
}
}
if ( web.representation == STRING )
{
/* not using explicit linked list;
since get_next_vertex_facet() uses
edge list around vertex and facet
list around edge.
*/
}
else
FOR_ALL_FACETS(f_id)
{
vertex_id *fv = get_facet_vertices(f_id);
for ( i = 0 ; i < facet_verts ; i++ )
{ v_id = fv[i];
ff_id = get_vertex_facet(v_id);
if ( !equal_id(f_id,ff_id) )
{ /* splice in after first one */
fff_id = get_next_vertex_facet(v_id,ff_id);
if ( !equal_element(f_id,fff_id) )
{ set_next_vertex_facet(v_id,ff_id,f_id);
set_next_vertex_facet(v_id,f_id,fff_id);
}
}
}
}
vfacet_timestamp = top_timestamp;
}
/**********************************************************************
*
* function: make_bfacet_lists()
*
* purpose: construct from scratch facet lists aound bodies.
* These are doubly linked circular lists with links residing
* in facet structures.
*/
void make_bfacet_lists()
{ body_id b_id;
facet_id f_id, ff_id,fff_id,fi_id;
int four = 4;
if ( bfacet_timestamp >= top_timestamp ) return;
if ( web.skel[BODY].count == 0 ) return;
expand_attribute(FACET,F_NEXT_BFACET_ATTR,&four);
/* start by making one-element loops on facets pointed to
by body facet_edge link */
FOR_ALL_BODIES(b_id)
{ /* make sure legal pointer */
f_id = get_body_facet(b_id);
if ( !valid_id(f_id) ||
#ifdef MPI_EVOLVER
!mpi_remote_present(f_id) ||
#endif
!equal_id(b_id,get_facet_body(f_id)) )
{ set_body_facet(b_id,NULLID);
FOR_ALL_FACETS(f_id)
{ if ( equal_id(b_id,get_facet_body(f_id)) )
{set_body_facet(b_id,f_id); break; }
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
{set_body_facet(b_id,inverse_id(f_id)); break; }
}
}
f_id = get_body_facet(b_id);
if ( valid_id(f_id) )
{
set_next_body_facet(f_id,f_id);
set_prev_body_facet(f_id,f_id);
}
}
/* now splice in all other facets */
FOR_ALL_FACETS(f_id)
{ b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ ff_id = get_body_facet(b_id);
if ( !equal_id(f_id,ff_id) )
{ /* splice in after first one */
fff_id = get_next_body_facet(ff_id);
set_next_body_facet(ff_id,f_id);
set_prev_body_facet(f_id,ff_id);
set_next_body_facet(f_id,fff_id);
set_prev_body_facet(fff_id,f_id);
}
}
fi_id = inverse_id(f_id);
b_id = get_facet_body(fi_id);
if ( valid_id(b_id) )
{ ff_id = get_body_facet(b_id);
if ( !equal_id(fi_id,ff_id) )
{ /* splice in after first one */
fff_id = get_next_body_facet(ff_id);
set_next_body_facet(ff_id,fi_id);
set_prev_body_facet(fi_id,ff_id);
set_next_body_facet(fi_id,fff_id);
set_prev_body_facet(fff_id,fi_id);
}
}
}
bfacet_timestamp = top_timestamp;
}
/*******************************************************************
*
* function: insert_vertex_edge(v_id,e_id)
*
* purpose: fix up edge links around vertex when edge added
*
*/
void insert_vertex_edge(v_id,e_id)
vertex_id v_id;
edge_id e_id;
{ edge_id ee_id,eee_id;
int n;
#ifdef MPI_EVOLVER
if ( !elptr(v_id) || !elptr(e_id) )
return;
#endif
if ( !equal_id(v_id,get_edge_tailv(e_id)) )
{ kb_error(1372,"Internal error: Trying to insert edge to wrong vertex.\n",
WARNING);
return;
}
ee_id = get_vertex_edge(v_id);
if ( !valid_id(ee_id) )
{ set_next_tail_edge(e_id,e_id);
set_vertex_edge(v_id,e_id);
return;
}
/* go around to be sure not already there */
eee_id = ee_id; n = 0;
do
{ eee_id = get_next_tail_edge(eee_id);
if ( equal_id(eee_id,e_id) ) return;
if ( ++n > 2*web.skel[EDGE].count+5 ) /* sanity check */
{ sprintf(errmsg,"Internal error: Vertex %s edge loop not closed.\n",
ELNAME(v_id));
kb_error(1373,errmsg,WARNING);
return;
}
} while ( !equal_id(eee_id,ee_id) );
/* insert into existing list */
ee_id = get_next_tail_edge(eee_id);
set_next_tail_edge(eee_id,e_id);
set_next_tail_edge(e_id,ee_id);
} /* end insert_vertex_edge */
/*******************************************************************
*
* function: remove_vertex_edge(v_id,e_id)
*
* purpose: fix up edge links around vertex when edge removed
*
*/
void remove_vertex_edge(v_id,e_id)
vertex_id v_id;
edge_id e_id; /* tail is v_id */
{ edge_id ee_id,eee_id,eeee_id;
vertex_id vv_id = get_edge_tailv(e_id);
int n = 0;
#ifdef MPI_EVOLVER
if ( !mpi_remote_present(v_id) )
return;
#endif
if ( !equal_id(v_id,vv_id) )
{ sprintf(errmsg,
"Internal error: Trying to detach edge %s from vertex %s instead of %s.\n",
ELNAME(e_id),ELNAME1(v_id),ELNAME2(vv_id));
kb_error(1374,errmsg, WARNING);
return;
}
/* make sure edge actually in vertex edge loop */
ee_id = get_vertex_edge(v_id);
if ( !valid_id(ee_id)) return;
eee_id = ee_id;
do
{
#ifdef MPI_EVOLVER
if ( !mpi_remote_present(eee_id) )
return; /* fail, but don't crash */
#endif
if ( equal_id(eee_id,e_id) ) break;
eee_id = get_next_tail_edge(eee_id);
if ( ++n > 2*web.skel[EDGE].count ) /* sanity check */
{ kb_error(1375,"Internal error: Vertex edge loop not closed.\n",WARNING);
break;
}
} while ( !equal_id(eee_id,ee_id) );
if ( !equal_id(eee_id,e_id) ) return;
ee_id = get_next_tail_edge(e_id);
if ( equal_id(e_id,ee_id) )
{ set_vertex_edge(v_id,NULLID);
return;
}
#ifdef MPI_EVOLVER
if ( !mpi_remote_present(ee_id) )
return;
#endif
eee_id = ee_id;
eeee_id = get_next_tail_edge(ee_id);
#ifdef MPI_EVOLVER
if ( !mpi_remote_present(eeee_id) )
return;
#endif
n = 0;
while ( !equal_id(e_id,eeee_id) )
{ eee_id = eeee_id;
eeee_id = get_next_tail_edge(eee_id);
#ifdef MPI_EVOLVER
if ( !mpi_remote_present(eeee_id) )
return;
#endif
if ( ++n > 2*web.skel[EDGE].count ) /* sanity check */
{ sprintf(errmsg, "Internal error: Vertex %s edge loop not closed.\n",
ELNAME(v_id));
kb_error(1376,errmsg, WARNING);
break;
}
}
set_next_tail_edge(eee_id,ee_id);
set_next_tail_edge(e_id,e_id);
set_vertex_edge(v_id,ee_id);
/* clean up in case of constraint content quantities */
if ( everything_quantities_flag && (web.representation == STRING) )
{ int k,n;
conmap_t *map = get_v_constraint_map(v_id);
#define MAXTODO 10
conmap_t to_do[MAXTODO];
/* make list since unset and set can change order in map */
for ( k = 1, n = 0; k <= (int)*map ; k++ )
{ int connum = map[k]&CONMASK;
struct constraint *con = get_constraint(connum);
if ( (con->attr & CON_CONTENT) && (n < MAXTODO) )
to_do[n++] = connum;
}
for ( k = 0 ; k < n ; k++ )
{ unset_v_constraint_map(v_id,to_do[k]);
set_v_constraint_map(v_id,to_do[k]);
}
}
} /* end remove_vertex_edge() */
/*******************************************************************
*
* function: get_vertex_first_facet()
*
* purpose: find some facet adjoining vertex, first facet in
* implicit list found by following vertex edge list
* around and then facets around edge.
*
* Returns facetedge_id if possible, otherwise facet_id
*/
element_id get_vertex_first_facet(v_id)
vertex_id v_id;
{
/* special cases */
if ( web.representation == SIMPLEX )
{ if ( vfacet_timestamp < top_timestamp )
make_vfacet_lists();
return get_vertex_facet(v_id);
}
if ( get_vattr(v_id) & Q_MIDFACET )
return get_vertex_facet(v_id);
return get_next_vertex_facet(v_id,NULLID);
} /* end get_vertex_first_facet() */
/************************************************************************
*
* Function: get_next_vertex_facet()
*
* Purpose: get next facet in implicit chain around vertex.
*
* Returns facetedge_id if possible, otherwise facet_id
*/
element_id get_next_vertex_facet(v_id,prev_id)
vertex_id v_id;
element_id prev_id; /* either facet_id or facetedge_id;
if null, gets first one */
{
edge_id start_e,ee_id;
facetedge_id fe_id,start_fe, first_fe = NULLID;
facet_id next_f;
int found; /* whether old f_id found yet */
if ( web.representation == SIMPLEX )
{
return get_simplex_next_vertex_facet(v_id,prev_id);
}
if ( id_type(prev_id) == FACET )
return NULLID; /* interior Lagrange point */
/* now trace loop of edges and facetedges */
start_e = get_vertex_edge(v_id);
if ( !valid_id(start_e) ) return NULLID;
ee_id = start_e;
found = !valid_id(prev_id);
do
{ fe_id = start_fe = get_edge_fe(ee_id);
if ( valid_id(fe_id) )
do
{
facetedge_id ret_fe = fe_id; /* return value */
next_f = get_fe_facet(fe_id);
if ( web.representation == STRING )
{ if ( !valid_id(next_f) )
return NULLID;
if ( !valid_id(get_prev_edge(fe_id)) && inverted(next_f) )
{ /* in case facet doesn't have positive facet */
next_f = positive_id(next_f);
ret_fe = inverse_id(fe_id);
}
}
if ( !inverted(next_f) )
{ if ( !valid_id(first_fe) )
first_fe = ret_fe;
if ( found )
return ret_fe;
if ( equal_element(fe_id,prev_id) )
found = 1;
}
fe_id = get_next_facet(fe_id);
} while ( !equal_id(start_fe,fe_id) );
ee_id = get_next_tail_edge(ee_id);
} while ( !equal_id(ee_id,start_e) );
if ( found )
return first_fe; /* looped all the way around */
return NULLID;
}
/***********************************************************************
vertex facet list stuff for simplex model
*/
/*******************************************************************
*
* function: insert_vertex_facet(v_id,f_id)
*
* purpose: fix up facet links around vertex when facet added
*
*/
void insert_vertex_facet(v_id,f_id)
vertex_id v_id;
facet_id f_id;
{ facet_id ff_id,fff_id;
int n;
ff_id = get_vertex_facet(v_id);
if ( !valid_id(ff_id) )
{ set_next_vertex_facet(v_id,f_id,f_id);
set_vertex_facet(v_id,f_id);
set_vertex_facet(v_id,f_id);
return;
}
/* go around to be sure not already there */
fff_id = ff_id; n = 0;
do
{ fff_id = get_next_vertex_facet(v_id,fff_id);
if ( equal_element(fff_id,f_id) ) return;
if ( ++n > 2*web.skel[FACET].count+5 ) /* sanity check */
{ kb_error(2441,"Internal error: Vertex facet loop not closed.\n",WARNING);
return;
}
} while ( !equal_id(fff_id,ff_id) );
/* insert into existing list */
ff_id = get_next_vertex_facet(v_id,fff_id);
set_next_vertex_facet(v_id,fff_id,f_id);
set_next_vertex_facet(v_id,f_id,ff_id);
}
/*******************************************************************
*
* function: remove_vertex_facet(v_id,f_id)
*
* purpose: fix up facet links around vertex when facet removed
*
*/
void remove_vertex_facet(v_id,f_id)
vertex_id v_id;
facet_id f_id;
{ facet_id ff_id,fff_id,ffff_id;
int n = 0;
/* find it */
ff_id = get_vertex_facet(v_id);
if ( !valid_id(ff_id)) return;
fff_id = ff_id;
do
{ if ( equal_element(fff_id,f_id) ) break;
fff_id = get_next_vertex_facet(v_id,fff_id);
if ( ++n > 2*web.skel[FACET].count ) /* sanity check */
{ kb_error(2442,"Internal error: Vertex facet loop not closed.\n",WARNING);
break;
}
} while ( !equal_element(fff_id,ff_id) );
if ( !equal_id(fff_id,f_id) ) return;
ff_id = get_next_vertex_facet(v_id,f_id);
if ( equal_element(f_id,ff_id) )
{ set_vertex_facet(v_id,NULLID);
return;
}
fff_id = ff_id;
ffff_id = get_next_vertex_facet(v_id,ff_id);
n = 0;
while ( !equal_element(f_id,ffff_id) )
{ fff_id = ffff_id;
ffff_id = get_next_vertex_facet(v_id,fff_id);
if ( ++n > 2*web.skel[FACET].count ) /* sanity check */
{ kb_error(2443,"Internal error: Vertex facet loop not closed.\n",WARNING);
break;
}
}
set_next_vertex_facet(v_id,fff_id,ff_id);
set_next_vertex_facet(v_id,f_id,f_id);
set_vertex_facet(v_id,ff_id);
if ( web.representation==SIMPLEX )
set_vertex_facet(v_id,ff_id);
}
facet_id get_simplex_next_vertex_facet(v_id,f_id)
vertex_id v_id;
facet_id f_id;
{ int i;
vertex_id *v = get_facet_vertices(f_id);
facet_id *f = F_ELID(f_id,F_NEXT_VFACET_ATTR);
int vmax = web.skel[FACET].ctrlpts;
for ( i = 0 ; i < vmax ; i++ )
if (equal_id(v_id,v[i])) return f[i] ;
sprintf(errmsg,"Internal error: get_next_vertex_facet failure v %s f %s\n",
ELNAME(v_id), ELNAME1(f_id));
kb_error(1306,errmsg,RECOVERABLE);
return NULLID;
}
void set_next_vertex_facet(v_id,f_id,ff_id)
vertex_id v_id; facet_id f_id,ff_id;
{
vertex_id *v = get_facet_vertices(f_id);
facet_id *f = F_ELID(f_id,F_NEXT_VFACET_ATTR);
int vmax = web.skel[FACET].ctrlpts;
int i;
for ( i = 0 ; i < vmax ; i++ )
{ if (equal_id(v_id,v[i]))
{ f[i] = ff_id ;
break;
}
}
}
/* end vertex facet list stuff for simplex model
***********************************************************************/
/************************************************************************
*
* function: count_fixed_vol()
*
* purpose: return number of fixed volumes and quantities
*
*/
int count_fixed_vol()
{ int retval = 0;
body_id bi_id; /* identifier for body i */
int n;
struct gen_quant *gq;
if ( !everything_quantities_flag && !web.pressure_flag )
FOR_ALL_BODIES(bi_id)
if ( get_battr(bi_id) & (FIXEDVOL) ) retval++;
for ( n = 0 ; n < gen_quant_count ; n++ )
{ gq = GEN_QUANT(n);
if ( gq->flags & (Q_FIXED|Q_CONSERVED) )
retval++;
}
return retval;
}
/*****************************************************************
*
* Random number generator using the Mersenne Twister.
*
* A C-program for MT19937B: Integer Version
* genrand() generate one pseudorandom integer which is
* uniformly distributed among the 32bit unsigned integers
* sgenrand(seed) set initial values to the working area of 624 words.
* sgenrand(seed) must be called once before calling genrand()
* (seed is any integer except 0).
* Modified to produce batch of drands by K. Brakke
* Reference:
Makoto Matsumoto and Takuji Nishimura,
Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
Pseudo-Random Number Generator, ACM Transactions on Modeling and
Computer Simulation, Vol. 8, No. 1, January 1998, pp. 3-30.
In ACM on-line Library,
http://www.acm.org/pubs/citations/journals/tomacs/1998-8-1/p3-matsumoto/
*/
/*
LICENCE CONDITIONS:
Matsumoto and Nishimura consent to GNU General
Public Licence for this code.
*/
/* Period parameters */
#define N 624
#define NR 312
#define M 397
#define MATRIX_A 0x9908b0df /* constant vector a */
#define UPPER_MASK 0x80000000 /* most significant w-r bits */
#define LOWER_MASK 0x7fffffff /* least significant r bits */
/* for tempering */
#define TEMPERING_MASK_B 0x9d2c5680
#define TEMPERING_MASK_C 0xefc60000
#define TEMPERING_SHIFT_U(y) (y >> 11)
#define TEMPERING_SHIFT_S(y) (y << 7)
#define TEMPERING_SHIFT_T(y) (y << 15)
#define TEMPERING_SHIFT_L(y) (y >> 18)
static unsigned long ptgfsr[N]; /* set initial seeds: N = 624 words */
static REAL drands[NR]; /* batch of random doubles */
static int initflag;
static REAL rfactor = 0.0;
static int k = N;
static int kr = NR;
void sgenrand(unsigned long);
void
sgenrand(seed)
unsigned long seed; /* seed should not be 0 */
{
int k;
/* setting initial seeds to ptgfsr[N] using */
/* the generator Line 25 of Table 1 in */
/* [KNUTH 1981, The Art of Computer Programming */
/* Vol. 2 (2nd Ed.), pp102] */
ptgfsr[0]= seed & 0xffffffff;
for (k=1; k> 1) ^ mag01[y & 0x1];
}
for (;kk> 1) ^ mag01[y & 0x1];
}
y = (ptgfsr[N-1]&UPPER_MASK)|(ptgfsr[0]&LOWER_MASK);
ptgfsr[N-1] = ptgfsr[M-1] ^ (y >> 1) ^ mag01[y & 0x1];
for ( k = 0 ; k < N ; k++ )
{ y = ptgfsr[k];
y ^= TEMPERING_SHIFT_U(y);
y ^= TEMPERING_SHIFT_S(y) & TEMPERING_MASK_B;
y ^= TEMPERING_SHIFT_T(y) & TEMPERING_MASK_C;
y &= 0xffffffff; /* you may delete this line if word size = 32 */
y ^= TEMPERING_SHIFT_L(y);
ptgfsr[k] = y;
}
for ( kr = 0 ; kr < NR ; kr++ )
drands[kr] = (ptgfsr[2*kr]*rfactor + ptgfsr[2*kr+1])*rfactor;
k = 0;
kr = 0;
}
return drands[kr++];
}
#ifdef MSC
/* for METIS and other third parties */
double drand48()
{ return (double)kb_drand(); }
void srand48(int seed)
{ kb_initr(seed); }
#endif
/***********************************************************************
*
* function: wrap_vertex()
*
* purpose: Adjust vertex position by given wrap.
* Volconst adjustments taken care of in volume calculation.
*
*/
void wrap_vertex(v_id,wrap)
vertex_id v_id;
int wrap;
{ int i;
REAL newx[MAXCOORD];
REAL *x = get_coord(v_id);
edge_id e_id,start_e;
if ( (web.modeltype != LINEAR) && (web.modeltype != QUADRATIC) )
kb_error(4323,
"Can only do vertex wrap in LINEAR and QUADRATIC models so far.\n",
RECOVERABLE);
if ( !web.symmetry_flag ) return;
if ( get_vattr(v_id) & (Q_MIDPOINT|Q_MIDEDGE|Q_MIDFACET) ) return;
ENTER_GRAPH_MUTEX;
sym_wrap(x,newx,wrap);
for ( i = 0 ; i < SDIM ; i++ ) x[i] = newx[i];
start_e = e_id = get_vertex_edge(v_id);
do
{ set_edge_wrap(e_id,sym_compose(wrap,get_edge_wrap(e_id)));
if ( (web.modeltype == QUADRATIC) && !inverted(e_id) )
{ x = get_coord(get_edge_midv(e_id));
sym_wrap(x,newx,wrap);
for ( i = 0 ; i < SDIM ; i++ ) x[i] = newx[i];
}
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(start_e,e_id) );
LEAVE_GRAPH_MUTEX;
}
evolver-2.30c.dfsg/src/geomgraph.c 0000644 0001753 0001753 00000047716 11410765113 017351 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: geomgraph.c
*
* Contents: Routines for interface with geomview via pipe
* Meant to coexist with mvgraph.c for minneview,
* which has several things this file uses.
*
* Version using OFF format
*/
#include "include.h"
static FILE *pfd = NULL;
#ifdef OOGL
#ifdef WIN32
#define popen _popen
#define pipe(fds) _pipe(fds,256,O_BINARY)
#endif
static char gv_version[100]; /* geomview version string */
static char pipename[100]; /* for named pipe to geomview */
static char geom_name[100]; /* for geomview name of object */
char *base_name; /* for forming pipe name */
static int gdim; /* 3 or 4 dimensions */
/* for facets */
static float *vvlist; /* vertex list */
static struct flist_t { int num; /* number of vertices */
int v[3]; /* vertex list */
int colors; /* number of colors following */
float c[4]; /* color rgba */
} *fflist;
static int *vindex; /* for translating vertex id to index */
static int vercount,vmaxcount;
static int ecount;
static int fcount,fmaxcount;
/* for edges */
struct elist_t { float x[2][4]; /* 2 endpoints */
float c[4]; /* colors */
vertex_id v_id[2]; /* endpoints, for picking */
} *eelist;
int edgecount; /* actual edges */
int edgemax; /* allocated */
/***************************************************************
*
* function: Begin_geomview()
*
* purpose: Spawns geomview.
*
*/
void Begin_geomview(outname)
char *outname; /* if want particular name for pipe, NULL else */
{
if ( geomview_flag )
kb_error(1657,"Cannot have multiple geomview displays.\n",RECOVERABLE);
gv_version[0] = '0'; gv_version[1] = 0;
base_name = strrchr(datafilename,PATHCHAR);
if ( base_name == NULL ) base_name = datafilename;
else base_name++; /* skip '/' */
/* using named pipe */
if ( outname ) strcpy(pipename,outname);
else
{ sprintf(pipename,"/tmp/%s.XXXXXX",base_name);
#ifdef LINUX
/* gcc complains about mktemp, so we use mkstemp */
mkstemp(pipename); /* actually creates file */
unlink(pipename); /* so can recreate it later as pipe */
#else
mktemp(pipename);
#endif
}
/* spawn geomview */
if ( geompipe_flag == GEOM_TO_GEOMVIEW)
{
#ifdef WIN32
kb_error(2414,"There is no Windows version of geomview.\n",RECOVERABLE);
#else
int gv_pid;
int to_gv_pipe[2];
pipe(gv_pipe); /* from geomview stdout */
pipe(to_gv_pipe); /* to geomview stdin */
signal(SIGINT,SIG_IGN); /* to avoid geomview 1.6 CTRL-C bug */
gv_pid = fork();
if ( gv_pid == 0 )
{ /* child */
close(0);
dup(to_gv_pipe[0]);
close(to_gv_pipe[0]);
close(to_gv_pipe[1]);
close(1);
dup(gv_pipe[1]);
close(gv_pipe[0]);
close(gv_pipe[1]);
signal(SIGINT,SIG_IGN);
execlp("geomview","geomview","-c","(interest (pick world))","-",NULL);
perror("geomview"); /* only error gets here */
kb_error(1660,"geomview invocation failed.\n",RECOVERABLE);
}
/* evolver */
signal(SIGINT,catcher);
close(gv_pipe[1]);
close(to_gv_pipe[0]);
pfd = fdopen(to_gv_pipe[1],"w"); /* hooked to stdin of geomview*/
/* get geomview version */
fprintf(pfd,"(echo (geomview-version) \"\n\")\n");
fflush(pfd);
read(gv_pipe[0],gv_version,sizeof(gv_version));
if ((strcmp(gv_version,"\"1.6") > 0)&&(strcmp(gv_version,"\"1.6.1p7") < 0))
{ geomview_bug_flag = 1;
}
#endif
}
else if ( geompipe_flag == GEOM_PIPE_COMMAND )
{
pfd = popen(outname,"w");
if ( pfd == NULL )
{ sprintf(errmsg,"%s: spawn failed.\n",outname);
kb_error(2075,errmsg,RECOVERABLE);
}
}
else /* just a pipe, without geomview */
{
#ifdef WIN32
outstring("Warning: Windows named pipes do not appear as regular files,\n");
outstring("so an ordinary file will be created instead and not deleted when pipe closed.\n");
prompt("Enter file name: ",pipename,sizeof(pipename));
#else
sprintf(msg,"test -p %s || (test -x /etc/mknod && /etc/mknod %s p) || (test -s /usr/sbin/mknod && /usr/sbin/mknod %s p) || (test -s /usr/bin/mkfifo && /usr/bin/mkfifo %s) || /bin/mknod %s p",
pipename,pipename,pipename,pipename,pipename);
if ( system(msg) != 0 )
{ sprintf(errmsg,"Pipe creation failed for %s\n",pipename);
kb_error(1661,errmsg,RECOVERABLE) ;
}
sleep(1);
sprintf(msg,"Pipe name: %s\n",pipename);
outstring(msg);
#endif
pfd = fopen(pipename,"w");
if ( pfd == NULL )
{ perror(pipename);
kb_error(1662,"Check that needed directories exists and try again.\n",
RECOVERABLE);
}
}
geomview_flag = 1; /* tell everybody we're initialized */
OOGL_flag = 1; /* tell everybody we're initialized */
UpdateOOGL(); /* make initial display */
}
/*********************************************************************
*
* function: end_geomview_object()
*
* purpose; delete current surface from geomview display
*
*/
void end_geomview_object()
{
if ( geomview_flag && geom_name[0] )
fprintf(pfd,"(delete %s)\n", geom_name);
}
/*******************************************************************
*
* function: End_geomview()
*
* purpose: Close down geomview process.
*
*/
void End_geomview()
{
fprintf(pfd,"(exit)\n");
fclose(pfd);
#ifndef WIN32
if ( geompipe_flag == GEOM_NAMED_PIPE)
{ sprintf(msg,"rm %s",pipename);
system(msg);
}
#endif
geomview_flag = 0;
geompipe_flag = GEOM_TO_GEOMVIEW;
geom_name[0] = 0;
OOGL_flag = 0;
pfd = NULL;
}
/************************************************************************
*
* function: geomview_start()
*
* purpose: initialize for new surface in geomview.
*
*/
void geomview_start()
{
vertex_id v_id;
int i,k;
float *vv;
gdim = 3;
if ( view_4D_flag ) gdim = 4;
/* initialize lists for facets */
vmaxcount = vercount = web.skel[VERTEX].count;
ecount = web.skel[EDGE].count; if ( ecount <= 0 ) ecount = 1; /* GV bug */
fmaxcount = web.skel[FACET].count+1;
fcount = 0;
vvlist = (float *)temp_calloc(vmaxcount*gdim,sizeof(float));
fflist = (struct flist_t *)temp_calloc(fmaxcount, sizeof(struct flist_t));
vindex = (int *)temp_calloc(web.skel[VERTEX].max_ord+2,sizeof(int));
/* pick lists, elements in order fed to geomview */
if ( vpicklist ) myfree((char*)vpicklist);
vpicklist = (vertex_id*)mycalloc(vmaxcount,sizeof(vertex_id));
if ( fpicklist ) myfree((char*)fpicklist);
fpicklist = (facet_id*)mycalloc(fmaxcount,sizeof(facet_id));
vv = vvlist;
k = 0;
FOR_ALL_VERTICES(v_id)
{
REAL *x = get_coord(v_id);
for ( i = 0 ; i < gdim ; i++,vv++ )
if ( i < web.sdim )
*vv = (float)x[i];
vindex[loc_ordinal(v_id)] = k; /* so can reference by list order */
vpicklist[k] = v_id;
k++;
}
/* initialize list for edges */
if ( web.representation == STRING )
edgemax = web.skel[EDGE].count;
else edgemax = 100;
edgecount = 0;
eelist = (struct elist_t *)temp_calloc(edgemax,sizeof(struct elist_t));
}
/***********************************************************************
*
* function: geomview_edge()
*
* purpose: add an edge to geomview display list.
*
*/
void geomview_edge(gdata,e_id)
struct graphdata *gdata;
edge_id e_id;
{ struct elist_t *ee;
int color;
int j,k;
color = gdata[0].ecolor;
if ( color == CLEAR ) return;
if ( (color < 0) || (color >= IRIS_COLOR_MAX) )
color = DEFAULT_EDGE_COLOR;
if ( edgecount >= edgemax-1 )
{ eelist = (struct elist_t*)temp_realloc((char*)eelist,
2*edgemax*sizeof(struct elist_t));
edgemax *= 2;
}
ee = eelist + edgecount;
if ( edge_rgb_color_attr > 0 )
{ ee->c[0] = (float)(((color>>24)&0xFF)/255.);
ee->c[1] = (float)(((color>>16)&0xFF)/255.);
ee->c[2] = (float)(((color>>8)&0xFF)/255.);
ee->c[3] = (float)(facet_alpha_flag ? (color&0xFF)/255. : facet_alpha);
}
else
{ for ( j = 0 ; j < 3 ; j++ )
ee->c[j] = (float)(rgb_colors[color][j]);
ee->c[3] = (float)(facet_alpha);
}
/* record for later VECT format */
for ( k = 0 ; k < 2 ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
ee->x[k][j] = (float)gdata[k].x[j];
/* pick data */
if ( valid_id(e_id) )
{ ee->v_id[0] = get_edge_tailv(e_id);
ee->v_id[1] = get_edge_headv(e_id);
}
else
{ ee->v_id[0] = gdata[0].v_id;
ee->v_id[1] = gdata[1].v_id;
}
edgecount++;
}
/************************************************************************
*
* Function: geomview_facet()
*
* Purpose: Accepts facets from graphgen() and plots them.
*/
void geomview_facet(gdata,f_id)
struct graphdata *gdata;
facet_id f_id;
{ struct flist_t *ff;
int color;
int i,j,k;
int dim = (web.sdim < gdim) ? web.sdim : gdim;
color = gdata[0].color;
if ( color == UNSHOWN ) goto do_edges;
if ( (color >= IRIS_COLOR_MAX) )
color = DEFAULT_EDGE_COLOR;
if ( fcount >= fmaxcount-2 )
{ fflist = (struct flist_t*)temp_realloc((char*)fflist,
2*fmaxcount*sizeof(struct flist_t));
fpicklist = (facet_id*)kb_realloc((char*)fpicklist,
2*fmaxcount*sizeof(facet_id));
fmaxcount *= 2;
}
if ( color != CLEAR )
{
ff = fflist + fcount;
ff->num = FACET_VERTS; /* 3 vertices on polygon */
ff->colors = 4;
if ( facet_rgb_color_attr > 0 )
{ ff->c[0] = (float)(((color>>24)&0xFF)/255.);
ff->c[1] = (float)(((color>>16)&0xFF)/255.);
ff->c[2] = (float)(((color>>8)&0xFF)/255.);
ff->c[3] = (float)(facet_alpha_flag ? (color&0xFF)/255. : facet_alpha);
}
else
{ for ( j = 0 ; j < 3 ; j++ )
ff->c[j] = (float)rgb_colors[color][j];
ff->c[3] = (float)facet_alpha;
}
fpicklist[fcount] = f_id;
if ( gdata[0].flags & LIST_FACET )
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
ff->v[i] = vindex[loc_ordinal(gdata[i].v_id)];
}
else if ( gdata[0].flags & SIMPLE_FACET ) /* can use regular vertices */
{ facetedge_id fe = get_facet_fe(f_id);
if ( valid_id(fe) )
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
ff->v[i] = vindex[loc_ordinal(get_fe_tailv(fe))];
fe = get_next_edge(fe);
}
}
else /* have to add vertices to list also */
{
while ( vercount + FACET_VERTS > vmaxcount )
{ vvlist=(float*)temp_realloc((char*)vvlist,
gdim*2*vmaxcount*sizeof(float));
vpicklist=(vertex_id*)kb_realloc((char*)vpicklist,
2*vmaxcount*sizeof(vertex_id));
vmaxcount *= 2;
}
for ( k = 0 ; k < FACET_VERTS ; k++,vercount++ )
{ for ( j = 0 ; j < dim ; j++ )
vvlist[vercount*gdim+j] = (float)gdata[k].x[j];
vpicklist[vercount] = gdata[k].v_id;
ff->v[k] = vercount;
}
}
fcount++;
}
if ( gdata[0].color != gdata[0].backcolor )
if ( gdata[0].backcolor != CLEAR )
{ /* add perturbed back face */
ff = fflist + fcount;
ff->num = 3; /* 3 vertices on polygon */
ff->colors = 4;
color = gdata[0].backcolor;
if ( facet_rgb_color_attr > 0 )
{ ff->c[0] = (float)(((color>>24)&0xFF)/255.);
ff->c[1] = (float)(((color>>16)&0xFF)/255.);
ff->c[2] = (float)(((color>>8)&0xFF)/255.);
ff->c[3] = (float)(facet_alpha_flag ? (color&0xFF)/255. : facet_alpha);
}
else
for ( j = 0 ; j < 3 ; j++ )
ff->c[j] = (float)rgb_colors[color][j];
ff->c[3] = (float)facet_alpha;
fpicklist[fcount] = f_id;
while ( vercount + 3 > vmaxcount )
{ vvlist=(float*)temp_realloc((char*)vvlist,
gdim*2*vmaxcount*sizeof(float));
vpicklist=(vertex_id*)kb_realloc((char*)vpicklist,
2*vmaxcount*sizeof(vertex_id));
vmaxcount *= 2;
}
for ( k = 0 ; k < 3 ; k++,vercount++ )
{ for ( j = 0 ; j < dim ; j++ )
vvlist[vercount*gdim+j] =
(float)(gdata[2-k].x[j] - thickness*gdata[0].norm[j]);
vpicklist[vercount] = vpicklist[ff->v[k]];
ff->v[k] = vercount;
}
fcount++;
}
/* do designated edges */
do_edges:
gdata[FACET_VERTS] = gdata[0]; /* last is first */
for ( k = 0 ; k < FACET_VERTS ; k++ )
if ( (gdata[k].etype & EBITS) != INVISIBLE_EDGE )
geomview_edge(gdata+k,gdata[k].id);
}
/*******************************************************************
*
* Function: geomview_end()
*
* Purpose: Finish off geomview stuffing.
*
*/
void geomview_end()
{ int i,j,k;
float *vv = vvlist;
struct flist_t *ff = fflist;
int ret; /* return code from fprintf or fwrite */
base_name = strrchr(datafilename,PATHCHAR);
if ( base_name == NULL ) base_name = datafilename;
else base_name++; /* skip '/' */
if ( !base_name || !base_name[0] ) goto g_exit; /* no surface */
setting_backcull = 0; /* so read_pick() knows */
/* if ( gdim < 4 ) */
{ /* command format wrapper */
strncpy(geom_name,base_name,sizeof(geom_name));
fprintf(pfd,"(geometry %s ",geom_name);
if ( transforms_flag && (transform_count>1) && !transform_colors_flag )
fprintf(pfd," { INST \nunit { = \n");
fprintf(pfd,"LIST {\n");
if ( strcmp(gv_version,"\"1.6") > 0 )
{ if ( backcull_flag ) fprintf(pfd,"{appearance { backcull}}\n");
else fprintf(pfd,"{appearance {-backcull}}\n");
setting_backcull = 1;
}
}
/* facets */
if ( fcount > 0 )
{
if ( gv_binary_flag )
{ if ( gdim == 3 )
ret =fprintf(pfd,"{OFF BINARY\n");
else
ret =fprintf(pfd,"{4OFF BINARY\n");
if ( ret < 0 ) return; /* broken pipe */
fwrite(&vercount,1,sizeof(int),pfd);
fwrite(&fcount,1,sizeof(int),pfd);
fwrite(&ecount,1,sizeof(int),pfd);
fwrite(vvlist,vercount*gdim,sizeof(float),pfd);
fwrite(fflist,fcount,sizeof(struct flist_t),pfd);
}
else
{ if ( gdim == 3 )
ret =fprintf(pfd,"{OFF\n"); /* COFF used for vertex colors only */
else
ret =fprintf(pfd,"{4OFF\n"); /* COFF used for vertex colors only */
if ( ret < 0 ) return; /* broken pipe */
fprintf(pfd,"%d %d %d\n",vercount,fcount,ecount);
for ( k = 0, vv = vvlist ; (k < vercount) ; k++,vv+=gdim )
{ if ( gdim == 3 )
fprintf(pfd,"%f %f %f\n",(DOUBLE)vv[0],(DOUBLE)vv[1],(DOUBLE)vv[2]);
else
fprintf(pfd,"%f %f %f %f\n",(DOUBLE)vv[0],(DOUBLE)vv[1],(DOUBLE)vv[2],
(DOUBLE)vv[3]);
}
for ( k = 0, ff = fflist ; (k < fcount) ; k++,ff++ )
fprintf(pfd,"3 %d %d %d %f %f %f\n",ff->v[0],ff->v[1],
ff->v[2], (DOUBLE)ff->c[0],(DOUBLE)ff->c[1],(DOUBLE)ff->c[2]);
}
fprintf(pfd,"}\n");
} /* end facets */
/* edges */
if ( edgecount > 0 )
{ struct elist_t *ee;
int new_vmax;
/* append edge vertices to pick list */
if ( fcount > 0 )
{ new_vmax = vercount + 2*edgecount;
}
else
{ new_vmax = 2*edgecount;
vercount = 0;
}
gv_vect_start = vercount;
vpicklist=(vertex_id*)kb_realloc((char*)vpicklist,
new_vmax*sizeof(vertex_id));
for ( i = 0, ee = eelist ; i < edgecount ; i++,ee++,vercount += 2 )
{ vpicklist[vercount] = ee->v_id[0];
vpicklist[vercount+1] = ee->v_id[1];
}
if ( gv_binary_flag & 0 ) /* Geomview vect binary fouled up somehow */
{ int tmp;
if ( gdim == 4 )
fprintf(pfd,"{4VECT BINARY\n");
else
fprintf(pfd,"{VECT BINARY\n");
fwrite(&edgecount,1,sizeof(int),pfd); /* NPOLYLINES */
tmp = 2*edgecount;
fwrite(&tmp,1,sizeof(int),pfd); /* NVERTICES */
fwrite(&edgecount,1,sizeof(int),pfd); /* NCOLORS */
tmp = 2;
for ( i = 0 ; (i < edgecount) ; i++ )
fwrite(&tmp,1,sizeof(int),pfd); /* vertices per line */
tmp = 1;
for ( i = 0 ; (i < edgecount) ; i++ )
fwrite(&tmp,1,sizeof(int),pfd); /* colors per line */
for ( i = 0,ee=eelist ; (i < edgecount) ; i++,ee++ )
/* vertex coords */
{ fwrite(ee->x[0],gdim,sizeof(float),pfd); /* vertices */
fwrite(ee->x[1],gdim,sizeof(float),pfd);
}
for ( i = 0,ee=eelist ; (i < edgecount) ; i++,ee++ )
/* line colors */
fwrite(ee->c,4,sizeof(float),pfd); /* colors */
}
else
{
/* first line: nlines,nvertices,ncolors */
if ( gdim == 4 )
fprintf(pfd,"{4VECT \n%d %d %d\n",edgecount,2*edgecount,edgecount);
else
fprintf(pfd,"{VECT \n%d %d %d\n",edgecount,2*edgecount,edgecount);
for ( i = 0 ; (i < edgecount) ; i++ )
fprintf(pfd,"2\n"); /* vert per edge */
for ( i = 0 ; (i < edgecount) ; i++ )
fprintf(pfd,"1\n"); /* colors per edge */
for ( i = 0,ee=eelist ; (i < edgecount) ; i++,ee++ )
/* vertex coords */
{ if ( gdim == 4 )
fprintf(pfd,"%f %f %f %f %f %f %f %f\n",(DOUBLE)ee->x[0][0],
(DOUBLE)ee->x[0][1], (DOUBLE)ee->x[0][2],(DOUBLE)ee->x[0][3],
(DOUBLE)ee->x[1][0],(DOUBLE)ee->x[1][1],(DOUBLE)ee->x[1][2],
(DOUBLE)ee->x[1][3]);
else
fprintf(pfd,"%f %f %f %f %f %f\n",
(DOUBLE)ee->x[0][0],(DOUBLE)ee->x[0][1],(DOUBLE)ee->x[0][2],
(DOUBLE)ee->x[1][0],(DOUBLE)ee->x[1][1],(DOUBLE)ee->x[1][2]);
}
for ( i = 0,ee=eelist ; (i < edgecount) ; i++,ee++ )
/* line colors */
fprintf(pfd,"%f %f %f %f\n",(DOUBLE)ee->c[0],(DOUBLE)ee->c[1],
(DOUBLE)ee->c[2],(DOUBLE)ee->c[3]);
}
fprintf(pfd,"}\n");
} /* end edges */
/* end wrapping */
fprintf(pfd,"}\n"); /* end LIST */
/* transforms, if any */
if ( transforms_flag && (transform_count>1) && !transform_colors_flag )
{ fprintf(pfd,"\n}\ntlist { =\n");
fprintf(pfd,"\n");
for ( k = 0 ; k < transform_count ; k++ )
{ for ( i = 0 ; i < 4 ; i++ )
{ for ( j = 0 ; j < 4 ; j++ )
{ if ( view_4D_flag ) /* pass on 4x4 corner */
fprintf(pfd,"%f ",(DOUBLE)view_transforms[k][j][i]);
else if ( (i < SDIM) && (j < SDIM) )
fprintf(pfd,"%f ",(DOUBLE)view_transforms[k][j][i]);
else if ( (i < SDIM) && (j == 3) )
fprintf(pfd,"%f ",(DOUBLE)view_transforms[k][SDIM][i]);
else if ( (j < SDIM) && (i == 3) )
fprintf(pfd,"%f ",(DOUBLE)view_transforms[k][j][SDIM]);
else if ( (j == 3) && (i == 3) )
fprintf(pfd,"%f ",(DOUBLE)view_transforms[k][SDIM][SDIM]);
else
fprintf(pfd,"%f ",(DOUBLE)identmat[j][i]);
}
fprintf(pfd,"\n");
}
fprintf(pfd,"\n");
}
fprintf(pfd,"}\n}\n");
}
fprintf(pfd,"\n)"); /* matches (geometry */
fprintf(pfd,"\n(event-pick on)\n");
fprintf(pfd,"(pickable %s)\n",geom_name);
fprintf(pfd,"(interest (pick World))\n"); /* enable picking */
fflush(pfd);
g_exit:
temp_free((char*)vvlist);
temp_free((char*)eelist);
temp_free((char*)fflist);
temp_free((char*)vindex);
}
#else
/*********************************
* stubs for non-geomview systems *
*********************************/
void Begin_geomview(name)
char *name;
{
kb_error(2076,"This Evolver not compiled for Geomview. Compile with -DOOGL.\n",RECOVERABLE);
}
void End_geomview()
{
}
void end_geomview_object()
{
}
void geomview_facet(gdata,f_id)
struct graphdata *gdata;
facet_id f_id;
{
}
#endif
/**************************************************************************
*
* function: geomview_command()
*
* purpose: forward a command to geoview, if active.
*/
void geomview_command(cmd)
char *cmd;
{ if ( geomview_flag )
{ fprintf(pfd,cmd); fflush(pfd); }
else kb_error(1663,"Geomview not active.\n",WARNING);
}
evolver-2.30c.dfsg/src/bk.c 0000644 0001753 0001753 00000157465 11410765113 015777 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************************/
/* File: bk.c */
/* */
/* Bunch-Kaufman factoring */
/* and general linear system mongering */
/************************************************************************/
#include "include.h"
/**************************************************************************/
#define RSWAP(a,b) {REAL rtmp = a; a = b ; b = rtmp; }
#define RPTRSWAP(a,b) {REAL *rtmp = a; a = b ; b = rtmp; }
#define ISWAP(a,b) {int rtmp = a; a = b ; b = rtmp; }
/* local prototypes to keep certain compilers happy */
struct xsorting { int inx; /* original row number */
REAL x; /* x value of vertex */
int ord; /* ordinal of vertex */
int deg; /* degree of freedom */
};
void sp_aug_solve ARGS(( struct linsys *,REAL *,REAL *,REAL *,REAL *,REAL *));
int xcomp ARGS((struct xsorting *, struct xsorting*));
void BK_hess_project ARGS(( struct linsys *,REAL *,REAL *x));
/***************************************************************************
*
* function: sp_aug_solve()
*
* purpose: common steps in Hessian solving.
*
*/
void sp_aug_solve(S,X,B,T1,T2,T3)
struct linsys *S;
REAL *X; /* incoming */
REAL *B; /* incoming rhs, possibly null */
REAL *T1,*T2,*T3; /* intermediates and final, preallocated */
{
if ( sparse_constraints_flag )
{ int i,j;
memset(T1,0,S->CN*sizeof(REAL));
for ( i = 0 ; i < S->CN ; i++ )
for ( j = S->CIA[i] ; j < S->CIA[i+1] ; j++ )
T1[i] += S->CA[j]*X[S->CJA[j]];
if ( B )
for ( i = 0 ; i < S->CN ; i++ )
T1[i] += B[i]; /* corrections */
#ifdef BLAS
if ( blas_flag )
LD_block_solve(S->CHinvCinv,T1,T2,S->CN);
else
#endif
matvec_mul(S->CHinvCinv,T1,T2,S->CN,S->CN);
memset(T3,0,S->N*sizeof(REAL));
for ( i = 0 ; i < S->CN ; i++ )
for ( j = S->CIA[i] ; j < S->CIA[i+1] ; j++ )
T3[S->CJA[j]] += S->CA[j]*T2[i];
sp_solution(S,T3,T3);
}
else
{ int i;
matvec_mul(S->C,X,T1,S->CN,S->N);
if ( B )
for ( i = 0 ; i < S->CN ; i++ )
T1[i] += B[i]; /* corrections */
#ifdef BLAS
if ( blas_flag )
LD_block_solve(S->CHinvCinv,T1,T2,S->CN);
else
#endif
matvec_mul(S->CHinvCinv,T1,T2,S->CN,S->CN); /* Lagrange multipliers */
vec_mat_mul(T2,S->HinvC,T3,S->CN,S->N);
}
}
/*******************************************************************
*
* function: bk_mul()
*
* purpose: multiply vector by original sparse matrix
*/
void bk_mul(S,w,v)
struct linsys *S;
REAL *w; /* in */
REAL *v; /* out */
{ int row,col,i;
PROF_START(hessian_mul);
memset((char*)v,0,S->N*sizeof(REAL));
for ( row = 0 ; row < S->N ; row++ )
{ for ( i = S->IA[row]-A_OFF ; i < S->IA[row+1]-A_OFF ; i++ )
{ col = S->JA[i] - A_OFF;
v[row] += S->A[i]*w[col];
if ( col != row ) v[col] += S->A[i]*w[row];
}
}
if ( (S->CN > 0) && S->CHinvCinv )
{ /* project back */
REAL *tempv = (REAL*)temp_calloc(2*S->N,sizeof(REAL));
REAL *tempvv = tempv + S->N;
sp_aug_solve(S,v,NULL,tempv,tempvv,tempv);
for ( i = 0 ; i < S->N ; i++ ) v[i] -= tempv[i];
temp_free((char*)tempv);
}
PROF_FINISH(hessian_mul);
} /* end bk_mul() */
/*******************************************************************
*
* function: free_system()
*
* purpose: free all memory allocated to linear system structure.
*/
void free_system(S)
struct linsys *S;
{
if ( S->IA ) temp_free((char*)S->IA);
if ( S->JA && !(S->flags & S_JA_INCLUDED) ) temp_free((char*)S->JA);
if ( S->A ) temp_free((char*)S->A);
if ( S->pIA ) temp_free((char*)S->pIA);
if ( S->pJA ) temp_free((char*)S->pJA);
if ( S->pA ) temp_free((char*)S->pA);
if ( S->P ) temp_free((char*)S->P);
if ( S->IP ) temp_free((char*)S->IP);
if ( S->ISP ) temp_free((char*)S->ISP);
if ( S->psize ) temp_free((char*)S->psize);
if ( S->LIA ) temp_free((char*)S->LIA);
if ( S->LJA ) temp_free((char*)S->LJA);
if ( S->LIJA ) temp_free((char*)S->LIJA);
if ( S->LA ) temp_free((char*)S->LA);
if ( S->CIA ) temp_free((char*)S->CIA);
if ( S->CJA ) temp_free((char*)S->CJA);
if ( S->CA ) temp_free((char*)S->CA);
if ( S->coninx ) temp_free((char*)S->coninx);
if ( S->coninxinv ) temp_free((char*)S->coninxinv);
if ( S->rowmag ) temp_free((char*)S->rowmag);
if ( S->apinv ) temp_free((char*)S->apinv);
if ( S->HinvC ) free_matrix(S->HinvC);
if ( S->CHinvCinv )
{ if ( blas_flag )
{ temp_free((char*)S->CHinvCinv[0]); temp_free((char*)S->CHinvCinv); }
else free_matrix(S->CHinvCinv);
}
if ( S->C ) { temp_free((char *)S->C[0]); temp_free((char*)S->C);}
if ( S->stree )
{ int k;
for ( k = 0 ; k <= S->streemax ; k++ )
{ if ( S->stree[k].u.info.mat)
{ temp_free((char*)S->stree[k].u.info.mat);
temp_free((char*)S->stree[k].u.info.vlist);
}
}
}
if ( S->low_rank_vectors ) free_matrix(S->low_rank_vectors);
if ( S->low_rank_form ) free_matrix(S->low_rank_form);
if ( S->low_rank_inverse_form ) free_matrix(S->low_rank_inverse_form);
memset((char*)S,0,sizeof(struct linsys));
} /* end free_system() */
/************************************************************************
*
* function: find_ordering()
*
* purpose: find order of vertex degree of freedom variables.
* Currently in x coordinate order. Not very useful.
* in: array Hessian data
* n total degrees
* out: P permutation vector, P[0] is first variable to do.
*/
/* comparison function for sorting */
int xcomp(a,b)
struct xsorting *a,*b;
{ if ( a->x < b->x ) return -1;
if ( a->x > b->x ) return 1;
if ( a->ord < b->ord ) return -1;
if ( a->ord > b->ord ) return 1;
if ( a->deg < b->deg ) return -1;
if ( a->deg > b->deg ) return 1;
return 0;
} /* end xcomp() */
void find_ordering(verlist,n,P)
struct hess_verlist *verlist; /* pointers to rows */
int n; /* size of system */
int *P; /* preallocated for return of permutation */
{
int i,j;
struct xsorting *xlist,*Bptr;
vertex_id v_id;
/* sort vertices in x order */
xlist = (struct xsorting *)temp_calloc(n,sizeof(struct xsorting));
for ( i = 0, Bptr = xlist ; i < n ; i++,Bptr++ ) Bptr->inx = i;
FOR_ALL_VERTICES(v_id)
{ struct hess_verlist *v; /* current vertex */
v = verlist + loc_ordinal(v_id);
Bptr = xlist + v->rownum;
for ( j = 0 ; j < v->freedom ; j++, Bptr++ )
{
Bptr->ord = loc_ordinal(v->v_id);
Bptr->deg = j;
Bptr->x = get_coord(v->v_id)[0];
}
}
qsort((char*)xlist,n,sizeof(struct xsorting),FCAST xcomp);
for ( i = 0 ; i < n ; i++ )
{ P[i] = xlist[i].inx + A_OFF;
}
temp_free((char*)xlist);
} /* end find_ordering() */
/**********************************************************************
*
* function: bk_AIJ_setup()
*
* purpose: convert raw Hessian data to standard sparse format
*
*/
void bk_AIJ_setup(N,S)
int N; /* size of system */
struct linsys *S; /* pointer to empty structure */
{
#ifdef OLDHASH
int i,j,n;
int total = 0;
struct hess_entry *e;
int spot;
int *ptr,*cptr,*dptr;
int isize,dsize;
PROF_START(hessian_AIJ_setup);
S->flags &= ~ S_ODRV_REORDERED;
S->flags |= S_JA_INCLUDED; /* S->JA not separately allocated */.
if ( augmented_hessian_mode )
N = total_rows;
S->N = N;
for ( i = 0 ; i < N ; i++ ) total += array[i].count;
/* incoming list of hess_entry structs is compacted in place */
isize = sizeof(int);
dsize = sizeof(REAL);
/* delete row numbers */
e = hashtable;
ptr = (int*)e;
if ( 2*isize == dsize )
for ( n = 0; n < total; n++,e++,ptr+=3 )
{ ptr[0] = ((int*)e)[0];
ptr[1] = ((int*)e)[1];
ptr[2] = e->col;
}
else if ( isize == dsize )
for ( n = 0; n < total; n++,e++,ptr+=2 )
{ ptr[0] = ((int*)e)[0];
ptr[1] = e->col;
}
else if ( 4*isize == dsize )
for ( n = 0; n < total; n++,e++,ptr+=5 )
{ ptr[0] = ((int*)e)[0];
ptr[1] = ((int*)e)[1];
ptr[2] = ((int*)e)[2];
ptr[3] = ((int*)e)[3];
ptr[4] = e->col;
}
else /* i.e. 10-byte long double */
{ char *p = (char*)ptr;
for ( n = 0; n < total; n++,e++,p+=dsize+isize )
{ *(REAL *)p = e->value;
*(int *)(p+dsize) = e->col;
}
ptr = (int *)p;
}
/* now extract cols to room at the end */
S->JA = cptr = ptr;
S->A = (REAL*)(hashtable);
hashtable = NULL;
ptr = (int*)(S->A);
dptr = ptr;
if ( 2*isize == dsize )
for ( n = 0 ; n < total; n++,dptr+=3,ptr+=2,cptr++)
{ ptr[0] = dptr[0];
ptr[1] = dptr[1];
*cptr = dptr[2]+A_OFF;
}
else if ( isize == dsize )
for ( n = 0 ; n < total; n++,dptr+=2,ptr+=1,cptr++)
{ ptr[0] = dptr[0];
*cptr = dptr[1]+A_OFF;
}
else if ( 4*isize == dsize )
for ( n = 0 ; n < total; n++,dptr+=5,ptr+=4,cptr++)
{ ptr[0] = dptr[0];
ptr[1] = dptr[1];
ptr[2] = dptr[2];
ptr[3] = dptr[3];
*cptr = dptr[4]+A_OFF;
}
else
{ char *p = (char *)ptr;
REAL *d = (REAL *)ptr;
for ( n = 0 ; n < total; n++,p+=isize+dsize,d++,cptr++ )
{ *d = *(REAL*)p;
*cptr = *(int*)(p+dsize)+A_OFF;
}
}
/* allocate other bits */
S->IA = (int *)temp_calloc(N+1,sizeof(int));
if ( S->P == NULL ) S->P = (int *)temp_calloc(N,sizeof(int));
if ( S->IP == NULL ) S->IP = (int *)temp_calloc(N,sizeof(int));
S->flags &= ~ S_ODRV_REORDERED;
for ( i = 0, spot = 0 ; i < N ; i++ )
{ S->IA[i] = spot + A_OFF;
spot += harray[i].count;
}
S->IA[N] = spot + A_OFF;
/* test for NaN's */
for ( i = 0 ; i < S->IA[S->N]-A_OFF ; i++ )
if ( !is_finite(S->A[i]) )
{ kb_error(1822,"NaNs in Hessian. Replacing with big value.\n",WARNING);
S->A[i] = 1e30;
}
PROF_FINISH(hessian_AIJ_setup);
#endif
} /* end bk_AIJ_setup() */
/**********************************************************************
*
* function: bk_constraint_setup()
*
* purpose: get matrices needed for handling constraints
*
*/
void bk_constraint_setup(concount,S)
int concount; /* number of constraints */
struct linsys *S;
{ int i,j;
PROF_START(hessian_constraint_setup);
if ( S->CN == 0 )
{ S->N = S->A_rows; goto debug_print; }
if ( S->A_rows < S->CN )
{ sprintf(errmsg,"Degrees of freedom, %d, fewer than constraints, %d.\n",
S->A_rows,S->CN);
kb_error(3382,errmsg,RECOVERABLE);
}
if ( augmented_hessian_mode )
{ /* Keeping constraints in sparse augmented hessian. */
/* So not much to do, except eliminate unused constraints, */
/* building constraint conversion index in the process, */
/* and make sure zero elements exist on diagonal for constraints. */
if ( S->A_rows + S->CN > S->maxN )
kb_error(2549,"Internal error: S->N got bigger than expected.\n",
RECOVERABLE);
S->N = S->A_rows + S->CN;
/* convert entries in S->JA */
for ( i = 0 ; i < S->IA[S->A_rows]-A_OFF ; i++ )
if ( S->JA[i]-A_OFF >= S->A_rows )
S->JA[i] = S->A_rows + S->coninx[S->JA[i]-A_OFF-S->A_rows] + A_OFF;
/* create diagonal for constraints */
for ( i = 1 ; i <= S->CN ; i++ )
{ S->IA[i+S->A_rows] = S->IA[i+S->A_rows-1] + 1;
S->JA[S->IA[i+S->A_rows-1]-A_OFF] = i + S->A_rows - 1 + A_OFF;
S->A[S->IA[i+S->A_rows-1]-A_OFF] = 0.0;
}
if ( S->IA[S->N] > S->maxA )
kb_error(2598,"Internal error: S->A got bigger than expected.\n",
RECOVERABLE);
}
else if ( sparse_constraints_flag )
{
/* Have to strip constraint gradients from A and put in CA */
int k,kk;
/* First, count entries for each constraint */
S->CIA = (int *)temp_calloc(concount+1,sizeof(int));
for ( i = S->A_rows ; i > 0 ; i-- )
{ for ( j = S->IA[i]-A_OFF - 1 ; j > S->IA[i-1]-A_OFF ; j-- )
if ( S->JA[j]-A_OFF >= S->A_rows )
S->CIA[S->JA[j]-A_OFF - S->A_rows]++;
else break;
}
/* Running totals to S->CIA */
for ( i = 0, j = 0 ; i < concount ; i++ )
{ int tmp = S->CIA[i];
S->CIA[i] = j;
j += tmp;
}
S->CJA = (int *)temp_calloc(j,sizeof(int));
S->CA = (REAL*)temp_calloc(j,sizeof(REAL));
for ( i = concount ; i > 0 ; i-- )
S->CIA[i] = S->CIA[i-1];
/* place constraint gradients and compact A,JA */
for ( i = 1, kk = 0, j = 0 ; i <= S->A_rows ; i++ )
{ for ( ; j < S->IA[i]-A_OFF ; j++ )
if ( S->JA[j]-A_OFF >= S->A_rows )
{ k = S->CIA[S->JA[j]-A_OFF-S->A_rows+1]++;
S->CJA[k] = i-1;
S->CA[k] = S->A[j];
}
else
{ S->JA[kk] = S->JA[j];
S->A[kk] = S->A[j];
kk++;
}
S->IA[i] = kk+A_OFF;
}
S->N = S->A_rows;
/* check the constraints we thought were going to be used actually are */
for ( i = 0 ; i < S->concount ; i++ )
{ /* a check on if any fixed constraints are null */
if ( (S->CIA[i] != S->CIA[i+1]) && (S->coninx[i] == -1) )
{ struct hess_verlist *vh = vhead + web.skel[VERTEX].max_ord+1+
optparamcount + i;
if ( valid_id(vh->v_id) )
sprintf(errmsg,
"Internal error: hessian setup skipped fixed body %s.\n",
ELNAME(vh->v_id));
else
sprintf(errmsg,
"Internal error: hessian setup skipped fixed quantity %s.\n",
GEN_QUANT(vh->v_id)->name);
kb_error(2552,errmsg,RECOVERABLE);
}
if ( (S->CIA[i] == S->CIA[i+1]) && (S->coninx[i] != -1) )
{ struct hess_verlist *vh = vhead + web.skel[VERTEX].max_ord+1+
optparamcount + i;
if ( valid_id(vh->v_id) )
sprintf(errmsg,
"Fixed body %s is not connected to any mobile vertices.\n",
ELNAME(vh->v_id));
else
sprintf(errmsg,
"Fixed quantity %s is not connected to any mobile vertices.\n",
GEN_QUANT(vh->v_id)->name);
kb_error(3362,errmsg,RECOVERABLE);
}
}
/* Strip out empty constraints */
for ( i = 0 ; i < S->CN ; i++ )
S->CIA[i+1] = S->CIA[S->coninxinv[i]+1];
}
else /* dense constraints */
{ int startj,newj;
S->C = (REAL**)temp_calloc(S->CN,sizeof(REAL*));
S->C[0] = (REAL*)temp_calloc(S->CN*S->N,sizeof(REAL));
for ( i = 1 ; i < S->CN ; i++ ) S->C[i] = S->C[0] + i*S->N;
for ( i = 0, startj = 0, newj = 0 ; i < S->N ; i++ )
{ /* fill in C (really C transpose) */
/* and compact JA, A */
for ( j = startj ; j < S->IA[i+1]-A_OFF ; j++ )
if ( S->JA[j]-A_OFF >= S->A_rows )
{ int row = S->coninx[S->JA[j]-A_OFF - S->A_rows];
S->C[row][i] = S->A[j];
}
else /* keep in A but move it down */
{ S->A[newj] = S->A[j];
S->JA[newj] = S->JA[j];
newj++;
}
startj = S->IA[i+1] - A_OFF; /* for next loop */
S->IA[i+1] = newj + A_OFF;
}
}
debug_print:
/* some debug printing */
if ( hess_debug )
{ vertex_id v_id;
printf("N = %d\n",S->N);
printf("IA: ");
for ( i = 0 ; i <= S->N ; i++ ) printf(" %d",S->IA[i]);
printf("\nJA: ");
for ( i = 0 ; i < S->IA[S->N]-A_OFF ; i++ ) printf(" %d",S->JA[i]);
printf("\n");
/* column labels */
MFOR_ALL_VERTICES(v_id)
{ struct hess_verlist *vh = get_vertex_vhead(v_id);
for ( j = 0 ; j < vh->freedom ; j++ )
{ sprintf(msg,"v%s.%d",ELNAME(v_id),j+1);
printf("%10s",msg);
}
}
for ( i = 0 ; i < optparamcount ; i++ )
printf("%10s",globals(optparam[i].pnum)->name);
if ( augmented_hessian_mode )
{ if ( !everything_quantities_flag )
{ for ( i = 0 ; i <= web.skel[BODY].max_ord ; i++ )
if ( S->coninx[i] >= 0 )
{ sprintf(msg,"b%d",i+1); printf("%10s",msg); }
for ( i = 0 ; i < gen_quant_count ; i++ )
if ( S->coninx[i + web.skel[BODY].max_ord+1] >= 0 )
{ sprintf(msg,"q%d",i+1); printf("%10s",msg); }
}
else /* just the quantities */
for ( i = 0 ; i < gen_quant_count ; i++ )
if ( S->coninx[i] >= 0 )
{ sprintf(msg,"q%d",i+1); printf("%10s",msg); }
}
printf("\n");
/* now the body of the sparse part of the hessian, just upper triangle */
for ( i = 0 ; i < S->N ; i++ )
{ int k,m;
for ( m = 0 ; m < i ; m++ ) printf(" ");
for ( m = i, k = S->IA[i]-A_OFF ; m < S->N ; m++ )
if ( (m == S->JA[k]-A_OFF) && (k < S->IA[i+1]-A_OFF) )
{ printf(" %9.6f",(DOUBLE)S->A[k]); k++; }
else printf(" %9.6f",0.0);
printf("\n");
}
/* Add on low-rank update */
if ( S->low_rank )
{
printf("With low-rank update: \n");
for ( i = 0 ; i < S->N ; i++ )
{ int k,m,ii,jj;
for ( m = 0 ; m < i ; m++ ) printf(" ");
for ( m = i, k = S->IA[i]-A_OFF ; m < S->N ; m++ )
{ REAL val;
if ( (m == S->JA[k]-A_OFF) && (k < S->IA[i+1]-A_OFF) )
{ val = S->A[k]; k++; }
else val = 0.0;
/* add low-rank stuff */
if ( m < S->low_rank_vecsize )
for ( ii = 0 ; ii < S->low_rank ; ii++ )
for ( jj = 0 ; jj < S->low_rank ; jj++ )
val += S->low_rank_vectors[ii][i]*S->low_rank_form[ii][jj]*
S->low_rank_vectors[jj][m];
printf(" %9.6f",(DOUBLE)val);
}
printf("\n");
}
}
if ( !augmented_hessian_mode )
{
printf("Constraints:\n");
if ( sparse_constraints_flag )
{ for ( i = 0 ; i < S->CN ; i++ )
{ int k = 0;
for ( j = S->CIA[i] ; j < S->CIA[i+1] ; j++ )
{ for ( ; k < S->CJA[j]-1 ; k++ ) printf("%9.6f ",0.0);
printf("%9.6f ",S->CA[j]);
k = S->CJA[j];
}
}
}
else
{
for ( i = 0 ; i < S->CN ; i++ )
{ printf("C%d:",i+1);
for ( j = 0 ; j < S->N ; j++ ) printf(" %9.6f",(double)(S->C[i][j]));
printf("\n");
}
}
printf("\n");
}
} /* end hess_debug */
PROF_FINISH(hessian_constraint_setup);
} /* end bk_constraint_setup */
/*********************************************************************
*
* function: BK_hess_project_setup()
*
* purpose: Set up projection to constraints using hessian metric.
* Forms S->HinvC and CHinvCinv, unless augmented_hessian
* is in effect.
*/
void BK_hess_project_setup(S)
struct linsys *S;
{ int i;
int con_index=0;
PROF_START(hessian_project_setup);
if ( S->CN == 0 ) goto set_counts;
if ( augmented_hessian_mode ) goto adjust_index;
if ( !sparse_constraints_flag )
{
/* HinvC */
if ( S->HinvC ) free_matrix(S->HinvC);
S->HinvC = dmatrix(0,S->CN-1,0,S->N-1);
for ( i = 0 ; i < S->CN ; i++ )
sp_solution(S,S->C[i],S->HinvC[i]);
}
if ( S->CHinvCinv ) free_matrix(S->CHinvCinv);
#ifdef BLAS
if ( blas_flag )
{ int fillsize = ((S->CN+BLAS_BLOCKSIZE)*(S->CN+BLAS_BLOCKSIZE+1))/2;
S->CHinvCinv = (REAL**)temp_calloc(S->CN,sizeof(REAL*));
S->CHinvCinv[0] = (REAL*)temp_calloc(fillsize,sizeof(REAL));
for ( i = 0 ; i < S->CN ; i += BLAS_BLOCKSIZE )
{ int j;
for ( j = i ; (j < i+BLAS_BLOCKSIZE) && (j < S->CN-1) ; j++ )
{
S->CHinvCinv[j+1] = S->CHinvCinv[j] + i + BLAS_BLOCKSIZE;
}
}
}
else
#endif
S->CHinvCinv = dmatrix(0,S->CN-1,0,S->CN-1);
if ( sparse_constraints_flag )
{
if ( sp_CHinvC_func == NULL )
kb_error(2445,"sparse_constraints need ysmp off (mindeg mode).\n",
RECOVERABLE);
(*sp_CHinvC_func)(S);
}
else
{
/* CHinvCinv */
#ifdef BLAS
if ( blas_flag )
{ for ( i = 0 ; i < S->CN ; i += BLAS_BLOCKSIZE )
{ int rowcount = (S->CN-i < BLAS_BLOCKSIZE) ? S->CN-i : BLAS_BLOCKSIZE;
int colcount = (S->CN < i+BLAS_BLOCKSIZE) ? S->CN : i+BLAS_BLOCKSIZE;
int transa = 'T';
int transb = 'N';
REAL alpha = 1.0;
REAL beta = 0.0;
int stridea = i+BLAS_BLOCKSIZE;
int strideb = S->C[1]-S->C[0]; /* WHoops! rows individually alloc! */
int stridec = S->CHinvCinv[1] - S->CHinvCinv[0];
mat_mul_tr(S->HinvC+i,S->C,S->CHinvCinv+i,rowcount,S->N,colcount);
/* DGEMM(&transa,&transb,&rowcount,&colcount,&S->N,&alpha,S->HinvC[i],
&stridea,S->C[0],&strideb,&beta,S->CHinvCinv[i],&stridec);
*/
}
}
else
#endif
mat_mul_tr(S->HinvC,S->C,S->CHinvCinv,S->CN,S->N,S->CN);
}
#ifdef BLAS
if ( blas_flag )
con_index = LD_block_factor(S->CHinvCinv,S->CN);
else
#endif
/* Kludge here since mat_inv() doesn't calculate index correctly */
/*
con_index = matrix_index(S->CHinvCinv,S->CN);
mat_inv(S->CHinvCinv,S->CN);
*/
con_index = mat_inv_sym(S->CHinvCinv,S->CN);
if ( con_index < 0 )
kb_error(1823,"Constraints not independent, or Hessian too singular.\n",
RECOVERABLE);
adjust_index:
/* adjust index for constraints */
if ( augmented_hessian_mode )
{ S->neg -= (S->CN - S->degencon);
S->pos -= (S->CN - S->degencon);
S->zero -= S->degencon;
}
else
{ S->neg -= con_index;
S->pos -= S->CN - con_index;
}
set_counts:
eigen_neg = S->neg; eigen_pos = S->pos;
PROF_FINISH(hessian_project_setup);
} /* end BK_hess_project_setup */
/*************************************************************************
*
* function: BK_hess_project()
*
* purpose: project vector onto constraints of system using Hessian metric
*
*/
void BK_hess_project(S,B,x)
struct linsys *S; /* factored and constrained system */
REAL *B; /* incoming vector */
REAL *x; /* solution, may be incoming */
{ REAL *T1,*T2,*T3;
int i;
if ( S->CN == 0 ) return;
T1 = (REAL *)temp_calloc(2*S->CN+S->N,sizeof(REAL));
T2 = T1 + S->CN;
T3 = T2 + S->CN;
sp_aug_solve(S,B,NULL,T1,T2,T3);
for ( i = 0 ; i < S->N ; i++ )
x[i] = B[i] - T3[i];
temp_free((char*)T1);
} /* end BK_hess_project */
/***********************************************************************
*
* function: lowest_eigenpair()
*
* purpose: find lowest eigenvalue and corresponding eigenvalue
*
* return: lowest eigenvalue;
*/
REAL lowest_eigenpair(S,v)
struct linsys *S;
REAL *v; /* eigenvector, preallocated */
{ REAL lo;
int old_quiet;
#ifdef XXX
REAL old_ev,new_ev;
int i;
int krydim = 20;
int nlook = 2;
REAL evalues[5];
REAL *vtmp = (REAL*)temp_calloc(S->N,sizeof(REAL));
#endif
/* find lower bound on lowest eigenvalue */
lo = -0.01;
S->lambda = lo;
sp_factor(S);
(*sp_hess_project_setup_func)(S);
while ( S->neg > 0)
{
S->lambda *= 10;
sp_factor(S);
(*sp_hess_project_setup_func)(S);
}
old_quiet = quiet_flag;
quiet_flag = 1;
do_ritz(S,S->lambda,1,&v);
quiet_flag = old_quiet;
return last_eigenvalue;
#ifdef XXX
//lanczos(S,krydim,evalues,nlook);
/* inverse iteration to find eigenvector */
S->lambda = evalues[0] - .0001;
sp_factor(S);
(*sp_hess_project_setup_func)(S);
for ( i = 0 ; i < S->N ; i++ ) v[i] = drand48();
old_ev = new_ev = 11231.0; /* weird number, nonzero */
do
{ sp_hessian_solve(S,v,vtmp,NO_SET_PRESSURE);
old_ev = new_ev;
new_ev = sqrt(dot(vtmp,vtmp,S->N));
for ( i = 0 ; i < S->N ; i++ ) v[i] = vtmp[i]/new_ev;
} while ( fabs(1/old_ev-1/new_ev) > 1000*machine_eps );
temp_free((char*)vtmp);
if ( S->zero != 0 ) last_eigenvalue = S->lambda;
else
last_eigenvalue = S->lambda + 1/new_ev;
return S->lambda + 1/new_ev;
#endif
} /* end lowest_eigenpair */
/***********************************************************************
*
* function: cg_lowest_eigenpair()
*
* purpose: find lowest eigenvalue and corresponding eigenvalue
* Uses conjugate gradient on sphere to minimize XHX
* Hessian_metric used.
*
* return: lowest eigenvalue;
*/
REAL old_cg_lowest_eigenpair(S,x)
struct linsys *S;
REAL *x; /* eigenvector, preallocated */
{ REAL norm_inv;
int i;
REAL *h=NULL; /* search direction */
REAL *ah=NULL;
REAL *f=NULL,*If=NULL; /* gradient of XAX, form and vector */
REAL *mx=NULL; /* MX */
REAL *mh=NULL; /* MH */
REAL cgamma; /* cg coefficient */
REAL xax,old_xax;
int count;
int maxcount;
char response[100];
REAL **CCinv=NULL;
REAL *Cf=NULL,*Gf=NULL;
h = (REAL *)temp_calloc(S->N,sizeof(REAL));
ah = (REAL *)temp_calloc(S->N,sizeof(REAL));
f = (REAL *)temp_calloc(S->N,sizeof(REAL));
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ mx = (REAL *)temp_calloc(S->N,sizeof(REAL));
mh = (REAL *)temp_calloc(S->N,sizeof(REAL));
}
if ( S->CN )
{ CCinv = dmatrix(0,S->CN,0,S->CN);
mat_mul_tr(S->C,S->C,CCinv,S->CN,S->N,S->CN);
mat_inv(CCinv,S->CN);
Cf = (REAL*)temp_calloc(S->CN,sizeof(REAL));
Gf = (REAL*)temp_calloc(S->CN,sizeof(REAL));
}
/* initial random guess */
for ( i = 0 ; i < S->N ; i++ ) x[i] = drand48() - .5;
/* project to constraints */
if ( S->CN )
{ matvec_mul(S->C,x,Cf,S->CN,S->N);
matvec_mul(CCinv,Cf,Gf,S->CN,S->CN);
for ( i = 0 ; i < S->CN ; i++ )
vector_add_smul(x,S->C[i],-Gf[i],S->N);
}
if ( web.area_norm_flag || hessian_linear_metric_flag )
norm_inv = 1/sqrt(sparse_metric_dot(x,x,&Met));
else norm_inv = 1/sqrt(dot(x,x,S->N));
for ( i = 0 ; i < S->N ; i++ ) x[i] *= norm_inv;
xax = 1e30; /* silly value for start of convergence test */
for(;;)
{ prompt("Enter max iterations: ",response,sizeof(response));
maxcount = atoi(response);
if ( maxcount == 0 ) break;
if ( maxcount < 0 ) { count = 0 ; maxcount = -maxcount; }
else count = 0;
do
{ REAL a,b,c,evalue,denom,q2,q1comp,hnorm,hnorm_inv;
old_xax = xax;
count++;
/* get cg search direction */
(*sp_mul_func)(S,x,f); /* AX */
xax = dot(x,f,S->N);
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,x,mx);
else mx = x;
for ( i = 0 ; i < S->N ; i++ ) f[i] -= xax*mx[i];
/* convert form f to vector If with cg metric I */
If = f;
/* project to constraints */
if ( S->CN )
{ matvec_mul(S->C,If,Cf,S->CN,S->N);
matvec_mul(CCinv,Cf,Gf,S->CN,S->CN);
for ( i = 0 ; i < S->CN ; i++ )
vector_add_smul(If,S->C[i],-Gf[i],S->N);
}
/* project If tangent to Steifel manifold */
if ( web.area_norm_flag || hessian_linear_metric_flag )
c = sparse_metric_dot(x,If,&Met);
else c = dot(x,If,S->N);
for ( i = 0 ; i < S->N ; i++ ) If[i] -= c*x[i];
/* compute Ah */
/* proper Hessian is A - XAX M */
(*sp_mul_func)(S,h,ah);
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,h,mh);
else mh = h;
for ( i = 0 ; i < S->N ; i++ ) ah[i] -= xax*mh[i];
/* compute gamma */
if ( count <= 1 ) cgamma = 0.0;
else
{ cgamma = -dot(If,ah,S->N)/dot(h,ah,S->N);
}
/* compute search direction */
for ( i = 0 ; i < S->N ; i++ ) h[i] = If[i] + cgamma*h[i];
if ( web.area_norm_flag || hessian_linear_metric_flag )
hnorm = sqrt(sparse_metric_dot(h,h,&Met));
else hnorm = sqrt(dot(h,h,S->N));
hnorm_inv = 1/hnorm;
/* recompute Ah */
(*sp_mul_func)(S,h,ah);
#ifdef XXX
projecting off XAX M seems to hurt
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,h,mh);
else mh = h;
for ( i = 0 ; i < S->N ; i++ ) ah[i] -= xax*mh[i];
#endif
/* find minimum along geodesic */
a = xax;
b = dot(x,ah,S->N)/hnorm;
c = dot(h,ah,S->N)/hnorm/hnorm;
evalue = 0.5*(a+c-sqrt((a-c)*(a-c)+4*b*b)); /* smallest ev */
denom = sqrt(b*b + (evalue - a)*(evalue - a));
if ( b < 0.0 ) denom = -denom;
q2 = (evalue - a)/denom;
q1comp = (evalue-a)*(evalue-a)/denom/(denom+b);
/* rotate h and x */
for ( i = 0 ; i < S->N ; i++ )
{ REAL xtmp = x[i]*hnorm;
REAL htmp = h[i]*hnorm_inv;
x[i] += -q1comp*x[i] + q2*htmp;
h[i] += -q2*xtmp -q1comp*h[i];
}
if ( (count < maxcount) && (maxcount > 5) && (count % (maxcount/5) == 0) )
{
#ifdef LONGDOUBLE
sprintf(msg,"%3d. %3.*Lg\n",count,DPREC,xax);
#else
sprintf(msg,"%3d. %3.17g\n",count,xax);
#endif
outstring(msg);
}
} while ( (fabs(xax - old_xax) > 10*machine_eps*fabs(xax)) && (countCN )
{ temp_free((char*)Gf);
temp_free((char*)Cf);
free_matrix(CCinv);
}
last_eigenvalue = xax;
return xax;
} /* end old_cg_lowest_eigenpair */
/***********************************************************************
*
* function: cg_lowest_eigenpair()
*
* purpose: find lowest eigenvalue and corresponding eigenvalue
* Uses conjugate gradient on sphere to minimize XHX
* Hessian_metric used.
*
* return: lowest eigenvalue;
*/
REAL cg_lowest_eigenpair(S,x)
struct linsys *S;
REAL *x; /* eigenvector, preallocated */
{ REAL norm_inv;
int i,j;
REAL *h; /* search direction */
REAL *ah; /* (A-XAX M)H */
REAL *ax; /* AX */
REAL *mx; /* MX */
REAL *mh; /* MH */
REAL xax,old_xax;
int count;
int maxcount;
char response[100];
REAL *Cf,*Gf;
REAL **P; /* matrix of coeff for Lagrange mult */
REAL **Pinv; /* inverse of P */
h = (REAL *)temp_calloc(S->N,sizeof(REAL));
ah = (REAL *)temp_calloc(S->N,sizeof(REAL));
ax = (REAL *)temp_calloc(S->N,sizeof(REAL));
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ mx = (REAL *)temp_calloc(S->N,sizeof(REAL));
mh = (REAL *)temp_calloc(S->N,sizeof(REAL));
}
else { mx = x; mh = h; }
P = dmatrix(0,S->CN+1,0,S->CN+1);
Pinv = dmatrix(0,S->CN+1,0,S->CN+1);
Cf = (REAL*)temp_calloc(S->CN+2,sizeof(REAL));
Gf = (REAL*)temp_calloc(S->CN+2,sizeof(REAL));
if ( S->CN )
{ /* CGC goes in upper left corner of P */
mat_mul_tr(S->C,S->C,P,S->CN,S->N,S->CN);
}
/* initial random guess */
for ( i = 0 ; i < S->N ; i++ ) x[i] = drand48() - .5;
/* project to constraints */
if ( S->CN )
{ matvec_mul(S->C,x,Cf,S->CN,S->N);
matcopy(Pinv,P,S->CN,S->CN);
mat_inv(Pinv,S->CN);
matvec_mul(Pinv,Cf,Gf,S->CN,S->CN);
for ( i = 0 ; i < S->CN ; i++ )
vector_add_smul(x,S->C[i],-Gf[i],S->N);
}
if ( web.area_norm_flag || hessian_linear_metric_flag )
norm_inv = 1/sqrt(sparse_metric_dot(x,x,&Met));
else norm_inv = 1/sqrt(dot(x,x,S->N));
for ( i = 0 ; i < S->N ; i++ ) x[i] *= norm_inv;
xax = 1e30; /* silly value for start of convergence test */
for(;;)
{ prompt("Enter max iterations: ",response,sizeof(response));
maxcount = atoi(response);
if ( maxcount == 0 ) break;
if ( maxcount < 0 ) { count = 0 ; maxcount = -maxcount; }
else count = 0;
do
{ REAL a,b,c,evalue,denom,q2,q1comp,hnorm,hnorm_inv;
int pdim;
old_xax = xax;
count++;
/* get cg search direction */
/* calculate needed vectors */
/* MX */
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,x,mx);
/* MH */
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,h,mh);
/* (A - XAX M)X */
(*sp_mul_func)(S,x,ax);
xax = dot(x,ax,S->N);
for ( i = 0 ; i < S->N ; i++ ) ax[i] -= xax*mx[i];
/* (A - XAX M)H */
(*sp_mul_func)(S,h,ah);
for ( i = 0 ; i < S->N ; i++ ) ah[i] -= xax*mh[i];
/* fill in P, which already has CGC in upper left */
if ( S->CN > 0 )
{ matvec_mul(S->C,mx,P[S->CN],S->CN,S->N);
matvec_mul(S->C,ah,P[S->CN+1],S->CN,S->N);
}
P[S->CN][S->CN] = dot(mx,mx,S->N);
P[S->CN+1][S->CN] = dot(ah,mx,S->N);
#ifdef SYMMETRICWAY
/* this way takes twice as long */
P[S->CN+1][S->CN+1] = dot(ah,ah,S->N);
for ( i = 0 ; i <= S->CN ; i++ )
for ( j = S->CN ; j < S->CN+2 ; j++ )
P[i][j] = P[j][i];
#else
P[S->CN+1][S->CN+1] = dot(ah,h,S->N);
P[S->CN][S->CN+1] = dot(mx,h,S->N);
for ( j = 0 ; j < S->CN ; j++ )
P[j][S->CN+1] = dot(h,S->C[j],S->N);
#endif
/* fill in right side */
if ( S->CN > 0 ) matvec_mul(S->C,ax,Cf,S->CN,S->N);
Cf[S->CN] = dot(mx,ax,S->N);
Cf[S->CN+1] = dot(ah,ax,S->N);
/* solve */
pdim = S->CN + ( count<=1 ? 1 : 2 );
matcopy(Pinv,P,pdim,pdim);
mat_inv(Pinv,pdim);
matvec_mul(Pinv,Cf,Gf,pdim,pdim);
/* compute new search direction h */
for ( i = 0 ; i < S->N ; i++ )
{
#ifdef SYMMETRICWAY
if ( count > 1 ) h[i] = -Gf[S->CN+1]*ah[i]; else h[i] = 0.0;
#else
if ( count > 1 ) h[i] = -Gf[S->CN+1]*h[i]; else h[i] = 0.0;
#endif
h[i] += ax[i] - Gf[S->CN]*mx[i];
for ( j = 0 ; j < S->CN ; j++ )
h[i] -= Gf[j]*S->C[j][i];
}
/* recompute Ah */
(*sp_mul_func)(S,h,ah);
if ( web.area_norm_flag || hessian_linear_metric_flag )
hnorm = sqrt(sparse_metric_dot(h,h,&Met));
else hnorm = sqrt(dot(h,h,S->N));
hnorm_inv = 1/hnorm;
/* find minimum along geodesic */
a = xax;
b = dot(x,ah,S->N)/hnorm;
c = dot(h,ah,S->N)/hnorm/hnorm;
evalue = 0.5*(a+c-sqrt((a-c)*(a-c)+4*b*b)); /* smallest ev */
denom = sqrt(b*b + (evalue - a)*(evalue - a));
if ( b < 0.0 ) denom = -denom;
q2 = (evalue - a)/denom;
q1comp = (evalue-a)*(evalue-a)/denom/(denom+b);
/* rotate h and x */
for ( i = 0 ; i < S->N ; i++ )
{ REAL xtmp = x[i]*hnorm;
REAL htmp = h[i]*hnorm_inv;
x[i] += -q1comp*x[i] + q2*htmp;
h[i] += -q2*xtmp -q1comp*h[i];
}
if ( (count < maxcount) && (maxcount > 5) && (count % (maxcount/5) == 0) )
{
#ifdef LONGDOUBLE
sprintf(msg,"%3d. %3.*Lg\n",count,DPREC,xax);
#else
sprintf(msg,"%3d. %3.17g\n",count,xax);
#endif
outstring(msg);
}
} while ( (fabs(xax - old_xax) > 10*machine_eps*fabs(xax)) && (countN);
ah = dmatrix(0,n-1,0,S->N);
f = dmatrix(0,n-1,0,S->N);
Q = dmatrix(0,n-1,0,S->N);
hx = dmatrix(0,2*n-1,0,S->N);
xh = (REAL**)temp_calloc(2*n,sizeof(REAL*));
work = (REAL*)temp_calloc(2*n,sizeof(REAL));
for ( i = 0 ; i < n ; i++ ) { xh[i] = x[i]; xh[i+n] = Q[i]; }
NN = dmatrix(0,n-1,0,n-1);
L = dmatrix(0,n-1,0,n-1);
Linv = dmatrix(0,n-1,0,n-1);
B = dmatrix(0,2*n-1,0,2*n-1);
xax = B;
hax = B+n;
xah = (REAL**)temp_calloc(n,sizeof(REAL*));
hah = (REAL**)temp_calloc(n,sizeof(REAL*));
for ( j = 0 ; j < n ; j++ ) { xah[j] = B[j]+n; hah[j] = B[j+n]+n; }
evalues = (REAL *)temp_calloc(2*n,sizeof(REAL));
evectors = dmatrix(0,2*n-1,0,2*n-1);
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ mx = dmatrix(0,n-1,0,S->N);
mh = dmatrix(0,n-1,0,S->N);
}
if ( S->CN )
{ CCinv = dmatrix(0,S->CN,0,S->CN);
mat_mul_tr(S->C,S->C,CCinv,S->CN,S->N,S->CN);
mat_inv(CCinv,S->CN);
Cf = dmatrix(0,S->CN-1,0,n-1);
Gf = dmatrix(0,S->CN-1,0,n-1);
}
/* initial random guess */
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->N ; i++ ) x[j][i] = drand48() - .5;
/* project to constraints */
if ( S->CN )
{ mat_mul_tr(S->C,x,Cf,S->CN,S->N,n);
mat_mult(CCinv,Cf,Gf,S->CN,S->CN,n);
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->CN ; i++ )
vector_add_smul(x[j],S->C[i],-Gf[i][j],S->N);
}
/* project to Steifel manifold XMX = I */
LQ_decomp(x,n,S->N,x,L,M);
trxax = 1e30; /* silly value for start of convergence test */
for(;;)
{ prompt("Enter max iterations: ",response,sizeof(response));
maxcount = atoi(response);
if ( maxcount == 0 ) break;
if ( maxcount < 0 ) { count = 0 ; maxcount = -maxcount; }
else count = 0;
do
{ REAL denom;
old_trxax = trxax;
count++;
/* get cg search direction */
for ( j = 0 ; j < n ; j++ )
(*sp_mul_func)(S,x[j],f[j]); /* AX */
mat_mul_tr(x,f,xax,n,S->N,n);
if ( web.area_norm_flag || hessian_linear_metric_flag )
for ( j = 0 ; j < n ; j++ )
(*sp_mul_func)(&Met,x[j],mx[j]);
else mx = x;
mat_mult(xax,mx,ah,n,n,S->N); /* ah just used as temp */
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->N ; i++ ) f[j][i] -= ah[j][i];
/* convert form f to vector If with cg metric I */
If = f;
/* project to constraints */
if ( S->CN )
{ mat_mul_tr(S->C,If,Cf,S->CN,S->N,n);
mat_mult(CCinv,Cf,Gf,S->CN,S->CN,n);
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->CN ; i++ )
vector_add_smul(If[j],S->C[i],-Gf[i][j],S->N);
}
/* project If tangent to Steifel manifold */
mat_mul_tr(mx,If,NN,n,S->N,n);
tr_mat_mul(NN,x,ah,n,n,S->N);
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->N ; i++ ) If[j][i] -= ah[j][i];
if ( count <= 1 ) cgamma = 0.0;
else
{ /* proper Hessian is A - XAX M */
REAL numer;
for ( j = 0 ; j < n ; j++ )
(*sp_mul_func)(S,h[j],ah[j]);
if ( web.area_norm_flag || hessian_linear_metric_flag )
for ( j = 0 ; j < n ; j++ )
(*sp_mul_func)(&Met,h[j],mh[j]);
else mh = h;
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->N ; i++ )
for ( k = 0 ; k < n ; k++ ) ah[j][i] -= xax[j][k]*mh[k][i];
for ( j = 0, numer = denom = 0.0 ; j < n ; j++ )
{ numer += dot(If[j],ah[j],S->N);
denom += dot(h[j],ah[j],S->N);
}
cgamma = -numer/denom;
}
for ( j = 0 ; j < n ; j++ )
for ( i = 0 ; i < S->N ; i++ ) h[j][i] = If[j][i] + cgamma*h[j][i];
/* normalize h to be orthonormal wrt M, hMh = I */
LQ_decomp(h,n,S->N,Q,L,M);
matcopy(Linv,L,n,n);
mat_inv(Linv,n);
/* compute Ah */
for ( j = 0 ; j < n ; j++ )
(*sp_mul_func)(S,h[j],ah[j]);
/* load up matrix */
/* B = | xax xah | */
/* | hax hah | */
mat_mul_tr(h,ah,hah,n,S->N,n);
mat_mult(Linv,hah,NN,n,n,n);
mat_mul_tr(NN,Linv,hah,n,n,n);
mat_mul_tr(Q,f,hax,n,S->N,n);
for ( i = 0 ; i < n ; i++ )
for ( j = 0 ; j < n ; j++ )
xah[i][j] = hax[j][i];
jacobi_eigenpairs(B,2*n,evalues,evectors,work);
/* returns eigenvectors in columns of evectors, in descending order */
/* use lowest n eigenvectors */
for ( j = n, trxax = 0.0; j < 2*n ; j++ ) trxax += evalues[j];
/* rotate h and x */
tr_mat_mul(evectors,xh,hx,2*n,2*n,S->N);
matcopy(x,hx+n,n,S->N);
mat_mult(L,hx,h,n,n,S->N);
if ( (count < maxcount) && (maxcount > 5) && (count % (maxcount/5) == 0) )
{ sprintf(msg,"%3d. ",count);
for ( j = 0 ; (j < 4)&&(j 10*machine_eps*fabs(trxax)) && (countzero != 0 ) last_eigenvalue = S->lambda;
else
last_eigenvalue = evalues[0];
free_matrix(h);
free_matrix(ah);
free_matrix(hx);
free_matrix(f);
free_matrix(B);
free_matrix(L);
free_matrix(Q);
free_matrix(Linv);
temp_free((char*)hah);
temp_free((char*)xah);
temp_free((char*)evalues);
temp_free((char*)work);
free_matrix(evectors);
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ free_matrix(mx);
free_matrix(mh);
}
if ( S->CN )
{ free_matrix(Gf);
free_matrix(Cf);
free_matrix(CCinv);
}
} /* end cg_ritz() */
/************************************************************************
*
* function: sp_hessian_solve()
*
* purpose: solve hessian with constraints
*
*/
void sp_hessian_solve(S,rhs,X,set_pressure_flag)
struct linsys *S;
REAL *rhs;
REAL *X; /* solution */
int set_pressure_flag; /* whether to set body pressures */
{ /* solve stuff */
int i,j,ii,jj;
REAL *T1,*T2,*T3;
body_id b_id;
struct gen_quant*q;
if ( (S->CN > 0) && augmented_hessian_mode )
{ /* Kludge since volume deltas got in with wrong sign */
for ( i = S->N - S->CN ; i < S->N ; i++ )
rhs[i] = - rhs[i];
}
sp_solution(S,rhs,X);
/* check decrease in residual */
if ( itdebug || hess_debug )
{ REAL *xrhs = (REAL *)temp_calloc(S->maxN,sizeof(REAL));
REAL rhsmag = 0.0;
REAL resmag = 0.0;
sp_hessian_mult(S,X,xrhs);
for ( i = 0 ; i < S->N ; i++ )
{ rhsmag += rhs[i]*rhs[i];
resmag += (rhs[i] - xrhs[i])*(rhs[i] - xrhs[i]);
}
if ( resmag > rhsmag/10 )
{ sprintf(errmsg,"Hessian solve only reduced residual from %g to %g.\n",
sqrt(rhsmag),sqrt(resmag));
kb_error(2561,errmsg,WARNING);
}
temp_free((char*)xrhs);
}
if ( S->CN > 0 ) /* have constraints */
{ if ( augmented_hessian_mode )
{ /* remap Lagrange multipliers*/
for ( i = 0 ; i < S->concount ; i++ )
if ( S->coninx[i] >= 0 )
pressures[i] = -X[S->N - S->CN + S->coninx[i]];
}
else
{ REAL *con_rhs = (REAL*)temp_calloc(S->CN,sizeof(REAL));
for ( i = 0 ; i < S->concount ; i++ )
{ j = S->coninx[i];
if ( j >= 0 ) con_rhs[j] = rhs[S->N+i];
}
T1 = (REAL*)temp_calloc(S->CN,sizeof(REAL));
T2 = (REAL*)temp_calloc(S->CN,sizeof(REAL));
T3 = (REAL*)temp_calloc(S->N,sizeof(REAL));
sp_aug_solve(S,X,con_rhs,T1,T2,T3);
for ( i = 0 ; i < S->N ; i++ )
X[i] -= T3[i];
for ( i = 0 ; i < S->CN ; i++ ) con_rhs[i] = -T2[i];
/* remap Lagrange multipliers*/
for ( i = 0 ; i < S->concount ; i++ )
if ( S->coninx[i] >= 0 )
pressures[i] = con_rhs[S->coninx[i]];
temp_free((char*)T1);
temp_free((char*)T2);
temp_free((char*)T3);
temp_free((char*)con_rhs);
}
if ( set_pressure_flag == SET_PRESSURE )
{ if ( ! everything_quantities_flag )
FOR_ALL_BODIES(b_id)
{ REAL p = get_body_pressure(b_id)+pressures[loc_ordinal(b_id)];
set_body_pressure(b_id,p);
}
for ( i = 0 ; i < gen_quant_count ; i++ )
{ q = GEN_QUANT(i);
if ( q->flags & (Q_FIXED|Q_CONSERVED) )
{ q->pressure += pressures[everything_quantities_flag ? i :
web.skel[BODY].max_ord+1+i];
if ( valid_id(q->b_id) )
set_body_pressure(q->b_id,q->pressure);
}
}
}
}
if ( hess_debug )
{
#ifdef MPI_EVOLVER
for ( ii = 0 ; ii < S->N ; ii++ )
printf(" %20.15f X[%d] \n",(DOUBLE)X[ii],ii);
#else
vertex_id v_id;
MFOR_ALL_VERTICES(v_id)
{ struct hess_verlist *vh = get_vertex_vhead(v_id);
for ( j = 0 ; j < vh->freedom ; j++ )
{ ii = vh->rownum+j;
printf(" %20.15f X[%d] v%d.%d\n",(DOUBLE)X[ii],ii,ordinal(v_id)+1,j+1);
}
}
#endif
for ( i = 0 ; i < optparamcount ; i++ )
{ ii = optparam[i].pnum;
jj = optparam[i].rownum;
printf(" %f X[%d] %s\n",(DOUBLE)X[jj],jj,globals(ii)->name);
}
}
} /* end sp_hessian_solve */
/************************************************************************
*
* function: sp_hessian_solve_multi()
*
* purpose: solve hessian with constraints for multiple rhs
*
*/
void sp_hessian_solve_multi(S,rhs,X,rk)
struct linsys *S;
REAL **rhs;
REAL **X; /* solution */
int rk; /* number of right sides */
{ /* solve stuff */
int k;
for ( k = 0 ; k < rk ; k++ )
sp_hessian_solve(S,rhs[k],X[k],0);
#ifdef oldstuff
(*sp_solve_multi_func)(S,rhs,X,rk);
if ( S->CN > 0 ) /* have constraints */
{ REAL **con_rhs = dmatrix(0,rk-1,0,S->CN);
for ( i = 0 ; i < S->concount ; i++ )
{ int j = S->coninx[i];
if ( j >= 0 )
for ( k = 0 ; k < rk ; k++ ) con_rhs[k][j] = rhs[k][S->N+i];
}
T1 = (REAL*)temp_calloc(S->CN,sizeof(REAL));
T2 = (REAL*)temp_calloc(S->CN,sizeof(REAL));
T3 = (REAL*)temp_calloc(S->N,sizeof(REAL));
for ( k = 0 ; k < rk ; k++ )
{
matvec_mul(S->C,X[k],T1,S->CN,S->N);
for ( i = 0 ; i < S->CN ; i++ )
T1[i] += con_rhs[k][i]; /* corrections */
#ifdef BLAS
if ( blas_flag )
LD_block_solve(S->CHinvCinv,T1,T2,S->CN);
else
#endif
matvec_mul(S->CHinvCinv,T1,T2,S->CN,S->CN); /* Lagrange multipliers */
vec_mat_mul(T2,S->HinvC,T3,S->CN,S->N);
for ( i = 0 ; i < S->N ; i++ )
X[k][i] -= T3[i];
for ( i = 0 ; i < S->CN ; i++ ) con_rhs[k][i] = -T2[i];
}
/* conrhs not used?? */
temp_free((char*)T1);
temp_free((char*)T2);
temp_free((char*)T3);
free_matrix(con_rhs);
}
#endif
} /* end sp_hessian_solve_multi */
/*******************************************************************************
*
* function: bk_eigenprobe()
*
* purpose: find number of eigenvalues less than, equal, or greater than
* desired value. Asks user for probe values.
*/
void bk_eigenprobe(S)
struct linsys *S;
{
for(;;)
{ char response[100];
prompt("Enter probe value: ",response,sizeof(response));
if ( (response[0] == 0) || (response[0] == 'q') ) break;
S->lambda = atof(response);
sp_factor(S);
(*sp_hess_project_setup_func)(S);
sprintf(msg,"Eigencounts: %d <, %d ==, %d > \n",S->neg,S->zero,S->pos);
outstring(msg);
}
return;
} /* end bk_eigenprobe */
/*******************************************************************************
*
* function: bk_inverse_it()
*
* purpose: Find eigenvector near probe value.
*/
void bk_inverse_it(S,V)
struct linsys *S;
REAL *V; /* for eigenvector return */
{ int i,ii,k,its;
REAL t,oldt;
char response[100];
REAL *W = NULL, *WW = NULL; /* for use when metric is needed */
prompt("Enter probe value: ",response,sizeof(response));
if ( (response[0] == 0) || (response[0] == 'q') ) return;
S->lambda = atof(response);
sp_factor(S);
(*sp_hess_project_setup_func)(S);
sprintf(msg,"Eigencounts: %d <, %d ==, %d > \n",S->neg,S->zero,S->pos);
outstring(msg);
if ( web.area_norm_flag || hessian_linear_metric_flag )
W = (REAL*)temp_calloc(S->N,sizeof(REAL));
/* inverse iteration */
/* random starting vector */
for ( i = 0 ; i < S->N ; i++ ) V[i] = drand48();
t = 1/sqrt(dot(V,V,S->N));
for ( i = ii = 0 ; i < S->N ; i++,ii++ ) V[i] *= t;
prompt("Enter maximum iterations: ",response,sizeof(response));
its = atoi(response);
if ( its == 0 ) goto afterits;
oldt = 1e30; /* for convergence test */
for ( k = 0, ii=0 ; k < its ; k++,ii++ )
{ REAL oldv0=1.0; /* for sign */
int oldvi=0; /* index of nonzero component */
REAL eps = 1/sqrt((REAL)(S->N))/2;
for ( i = 0, oldv0 = 0.0 ; i < S->N ; i++ )
if ( fabs(V[i]) > eps ) { oldvi = i; oldv0 = V[i]; break; }
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ (*sp_mul_func)(&Met,V,W); WW = W; }
else WW = V;
sp_hessian_solve(S,WW,V,NO_SET_PRESSURE);
if ( web.area_norm_flag || hessian_linear_metric_flag )
t = 1/sqrt(sparse_metric_dot(V,V,&Met));
else t = 1/sqrt(dot(V,V,S->N));
if ( V[oldvi]*oldv0 < 0. ) t = -t; /* get sign right */
#ifdef LONGDOUBLE
if ( k % 10 == 0 ) printf("%d ev = %*.*Lf\n",k,DWIDTH,DPREC,S->lambda+t);
#else
if ( k % 10 == 0 ) printf("%d ev = %20.15f\n",k,S->lambda+t);
#endif
for ( i = 0 ; i < S->N ; i++ ) V[i] *= t;
if ( fabs(t-oldt) <= 100*machine_eps*fabs(t) )
{ /* does twice as many iterations as needed to get t converged */
/* so eigenvector gets fully converged also */
ii -= 2;
if ( ii <= 0 )break;
}
oldt = t;
}
#ifdef LONGDOUBLE
printf("%d ev = %*.*Lf\n",k,DWIDTH,DPREC,S->lambda+t);
#else
printf("%d ev = %20.15f\n",k,S->lambda+t);
#endif
afterits:
if ( web.area_norm_flag || hessian_linear_metric_flag )
temp_free((char*)W);
return;
} /* end bk_inverse_it() */
/*************************************************************************
*
* function: sp_Hessian_solver()
*
* purpose; Set up and solve sparse Hessian with given right hand side.
*/
void sp_Hessian_solver(S,rhs,Xptr)
struct linsys *S; /* system */
REAL *rhs; /* right side */
REAL **Xptr; /* returned vector */
{
REAL *X;
if ( *Xptr == NULL )
*Xptr = (REAL*)temp_calloc(S->N,sizeof(REAL));
X = *Xptr;
(*sp_AIJ_setup_func)(S->A_rows,S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,S);
if ( sp_ordering_func ) (*sp_ordering_func)(S);
sp_factor(S);
(*sp_hess_project_setup_func)(S);
if ( hess_debug )
{ int i;
puts("rhs:");
for ( i = 0 ; i < S->N ; i++ ) printf("%g \n",(DOUBLE)rhs[i]);
}
sp_hessian_solve(S,rhs,X,SET_PRESSURE);
if ( S->neg > 0 )
{ sprintf(msg,"Hessian not positive definite. Index: %d\n",S->neg);
kb_error(1825,msg,WARNING);
}
if ( hess_debug )
{ int i;
REAL *out = (REAL*)temp_calloc(S->N,sizeof(REAL));
puts("X:");
for ( i = 0 ; i < S->N ; i++ ) printf("%g \n",(DOUBLE)X[i]);
bk_mul(S,X,out);
puts("check:");
for ( i = 0 ; i < S->N ; i++ ) printf("%g \n",(DOUBLE)out[i]);
temp_free((char*)out);
}
} /* end sp_hessian_solver() */
/**************************************************************************
*
* function: sparse_metric_dot()
*
* purpose: Take dot product of vectors when metric is sparse linear system.
* Metric sparse storage has diagonal element first in each row.
*
*/
REAL sparse_metric_dot(u,v,M)
REAL *u,*v; /* the vectors to be dotted */
struct linsys *M; /* the metric */
{ int i,j,end;
REAL sum;
sum = 0.0;
for ( i = 0 ; i < M->N ; i++ )
{ j = M->IA[i]-A_OFF;
end = M->IA[i+1]-A_OFF;
sum += M->A[j]*u[i]*v[i];
for ( j++ ; j < end ; j++ )
{ int ii = M->JA[j]-A_OFF;
sum += M->A[j]*(u[i]*v[ii] + u[ii]*v[i]);
}
}
return sum;
} /* end sparse_metric_dot() */
/*************************************************************************
*
* function: sp_CHinvC()
*
* purpose: Find inner product of matrix using hessian inverse as metric.
* C stored sparsely in S.
*
* Want to use sparsity in case of large CN. So solve H X = C
* for one constraint at a time, and sparse-multiply the result
* by the rest of the constraint rows. Avoids forming full
* CN x N matrix.
*/
void sp_CHinvC(S)
struct linsys *S; /* factored system */
{
int n; /* row index */
int i,j,k;
REAL *BB,*Y;
if ( S->P == NULL )
kb_error(2530,"Internal error: Must call sp_factor before sp_CHinvC.\n",
RECOVERABLE);
BB = (REAL*)temp_calloc(S->N,sizeof(REAL)); /* expanded rhs */
Y = (REAL*)temp_calloc(S->N,sizeof(REAL)); /* solution */
for ( i = 0 ; i < S->CN ; i++ )
{
/* solve H Y = C */
memset(BB,0,S->N*sizeof(REAL));
for ( n = S->CIA[i] ; n < S->CIA[i+1] ; n++ )
BB[S->CJA[n]] = S->CA[n];
sp_solution(S,BB,Y);
/* multiply by rows of C */
for ( j = 0 ; j <= i ; j++ )
{ REAL sum;
for ( k = S->CIA[j] , sum = 0.0 ; k < S->CIA[j+1] ; k++ )
sum += S->CA[k]*Y[S->CJA[k]];
S->CHinvCinv[i][j] = sum;
if ( ! blas_flag )
S->CHinvCinv[j][i] = sum; /* symmetric */
}
}
temp_free((char*)BB);
temp_free((char*)Y);
}
/*************************************************************************
*
* function: sp_solution()
*
* purpose: solve system possibly in sparse + low rank update
*/
void sp_solution(S,rhs,X)
struct linsys *S; /* factored sparse matrix */
REAL *rhs; /* right side */
REAL *X; /* for solution */
{
REAL *Y; /* working full-size vector */
REAL *Z; /* low rank working vector */
REAL *W; /* low rank working vector */
int i;
if ( S->low_rank == 0 )
{ /* no low-rank update */
(*sp_solve_func)(S,rhs,X);
return;
}
/* rest is solution of system with low rank update */
Y = (REAL*)temp_calloc(S->N,sizeof(REAL));
Z = (REAL*)temp_calloc(S->low_rank, sizeof(REAL));
W = (REAL*)temp_calloc(S->low_rank, sizeof(REAL));
(*sp_solve_func)(S,rhs,Y);
matvec_mul(S->low_rank_vectors,Y,Z,S->low_rank,S->low_rank_vecsize);
matvec_mul(S->low_rank_form,Z,W,S->low_rank,S->low_rank);
matvec_mul(S->low_rank_inverse_form,W,Z,S->low_rank,S->low_rank);
vec_mat_mul(Z,S->low_rank_vectors,Y,S->low_rank,S->low_rank_vecsize);
for ( i = 0 ; i < S->low_rank_vecsize ; i++ )
Y[i] = rhs[i] - Y[i];
for ( ; i < S->N ; i++ )
Y[i] = rhs[i];
(*sp_solve_func)(S,Y,X);
temp_free((char*)Y);
temp_free((char*)Z);
temp_free((char*)W);
}
/**************************************************************************
*
* function: sp_factor()
*
* purpose: factor sparse matrix, and set up low-rank corrections if present.
*
*/
void sp_factor(S)
struct linsys *S;
{
(*sp_factor_func)(S); /* factor just the matrix */
if ( S->low_rank )
{ REAL **W = dmatrix(0,S->low_rank-1,0,S->N-1);
REAL **Z = dmatrix(0,S->low_rank-1,0,S->low_rank-1);
int i;
(*sp_solve_multi_func)(S,S->low_rank_vectors,W,S->low_rank);
mat_mul_tr(S->low_rank_vectors,W,Z,S->low_rank,S->low_rank_vecsize,
S->low_rank);
mat_mult(S->low_rank_form,Z,S->low_rank_inverse_form,S->low_rank,
S->low_rank,S->low_rank);
for ( i = 0 ; i < S->low_rank ; i++ )
S->low_rank_inverse_form[i][i] += 1;
mat_inv(S->low_rank_inverse_form,S->low_rank);
free_matrix(W);
free_matrix(Z);
}
} /* end sp_factor() */
evolver-2.30c.dfsg/src/check.c 0000644 0001753 0001753 00000076302 11410765113 016446 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/***********************************************************************
*
* File: check.c
*
* Contents: Various integrity and consistency checks.
*
*/
#include "include.h"
/* maximum errors of any type before aborting */
#define MAXERR 20
int wrap_check ARGS((void));
int check_body_facets ARGS((void));
/*********************************************************************
*
* Function: run_checks()
*
* Purpose: Overall control of checking.
*/
int run_checks()
{
int numerr = 0;
if ( memdebug ) memory_report();
numerr += list_check();
if ( web.representation != SIMPLEX )
{ numerr += facetedge_check(REGCHECK);
if ( web.skel[BODY].count > 0 )
numerr += facet_body_check();
numerr += collapse_check();
numerr += vertex_facet_check();
}
numerr += method_check();
if ( web.symmetry_flag ) numerr += wrap_check();
#ifdef MPI_EVOLVER
numerr += mpi_task_checks();
#endif
check_count = numerr;
return numerr;
} /* end run_checks() */
/**********************************************************************
*
* Function: method_check()
*
* purpose: see if any method applied twice to an element.
*
* return: number of duplications.
*/
int method_check()
{ int type;
element_id id;
int count = 0;
int k,n;
for ( type = VERTEX; type < FACETEDGE ; type++ )
{ int meth_offset = get_meth_offset(type);
FOR_ALL_ELEMENTS(type,id)
{ struct element *e_ptr = elptr(id);
int *instlist = (int*)((char*)e_ptr + meth_offset);
for ( k = 0; k < (int)e_ptr->method_count ; k++ )
for ( n = k+1; n < (int)e_ptr->method_count ; n++ )
if ( abs(instlist[k]) == abs(instlist[n]) )
{ sprintf(msg,"%s %s has method %s twice.\n",
typenames[type],ELNAME(id),METH_INSTANCE(abs(instlist[k]))->name);
outstring(msg);
count++;
}
}
}
return count;
} /* end method_check() */
/**********************************************************************
*
* Function: list_check()
*
* Purpose: Check element linked lists.
*
*/
int list_check()
{
int type;
element_id id;
int numerr = 0;
/* free_discards(DISCARDS_ALL); */
for ( type = 0 ; type < NUMELEMENTS ; type++ )
{
element_id backid = NULLID;
if ( (web.representation == SIMPLEX) && (type == EDGE) ) continue;
#ifndef HASH_ID
/* check free list */
{ int freecount,maxfree;
maxfree = web.skel[type].maxcount - web.skel[type].count
- web.skel[type].discard_count;
id = web.skel[type].free;
freecount = 0;
while ( id != NULLID )
{ freecount++;
if ( freecount > maxfree )
{ sprintf(msg,"Type %d freelist has too many elements: %d.\n",
type,freecount);
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
break;
}
if ( id_type(id) != type )
{ sprintf(msg,"Type %d freelist has bad id %lX\n",type,(unsigned long)id);
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
break;
}
if ( elptr(id)->backchain != backid )
{ sprintf(msg,
"Type %d freelist has bad backchain %X instead of %X for id %lX\n",
type, (unsigned long)elptr(id)->backchain,(unsigned long)backid,
(unsigned long)id);
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
backid = id;
id = elptr(id)->forechain;
} /* end while */
if ( backid != web.skel[type].freelast )
{ sprintf(msg,"Type %d freelist has bad freelast %lX instead of %lX.\n",
type, (unsigned long)web.skel[type].freelast,(unsigned long)backid);
erroutstring(msg);
}
if ( freecount != maxfree )
{ sprintf(msg,"Type %d freelist has %d elements instead of %d.\n",
type,freecount,maxfree);
erroutstring(msg);
}
if ( !equal_id(id,NULLID) )
{ sprintf(msg,"Type %d freelist last id is non-null: %lX\n",type,
(unsigned long)id);
erroutstring(msg);
}
}
#endif
#ifndef MPI_EVOLVER
{ int usedcount,maxused,discards;
element_id prev_id;
/* check used list */
maxused = web.skel[type].count;
id = web.skel[type].used;
prev_id = NULLID;
usedcount = 0;
discards = 0;
while ( valid_id(id) )
{
if ( valid_element(id) )
usedcount++;
else discards++;
if ( usedcount > maxused )
{ sprintf(msg,"Type %d usedlist has too many elements: %d.\n",
type,usedcount);
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
break;
}
if ( id_type(id) != type )
{ sprintf(msg,"Type %d usedlist has bad id %lX of type %d\n",
type,(unsigned long)id,id_type(id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{ erroutstring("Too many errors.\n"); return numerr;}
break;
}
if ( !equal_id(prev_id,elptr(id)->backchain) )
{ sprintf(msg,"Type %d used list id %lX has backchain %lX instead of %lX\n",
type,(unsigned long)id,(unsigned long)elptr(id)->backchain,
(unsigned long)prev_id);
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
prev_id = id;
id = elptr(id)->forechain;
} /* end while */
if ( usedcount != maxused )
{ sprintf(msg,"Type %d usedlist has %d elements.\n",type,usedcount);
erroutstring(msg);
}
if ( discards != web.skel[type].discard_count )
{ sprintf(msg,"Type %d usedlist has %d elements.\n",type,usedcount);
erroutstring(msg);
}
if ( !equal_id(id,NULLID) )
{ sprintf(msg,"Type %d usedlist last id is non-null: %lX\n",type,
(unsigned long)id);
erroutstring(msg);
}
}
#endif
} /* end for loop */
#ifdef MPI_EVOLVER
for ( type = VERTEX ; type < NUMELEMENTS ; type++ )
{ int k;
for ( k = 0 ; k < web.skel[type].maxcount ; k++ )
if ( (web.skel[type].ibase[k]->local_id & OFFSETMASK) != k )
{ sprintf(msg,"Task %d: local_id is %08X on %s ibase[0x%X], self id %08X\n",
this_task,(int)(web.skel[type].ibase[k]->local_id),
typenames[type],k, (int)(web.skel[type].ibase[k]->self_id));
erroutstring(msg);
}
}
#endif
return numerr;
} /* end list_check() */
/**********************************************************************
*
* Function: facetedge_check()
*
* Purpose: Check integrity of facetedge chains both ways.
*/
int facetedge_check(flag)
int flag; /* PRELIMCHECK for check before subdivision, else REGCHECK */
{
vertex_id v_id;
edge_id e_id;
facet_id f_id;
facetedge_id fe_id,last_fe;
int count;
int numerr = 0;
int n;
/* check facetedge chain consistencies */
if ( numerr >= MAXERR ) numerr = 0;
count = 0;
MFOR_ALL_FACETEDGES(fe_id)
{ facetedge_id fe;
f_id = get_fe_facet(fe_id);
#ifdef MPI_EVOLVER
if ( (web.representation==SOAPFILM) || (id_task(f_id)==this_task) )
#endif
if ( valid_id(f_id) && !valid_element(f_id) )
{ sprintf(msg,"Facetedge %s links to invalid facet %08lX.\n",
ELNAME(fe_id), (unsigned long)f_id);
erroutstring(msg);
}
#ifdef MPI_EVOLVER
if ( (web.representation==SOAPFILM) || (id_task(f_id)==this_task) )
#endif
if ( valid_id(f_id) && !valid_element(get_facet_fe(f_id)) )
{ sprintf(msg,"Facetedge %s links to facet %s with invalid facetedge %s.\n",
ELNAME(fe_id),ELNAME1(f_id),ELNAME2(get_facet_fe(f_id)));
erroutstring(msg);
}
e_id = get_fe_edge(fe_id);
#ifdef MPI_EVOLVER
if ( mpi_corona_state > NO_CORONA || id_task(e_id) == this_task )
#endif
{
if ( valid_id(e_id) && !valid_element(e_id) )
{ sprintf(msg,"Facetedge %s links to invalid edge %08lX.\n",
ELNAME(fe_id),(unsigned long)e_id);
erroutstring(msg);
}
if ( valid_id(e_id) && !valid_element(get_edge_fe(e_id)) )
{ sprintf(msg,"Facetedge %s links to edge %s with invalid facetedge %s.\n",
ELNAME(fe_id),ELNAME1(e_id),ELNAME2(get_edge_fe(e_id)));
erroutstring(msg);
}
}
fe = get_prev_edge(fe_id);
if ( valid_id(fe) && !equal_id(get_next_edge(fe),fe_id) )
{ sprintf(msg,"Facetedge %s has bad prev edge link\n",ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
fe = get_next_edge(fe_id);
if ( valid_id(fe) && !equal_id(get_prev_edge(fe),fe_id) )
{ sprintf(msg,"Facetedge %s has bad next edge link\n",ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
fe = get_next_facet(fe_id);
if ( valid_id(fe) && !equal_id(get_prev_facet(fe),fe_id) )
{ sprintf(msg,"Facetedge %s has bad next facet link\n",ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
fe = get_prev_facet(fe_id);
if ( valid_id(fe) && !equal_id(get_next_facet(fe),fe_id) )
{ sprintf(msg,"Facetedge %s has bad prev facet link\n",ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
fe = get_next_edge(fe_id);
#ifndef MPI_EVOLVER
if ( valid_id(fe) && !equal_id(get_fe_headv(fe_id),get_fe_tailv(fe)) )
{ sprintf(msg,"Facetedge %s head vertex disagrees with next tail.\n",
ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
#endif
fe = get_prev_edge(fe_id);
#ifndef MPI_EVOLVER
if ( valid_id(fe) && !equal_id(get_fe_tailv(fe_id),get_fe_headv(fe)) )
{ sprintf(msg,"Facetedge %s tail vertex disagrees with prev head.\n",
ELNAME(fe_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
}
#endif
count++;
}
if ( count != web.skel[FACETEDGE].count )
{ sprintf(msg,"Only %d facetedges out of %ld generated.\n",
count,web.skel[FACETEDGE].count);
erroutstring(msg);
}
/* check that vertices have legit edge link */
FOR_ALL_VERTICES(v_id)
{
e_id = get_vertex_edge(v_id);
if ( !valid_id(e_id) ) continue;
if ( !valid_element(e_id) )
{ sprintf(errmsg,"Vertex %s has invalid edge link.\n",
ELNAME(v_id)+1);
kb_error(1829,errmsg,WARNING);
continue;
}
else if (get_vattr(v_id) & Q_MIDPOINT)
{ if ( !equal_id(v_id,get_edge_midv(e_id)) )
{ sprintf(errmsg,"Vertex %s has bad midpoint edge link.\n",ELNAME(v_id));
kb_error(1830,errmsg,WARNING);
continue;
}
}
else if (get_vattr(v_id) & Q_MIDEDGE)
{ vertex_id *v = get_edge_vertices(e_id);
int i;
for ( i = 0 ; i <= web.lagrange_order ; i++ )
if ( equal_id(v_id,v[i]) ) break;
if ( i > web.lagrange_order )
{ sprintf(errmsg,"Vertex %s has bad edge link.\n",ELNAME(v_id));
kb_error(1831,errmsg,WARNING);
}
}
else if (get_vattr(v_id) & Q_MIDFACET) { }
else if ( !equal_id(v_id,get_edge_tailv(e_id)) )
{ sprintf(errmsg,"Vertex %s has bad edge link.\n",ELNAME(v_id));
kb_error(1832,errmsg,WARNING);
continue;
}
} /* end vertices */
FOR_ALL_EDGES(e_id)
{ edge_id ee_id;
v_id = get_edge_tailv(e_id);
n = 0; ee_id = e_id;
do
{ ee_id = get_next_tail_edge(ee_id);
if ( ++n > 2*web.skel[EDGE].count )
{ sprintf(errmsg,"Vertex %s has bad edge loop from edge %s.\n",
ELNAME(v_id),ELNAME1(e_id));
kb_error(1833,errmsg,WARNING);
break;
}
}
while ( !equal_id(ee_id,e_id) );
v_id = get_edge_headv(e_id);
n = 0; ee_id = e_id;
do
{ ee_id = get_next_head_edge(ee_id);
if ( ++n > 2*web.skel[EDGE].count )
{ sprintf(errmsg,"Vertex %s has bad edge loop from edge %s.\n",
ELNAME(v_id),ELNAME1(e_id));
kb_error(1834,errmsg,WARNING);
break;
}
}
while ( !equal_id(ee_id,e_id) );
} /* end edges */
/* some more checks on edges */
count = 0;
bare_edge_count = 0;
FOR_ALL_EDGES(e_id)
{ vertex_id v_id = get_edge_headv(e_id);
facetedge_id first_fe;
#ifdef MPI_EVOLVER
if ( mpi_corona_state > NO_CORONA || id_task(v_id) == this_task )
#endif
if ( get_vattr(v_id) & AXIAL_POINT )
{ sprintf(msg,"Vertex %s is axial and not first vertex of edge %s.\n",
ELNAME(v_id),ELNAME1(e_id));
erroutstring(msg);
}
last_fe = NULLID;
fe_id = first_fe = get_edge_fe(e_id);
if ( valid_id(fe_id) ) do
{ edge_id ee_id = get_fe_edge(fe_id);
if ( !equal_id(e_id,ee_id) )
{ sprintf(msg,"Facetedge %s on edge %s instead of %s.\n",
ELNAME(fe_id),SELNAME1(ee_id), SELNAME2(e_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); goto facet_check;}
}
count++;
if ( count > web.skel[FACETEDGE].count )
{ sprintf(msg,"Bad chain of facetedges around edge %s.\n",
ELNAME(e_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); goto facet_check;}
}
last_fe = fe_id;
fe_id = get_next_facet(fe_id);
} while ( valid_id(fe_id) && !equal_id(fe_id,first_fe) );
if ( last_fe == NULLID )
{
if ( (web.representation == SOAPFILM) && (flag == REGCHECK) )
{ edge_id orig;
bare_edge_count++;
if ( get_eattr(e_id) & BARE_NAKED ) continue;
sprintf(msg,"Edge %s has no facets.\n",ELNAME(e_id));
erroutstring(msg);
orig = get_original(e_id);
if ( valid_id(orig) && !equal_element(orig,e_id) )
{ sprintf(msg," (originally edge %s)\n",ELNAME(e_id));
erroutstring(msg);
}
}
}
else if ( !equal_id(get_edge_fe(e_id),get_next_facet(last_fe)) )
{ edge_id orig;
sprintf(msg,"Facets around edge %s do not link up.\n",
ELNAME(e_id));
erroutstring(msg);
orig = get_original(e_id);
if ( valid_id(orig) && !equal_element(orig,e_id) )
{ sprintf(msg," (originally edge %s)\n",ELNAME(e_id));
erroutstring(msg);
}
}
}
#ifndef MPI_EVOLVER
if ( count != web.skel[FACETEDGE].count )
{ sprintf(msg,"Edges have %d facetedges out of %ld used.\n",
count,web.skel[FACETEDGE].count);
erroutstring(msg);
++numerr;
}
#endif
facet_check:
if ( numerr >= MAXERR ) numerr = 0;
if ( web.representation == SOAPFILM )
{ int i;
count = 0;
MFOR_ALL_FACETS(f_id)
{ facetedge_id first_fe;
int thiscount = 0;
last_fe = NULLID;
fe_id = first_fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++, fe_id = get_next_edge(fe_id) )
{ vertex_id v_id;
edge_id e_id = get_fe_edge(fe_id);
facet_id ff_id;
#ifdef MPI_EVOLVER
if ( mpi_corona_state == NO_CORONA )
{ if ( id_task(e_id) == this_task )
{ v_id = get_edge_tailv(e_id);
if ( id_task(v_id) == this_task )
{ if ( (thiscount != 0) && (get_vattr(v_id) & AXIAL_POINT))
{ set_facet_fe(f_id,fe_id);
}
}
}
}
else
#endif
{ v_id = get_edge_tailv(e_id);
if ( (thiscount != 0) && (get_vattr(v_id) & AXIAL_POINT))
{ set_facet_fe(f_id,fe_id);
}
}
ff_id = get_fe_facet(fe_id);
if ( !equal_id(f_id,ff_id) )
{ sprintf(msg,"Facetedge %s on facet %s instead of %s.\n",
ELNAME(fe_id),SELNAME1(ff_id), SELNAME2(f_id));
erroutstring(msg);
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); break;}
}
count++;
if ( ++thiscount > web.skel[FACETEDGE].count )
{ facet_id orig;
sprintf(msg,"Facetedge loop not closed on facet %s.\n",
ELNAME(f_id));
erroutstring(msg);
orig = get_original(f_id);
if ( valid_id(orig) && !equal_element(orig,f_id) )
{ sprintf(msg," (originally facet %s)\n", ELNAME(orig));
erroutstring(msg);
}
break;
}
last_fe = fe_id;
} /* end while */
fe_id = get_next_edge(last_fe);
if ( !equal_id(first_fe,fe_id) )
{ facet_id orig;
sprintf(msg,"Edges around facet %s do not link up.\n",
ELNAME(f_id));
erroutstring(msg);
orig = get_original(f_id);
if ( valid_id(orig) && !equal_element(orig,f_id) )
{ sprintf(msg," (originally facet %s)\n", ELNAME(orig));
erroutstring(msg);
}
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); break;}
}
if ( (thiscount != 3) && (flag == REGCHECK) )
{ facet_id orig;
sprintf(msg,"Facet %s has %d edges.\n",ELNAME(f_id),thiscount);
erroutstring(msg);
orig = get_original(f_id);
if ( valid_id(orig) && !equal_element(orig,f_id) )
{ sprintf(msg," (originally facet %s)\n", ELNAME(orig));
erroutstring(msg);
}
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); break;}
}
}
if ( count != web.skel[FACETEDGE].count )
{ sprintf(msg,"Facets have %d facet-edges out of %ld used.\n",
count,web.skel[FACETEDGE].count);
erroutstring(msg);
++numerr;
}
} /* end SOAPFILM */
return numerr;
} /* end facetedge_check() */
/************************************************************************
*
* function: vertex_facet_check()
*
* purpose: Check the vertex facet circularly linked lists.
*/
int vertex_facet_check()
{ vertex_id v_id;
int numerr = 0;
MFOR_ALL_VERTICES(v_id)
{ element_id f_id, start_f_id;
int count = 0;
start_f_id = get_vertex_first_facet(v_id);
if ( !valid_id(start_f_id) )
continue;
f_id = start_f_id;
do
{ f_id = get_next_vertex_facet(v_id,f_id);
count++;
if ( count > web.skel[FACET].count )
{ sprintf(msg,"Vertex %s has bad facet list.\n",ELNAME(v_id));
erroutstring(msg);
++numerr;
break;
}
} while ( !equal_id(f_id,start_f_id) );
}
if ( (numerr > 0) && (web.representation == SIMPLEX) )
{ erroutstring("Remaking vertex facet lists.\n");
make_vfacet_lists();
}
return numerr;
}
/************************************************************************
*
* Function: facet_body_check()
*
* Purpose: Check whether adjacent facets have same bodies.
* Should be used only for complete bodies.
* Also checks body facet lists.
*/
int facet_body_check()
{
facetedge_id fe;
facet_id f_id;
body_id b_id;
int numerr = 0;
element_id orig;
FOR_ALL_BODIES(b_id)
{ f_id = get_body_facet(b_id);
if ( !valid_id(f_id) ) continue;
if ( !valid_element(f_id) )
{ sprintf(msg,"Body %s has invalid facet link to facet %s.\n",
ELNAME(b_id),ELNAME1(f_id));
erroutstring(msg);
numerr++;
continue;
}
if ( !equal_id(b_id,get_facet_body(f_id) ) )
{ sprintf(msg,"Body %s has link to facet %s, which is on body %s.\n",
ELNAME(b_id),SELNAME1(f_id),ELNAME2(get_facet_body(f_id)));
erroutstring(msg);
numerr++;
}
}
if ( web.representation != SOAPFILM ) return numerr;
FOR_ALL_FACETEDGES(fe)
{ body_id bb_id;
facet_id ff_id;
edge_id e_id;
int k;
for ( k = 0 ; k < 2 ; k++ )
{ fe = inverse_id(fe);
f_id = get_fe_facet(fe);
b_id = get_facet_body(f_id);
if ( equal_id(fe,get_prev_facet(fe)) ) continue;
ff_id = get_fe_facet(fe_inverse(get_prev_facet(fe)));
bb_id = get_facet_body(ff_id);
e_id = get_fe_edge(fe);
if ( /* !equal_id(b_id,bb_id) */
(ordinal(b_id) != ordinal(bb_id)) /* for MPI, temp kludge */
&& !(get_attr(e_id)&(CONSTRAINT|FIXED|BOUNDARY)) )
{ sprintf(msg,"Inconsistent bodies for facets on edge %s.",
ELNAME(e_id) );
erroutstring(msg);
numerr++;
orig = get_original(e_id);
if ( valid_id(orig) && !equal_element(orig,e_id) )
{ sprintf(msg," (originally edge %s)",ELNAME(orig));
erroutstring(msg);
}
sprintf(msg,"\n facet %d",oid(f_id));
erroutstring(msg);
orig = get_original(f_id);
if ( valid_id(orig) && !equal_element(orig,f_id) )
{ sprintf(msg," (orig. %s)",ELNAME(orig)); erroutstring(msg); }
if ( valid_id(b_id) )
{
sprintf(msg," has body %s",ELNAME(b_id));
erroutstring(msg);
orig = get_original(b_id);
if ( valid_id(orig) && !equal_element(orig,b_id) )
{ sprintf(msg," (orig. %s)",ELNAME(orig));
erroutstring(msg);
}
}
else erroutstring(" has no body");
sprintf(msg,"; facet %d",oid(ff_id));
erroutstring(msg);
orig = get_original(ff_id);
if ( valid_id(orig) && !equal_element(orig,ff_id) )
{ sprintf(msg," (orig. %s)",ELNAME(orig));
erroutstring(msg);
}
if ( valid_id(bb_id) )
{
sprintf(msg," has body %s",ELNAME(bb_id));
erroutstring(msg);
orig = get_original(bb_id);
if ( valid_id(orig) && !equal_element(orig,bb_id) )
{ sprintf(msg," (orig. %s)",ELNAME(orig));
erroutstring(msg);
}
}
else erroutstring(" has no body");
erroutstring(".\n");
/* just a warning, not an error */
}
}
} /* end FACETEDGES */
numerr += check_body_facets();
return numerr;
} /* end facet_body_check() */
/************************************************************************
*
* function: check_body_facets()
*
* purpose: check body facet lists
*/
int check_body_facets()
{ int numerr = 0;
body_id b_id;
FOR_ALL_BODIES(b_id)
{ facet_id start_f,next_f;
facet_id f_id = get_body_facet(b_id);
if ( !valid_id(f_id) ) continue;
start_f = f_id;
do
{ if ( !valid_element(f_id) )
{ sprintf(msg,"Invalid facet %s on body facet list of body %s.\n",
ELNAME(f_id),ELNAME1(b_id));
erroutstring(msg);
numerr++;
}
if ( !equal_id(b_id,get_facet_body(f_id)) )
{ sprintf(msg,"Facet %s on body %s facet list, but is on body %s.\n",
SELNAME(f_id),ELNAME1(b_id),ELNAME2(get_facet_body(f_id)));
erroutstring(msg);
numerr++;
}
next_f = get_next_body_facet(f_id);
if ( !equal_id(f_id,get_prev_body_facet(next_f)) )
{ sprintf(msg,"Facet %s next body facet has bad prev_body_facet.\n",
SELNAME(f_id));
erroutstring(msg);
numerr++;
break;
}
f_id = next_f;
} while ( !equal_id(f_id,start_f) );
}
return numerr;
}
/**********************************************************************
*
* Function: collapse_check()
*
* Purpose: Checks whether adjacent facets have collapsed.
* Tests whether they have the same third vertex.
* Also checks for edges that have the same endpoints.
*/
int vvvvcomp(a,b)
struct vvvv *a,*b;
{ int i;
for ( i = 0 ; i < 3 ; i++ )
{ if ( a->v[i] < b->v[i] ) return -1;
if ( a->v[i] > b->v[i] ) return 1;
}
return 0;
}
int collapse_check()
{
struct vvvv *vvlist,*current;
facet_id f_id;
edge_id e_id;
vertex_id tmp;
vertex_id v1,v2,v3;
int i;
int count;
int numerr = 0;
element_id orig;
/* check edges */
if ( web.skel[EDGE].count == 0 ) return numerr;
vvlist = (struct vvvv *)temp_calloc(web.skel[EDGE].count,sizeof(struct vvvv));
current = vvlist;
count = 0;
FOR_ALL_EDGES(e_id)
{
v1 = get_edge_tailv(e_id);
v2 = get_edge_headv(e_id);
if ( equal_element(v1,v2) && !(get_vattr(v1) & AXIAL_POINT) )
{ sprintf(msg,"Edge %s",ELNAME(e_id));
erroutstring(msg);
orig = get_original(e_id);
if ( valid_id(orig) && !equal_element(orig,e_id) )
{ sprintf(msg," (orig. %s)",ELNAME(orig));
erroutstring(msg);
}
sprintf(msg," is loop on vertex %s",ELNAME(v1));
erroutstring(msg);
orig = get_original(get_edge_tailv(e_id));
if ( valid_id(orig) && !equal_element(orig,v1) )
{ sprintf(msg," (orig. %s)",ELNAME(orig));
erroutstring(msg);
}
erroutstring(".\n");
numerr++;
}
if ( v1 <= v2 )
{ current->id = e_id;
current->v[0] = v1;
current->v[1] = v2;
}
else
{ current->id = inverse_id(e_id);
current->v[0] = v2;
current->v[1] = v1;
}
if ( ++count > web.skel[EDGE].count )
{ erroutstring("Edge count disagrees with supposed value.");
count--;
numerr++;
break;
}
current++;
}
qsort((char *)vvlist,count,sizeof(struct vvvv),FCAST vvvvcomp);
/* scan list for duplicates */
for ( i = 0 ; i < count-1 ; i++ )
{ if ( vvvvcomp(vvlist+i,vvlist+i+1) == 0 )
if ( !web.symmetry_flag ||
(get_edge_wrap(vvlist[i].id) == get_edge_wrap(vvlist[i+1].id)) )
{ sprintf(msg,"Edges %s and %s have same endpoints: %s %s.\n",
ELNAME(vvlist[i].id),ELNAME1(vvlist[i+1].id),
ELNAME2(vvlist[i].v[0]), ELNAME3(vvlist[i].v[1]));
erroutstring(msg);
numerr++;
}
}
temp_free((char*)vvlist);
if ( web.representation == STRING ) return numerr;
#ifdef MPI_EVOLVER
if ( mpi_corona_state == NO_CORONA )
return numerr;
#endif
/* check facets */
if ( web.skel[FACET].count == 0 ) return numerr;
vvlist = (struct vvvv *)temp_calloc(web.skel[FACET].count,sizeof(struct vvvv));
current = vvlist;
count = 0;
FOR_ALL_FACETS(f_id)
{
facetedge_id fe;
fe = get_facet_fe(f_id);
v1 = positive_id(get_fe_tailv(fe));
v2 = positive_id(get_fe_headv(fe));
v3 = positive_id(get_fe_headv(get_next_edge(fe)));
/* bubble sort */
if ( v1 > v2 )
{ tmp = v1; v1 = v2; v2 = tmp; invert(f_id); }
if ( v2 > v3 )
{ tmp = v2; v2 = v3; v3 = tmp; invert(f_id); }
if ( v1 > v2 )
{ tmp = v1; v1 = v2; v2 = tmp; invert(f_id); }
current->id = f_id;
current->v[0] = v1;
current->v[1] = v2;
current->v[2] = v3;
if ( ++count > web.skel[FACET].count )
{ erroutstring("Facet count disagrees with supposed value.");
count--;
if ( ++numerr > MAXERR )
{erroutstring("Too many errors.\n"); return numerr;}
break;
}
current++;
}
qsort((char *)vvlist,count,sizeof(struct vvvv),FCAST vvvvcomp);
/* scan list for duplicates */
for ( i = 0 ; i < count-1 ; i++ )
{ if ( (vvvvcomp(vvlist+i,vvlist+i+1) == 0)
&& !(get_vattr(vvlist[i].v[0]) & AXIAL_POINT)
&& !(get_vattr(vvlist[i].v[1]) & AXIAL_POINT)
&& !(get_vattr(vvlist[i].v[2]) & AXIAL_POINT)
)
{ sprintf(msg,"Facets %s and %s have same vertices: %s %s %s.\n",
ELNAME(vvlist[i].id),ELNAME1(vvlist[i+1].id), ELNAME2(vvlist[i].v[0]),
ELNAME3(vvlist[i].v[1]),ELNAME4(vvlist[i].v[2]));
erroutstring(msg);
numerr++;
}
}
temp_free((char*)vvlist);
return numerr;
} /* end collapse_check() */
/**********************************************************************
*
* Function: normal_change_check()
*
* Purpose: Checks how much the normal of facets have changed
* during motion. Returns the largest (delta normal)/(normal)
*/
REAL normal_change_check()
{
facet_id f_id;
facetedge_id fe;
vertex_id v_id;
REAL side[2][MAXCOORD];
REAL max_delta;
REAL old_normal[MAXCOORD];
REAL new_normal[MAXCOORD];
REAL x[3][MAXCOORD];
int ord_v;
REAL diff;
struct boundary *bdry;
int i,n;
max_delta = 0.0;
FOR_ALL_FACETS(f_id)
{ int ii;
if ( get_fattr(f_id) & FIXED ) continue;
/* get old normal */
fe = get_facet_fe(f_id);
for ( ii = 0 ; ii < FACET_EDGES ; ii++, fe = get_next_edge(fe) )
{
v_id = get_fe_tailv(fe);
ord_v = loc_ordinal(v_id);
if ( get_vattr(v_id) & BOUNDARY )
{ bdry = get_boundary(v_id);
for ( i = 0 ; i < SDIM ; i++ )
x[ii][i] = eval(bdry->coordf[i],saved.coord[ord_v],v_id,NULL);
}
else
{
for ( i = 0 ; i < SDIM ; i++ )
x[ii][i] = saved.coord[ord_v][i];
}
}
for ( i = 0 ; i < SDIM ; i++ )
{ side[0][i] = x[1][i] - x[0][i];
side[1][i] = x[2][i] - x[0][i];
}
cross_prod(side[0],side[1],old_normal);
/* get new normal */
fe = get_facet_fe(f_id);
for ( n = 0 ; n < FACET_EDGES ; n++, fe = get_next_edge(fe) )
{
v_id = get_fe_tailv(fe);
for ( i = 0 ; i < SDIM ; i++ )
x[n][i] = get_coord(v_id)[i];
}
for ( i = 0 ; i < SDIM ; i++ )
{ side[0][i] = x[1][i] - x[0][i];
side[1][i] = x[2][i] - x[0][i];
}
cross_prod(side[0],side[1],new_normal);
/* test difference */
for ( i = 0 ; i < SDIM ; i++ )
side[0][i] = new_normal[i] - old_normal[i];
diff = sqrt(SDIM_dot(side[0],side[0])/
SDIM_dot(old_normal,old_normal));
if ( diff > max_delta )
max_delta = diff;
}
return max_delta;
} /* end normal_change_check() */
/********************************************************************
*
* function: wrap_check()
*
* purpose: check wraps around facet make identity, except for axial
* point. And checks torus wraps for validity.
*
* return: number of bad facets.
*/
int wrap_check()
{ edge_id e_id;
facet_id f_id;
int numerr = 0;
int count = 0;
int i;
if ( web.torus_flag )
FOR_ALL_EDGES(e_id)
{ WRAPTYPE wrap = get_edge_wrap(e_id);
for ( i = 0 ; i < SDIM ; i++, wrap >>= TWRAPBITS )
switch ( wrap & WRAPMASK )
{
case NEGWRAP : break;
case 0 : break;
case POSWRAP : break;
default :
sprintf(errmsg,"Big wrap %d on edge %s period %d\n",
WRAPNUM(wrap&WRAPMASK),ELNAME(e_id),i+1);
erroutstring(errmsg);
numerr++;
break;
}
}
FOR_ALL_FACETS(f_id)
{
facetedge_id fe,start_fe;
int wrap = 0;
fe = start_fe = get_facet_fe(f_id);
count = 0;
if ( valid_id(fe) )
do
{ if ( get_vattr(get_fe_tailv(fe)) & AXIAL_POINT )
{ wrap = 0; break; }
wrap = (*sym_compose)(wrap,get_fe_wrap(fe));
fe = get_next_edge(fe);
count++;
if ( count > 2*web.skel[EDGE].count )
{ sprintf(errmsg,"Facet %s has unclosed edge loop.\n",ELNAME(f_id));
erroutstring(errmsg);
numerr++;
break;
}
} while ( valid_id(fe) && !equal_id(fe,start_fe) );
if ( valid_id(fe) && (wrap != 0) )
{ sprintf(errmsg,"Wraps around facet %s not consistent.\n",ELNAME(f_id));
kb_error(2000,errmsg,WARNING);
numerr++;
}
}
return numerr;
} /* end wrap_check() */
evolver-2.30c.dfsg/src/mvgraph.c 0000644 0001753 0001753 00000003071 11410765113 017026 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************
*
* File: MVgraph.c
*
* Contents: Routines for interface with shared memory
* MinneView.
*/
#include "include.h"
#ifndef OOGL
void Begin_OOGL()
{
kb_error(1251,"This Evolver not compiled with the OOGL option.\n",WARNING);
}
void UpdateOOGL()
{
}
void End_OOGL()
{
}
#else
void Begin_OOGL() {}
void End_OOGL()
{
OOGL_flag = 0;
if ( geomview_flag ) End_geomview();
}
void UpdateOOGL()
{
void (*old_start)ARGS((void));
void (*old_end)ARGS((void));
void (*old_gedge)ARGS((struct graphdata *,edge_id));
void (*old_gfacet)ARGS((struct graphdata*,facet_id));
/* if user has asked us to quit, don't bother redisplaying */
/* (especially since graphgen resets breakflag!) */
if (breakflag) return;
/* save current screen graphics pointers */
old_start = graph_start;
old_end = graph_end;
old_gfacet = graph_facet;
old_gedge = graph_edge;
/* OOGL pointers */
if ( geomview_flag )
{
graph_start = geomview_start;
graph_facet = geomview_facet;
graph_edge = geomview_edge;
graph_end = geomview_end;
}
/* do output */
graphgen();
/* restore old graphics */
graph_start = old_start;
graph_end = old_end;
graph_edge = old_gedge;
graph_facet = old_gfacet;
}
#endif
evolver-2.30c.dfsg/src/odrv.c 0000644 0001753 0001753 00000073076 11410765113 016350 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/* for making FORTRAN local variables stack instead of static */
#define STATIC
/************************************************************************/
/* odrv.f -- translated by f2c (version of 8 February 1991 13:22:30). */
/* For YSMP sparse matrix package */
/************************************************************************/
#include "include.h"
#include "f2c.h"
int odrv_ ARGS(( integer *, integer *,integer *,REAL *, integer *,integer *,
integer *,integer *, integer *, integer *));
/* *********************************************************************** */
/* 1/15/81 */
/* *********************************************************************** */
/* Function: ODRV -- DRIVER FOR SPARSE MATRIX REORDERING ROUTINES */
/* *********************************************************************** */
int odrv_(n, ia, ja, a, p, ip, nsp, isp, path, flag_)
integer *n, *ia, *ja;
doublereal *a;
integer *p, *ip, *nsp, *isp, *path, *flag_;
{
STATIC integer head, l;
STATIC logical dflag;
STATIC integer q, v;
STATIC integer max_, tmp;
#ifdef NOPROTO
extern /* Subroutine */ int md_();
extern /* Subroutine */ int sro_();
#endif
/* DESCRIPTION */
/* ODRV FINDS A MINIMUM DEGREE ORDERING OF THE ROWS AND COLUMNS OF A */
/* SYMMETRIC MATRIX M STORED IN (IA,JA,A) FORMAT (SEE BELOW). FOR THE */
/* REORDERED MATRIX, THE WORK AND STORAGE REQUIRED TO PERFORM GAUSSIAN */
/* ELIMINATION IS (USUALLY) SIGNIFICANTLY LESS. */
/* IF ONLY THE NONZERO ENTRIES IN THE UPPER TRIANGLE OF M ARE BEING */
/* STORED, THEN ODRV SYMMETRICALLY REORDERS (IA,JA,A), (OPTIONALLY) */
/* WITH THE DIAGONAL ENTRIES PLACED FIRST IN EACH ROW. THIS IS TO */
/* ENSURE THAT IF M(I,J) WILL BE IN THE UPPER TRIANGLE OF M WITH */
/* RESPECT TO THE NEW ORDERING, THEN M(I,J) IS STORED IN ROW I (AND */
/* THUS M(J,I) IS NOT STORED); WHEREAS IF M(I,J) WILL BE IN THE */
/* STRICT LOWER TRIANGLE OF M, THEN M(J,I) IS STORED IN ROW J (AND */
/* THUS M(I,J) IS NOT STORED). */
/* STORAGE OF SPARSE MATRICES */
/* THE NONZERO ENTRIES OF THE MATRIX M ARE STORED ROW-BY-ROW IN THE */
/* ARRAY A. TO IDENTIFY THE INDIVIDUAL NONZERO ENTRIES IN EACH ROW, */
/* WE NEED TO KNOW IN WHICH COLUMN EACH ENTRY LIES. THESE COLUMN */
/* INDICES ARE STORED IN THE ARRAY JA; I.E., IF A(K) = M(I,J), THEN */
/* JA(K) = J. TO IDENTIFY THE INDIVIDUAL ROWS, WE NEED TO KNOW WHERE */
/* EACH ROW STARTS. THESE ROW POINTERS ARE STORED IN THE ARRAY IA; */
/* I.E., IF M(I,J) IS THE FIRST NONZERO ENTRY (STORED) IN THE I-TH ROW */
/* AND A(K) = M(I,J), THEN IA(I) = K. MOREOVER, IA(N+1) POINTS TO */
/* THE FIRST LOCATION FOLLOWING THE LAST ELEMENT IN THE LAST ROW. */
/* THUS, THE NUMBER OF ENTRIES IN THE I-TH ROW IS IA(I+1) - IA(I), */
/* THE NONZERO ENTRIES IN THE I-TH ROW ARE STORED CONSECUTIVELY IN */
/* A(IA(I)), A(IA(I)+1), ..., A(IA(I+1)-1), */
/* AND THE CORRESPONDING COLUMN INDICES ARE STORED CONSECUTIVELY IN */
/* JA(IA(I)), JA(IA(I)+1), ..., JA(IA(I+1)-1). */
/* SINCE THE COEFFICIENT MATRIX IS SYMMETRIC, ONLY THE NONZERO ENTRIES */
/* IN THE UPPER TRIANGLE NEED BE STORED. FOR EXAMPLE, THE MATRIX */
/* ( 1 0 2 3 0 ) */
/* ( 0 4 0 0 0 ) */
/* M = ( 2 0 5 6 0 ) */
/* ( 3 0 6 7 8 ) */
/* ( 0 0 0 8 9 ) */
/* COULD BE STORED AS */
/* \ 1 2 3 4 5 6 7 8 9 10 11 12 13 */
/* ---+-------------------------------------- */
/* IA \ 1 4 5 8 12 14 */
/* JA \ 1 3 4 2 1 3 4 1 3 4 5 4 5 */
/* A \ 1 2 3 4 2 5 6 3 6 7 8 8 9 */
/* OR (SYMMETRICALLY) AS */
/* \ 1 2 3 4 5 6 7 8 9 */
/* ---+-------------------------- */
/* IA \ 1 4 5 7 9 10 */
/* JA \ 1 3 4 2 3 4 4 5 5 */
/* A \ 1 2 3 4 5 6 7 8 9 . */
/* PARAMETERS */
/* N - ORDER OF THE MATRIX */
/* IA - INTEGER ONE-DIMENSIONAL ARRAY CONTAINING POINTERS TO DELIMIT */
/* ROWS IN JA AND A; DIMENSION = N+1 */
/* JA - INTEGER ONE-DIMENSIONAL ARRAY CONTAINING THE COLUMN INDICES */
/* CORRESPONDING TO THE ELEMENTS OF A; DIMENSION = NUMBER OF */
/* NONZERO ENTRIES IN (THE UPPER TRIANGLE OF) M */
/* A - REAL ONE-DIMENSIONAL ARRAY CONTAINING THE NONZERO ENTRIES IN */
/* (THE UPPER TRIANGLE OF) M, STORED BY ROWS; DIMENSION = */
/* NUMBER OF NONZERO ENTRIES IN (THE UPPER TRIANGLE OF) M */
/* P - INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE PERMUTATION */
/* OF THE ROWS AND COLUMNS OF M CORRESPONDING TO THE MINIMUM */
/* DEGREE ORDERING; DIMENSION = N */
/* IP - INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE INVERSE OF */
/* THE PERMUTATION RETURNED IN P; DIMENSION = N */
/* NSP - DECLARED DIMENSION OF THE ONE-DIMENSIONAL ARRAY ISP; NSP */
/* MUST BE AT LEAST 3N+4K, WHERE K IS THE NUMBER OF NONZEROES */
/* IN THE STRICT UPPER TRIANGLE OF M */
/* ISP - INTEGER ONE-DIMENSIONAL ARRAY USED FOR WORKING STORAGE; */
/* DIMENSION = NSP */
/* PATH - INTEGER PATH SPECIFICATION; VALUES AND THEIR MEANINGS ARE - */
/* 1 FIND MINIMUM DEGREE ORDERING ONLY */
/* 2 FIND MINIMUM DEGREE ORDERING AND REORDER SYMMETRICALLY */
/* STORED MATRIX (USED WHEN ONLY THE NONZERO ENTRIES IN */
/* THE UPPER TRIANGLE OF M ARE BEING STORED) */
/* 3 REORDER SYMMETRICALLY STORED MATRIX AS SPECIFIED BY */
/* INPUT PERMUTATION (USED WHEN AN ORDERING HAS ALREADY */
/* BEEN DETERMINED AND ONLY THE NONZERO ENTRIES IN THE */
/* UPPER TRIANGLE OF M ARE BEING STORED) */
/* 4 SAME AS 2 BUT PUT DIAGONAL ENTRIES AT START OF EACH ROW */
/* 5 SAME AS 3 BUT PUT DIAGONAL ENTRIES AT START OF EACH ROW */
/* FLAG - INTEGER ERROR FLAG; VALUES AND THEIR MEANINGS ARE - */
/* 0 NO ERRORS DETECTED */
/* 9N+K INSUFFICIENT STORAGE IN MD */
/* 10N+1 INSUFFICIENT STORAGE IN ODRV */
/* 11N+1 ILLEGAL PATH SPECIFICATION */
/* CONVERSION FROM REAL TO DOUBLE PRECISION */
/* CHANGE THE REAL DECLARATIONS IN ODRV AND SRO TO DOUBLE PRECISION */
/* DECLARATIONS. */
/* ----------------------------------------------------------------------- */
/* .... REAL A(1) */
/* ----INITIALIZE ERROR FLAG AND VALIDATE PATH SPECIFICATION */
/* Parameter adjustments */
--isp;
--ip;
--p;
--a;
--ja;
--ia;
/* Function Body */
*flag_ = 0;
if (*path < 1 || 5 < *path) {
goto L111;
}
/* ----ALLOCATE STORAGE AND FIND MINIMUM DEGREE ORDERING */
if ((*path - 1) * (*path - 2) * (*path - 4) != 0) {
goto L1;
}
max_ = (*nsp - *n) / 2;
v = 1;
l = v + max_;
head = l + max_;
if (max_ < *n) {
goto L110;
}
md_(n, &ia[1], &ja[1], &max_, &isp[v], &isp[l], &isp[head], &p[1], &ip[1],
&isp[v], flag_);
if (*flag_ != 0) {
goto L100;
}
/* ----ALLOCATE STORAGE AND SYMMETRICALLY REORDER MATRIX */
L1:
if ((*path - 2) * (*path - 3) * (*path - 4) * (*path - 5) != 0) {
goto L2;
}
tmp = *nsp + 1 - *n;
q = tmp - (ia[*n + 1] - 1);
if (q < 1) {
goto L110;
}
dflag = *path == 4 || *path == 5;
sro_(n, &ip[1], &ia[1], &ja[1], &a[1], &isp[tmp], &isp[q], &dflag);
L2:
return 0;
/* ** ERROR -- ERROR DETECTED IN MD */
L100:
return 0;
/* ** ERROR -- INSUFFICIENT STORAGE */
L110:
*flag_ = *n * 10 + 1;
return 0;
/* ** ERROR -- ILLEGAL PATH SPECIFIED */
L111:
*flag_ = *n * 11 + 1;
return 0;
} /* odrv_ */
/* *********************************************************************** */
/* *********************************************************************** */
/* Function: MD -- MINIMUM DEGREE ALGORITHM (BASED ON ELEMENT MODEL) */
/* *********************************************************************** */
int md_(n, ia, ja, max_, v, l, head, last, next, mark, flag_)
integer *n, *ia, *ja, *max_, *v, *l, *head, *last, *next, *mark, *flag_;
{
/* System generated locals */
integer i__1;
STATIC integer equiv_0[1];
/* Local variables */
STATIC integer dmin_, tail, k;
#define ek (equiv_0)
#define vk (equiv_0)
STATIC integer tag;
#ifdef NOPROTO
extern /* Subroutine */ int mdi_();
extern /* Subroutine */ int mdm_(), mdp_(), mdu_();
#endif
/* DESCRIPTION */
/* MD FINDS A MINIMUM DEGREE ORDERING OF THE ROWS AND COLUMNS OF A */
/* SYMMETRIC MATRIX M STORED IN (IA,JA,A) FORMAT. */
/* ADDITIONAL PARAMETERS */
/* MAX - DECLARED DIMENSION OF THE ONE-DIMENSIONAL ARRAYS V AND L; */
/* MAX MUST BE AT LEAST N+2K, WHERE K IS THE NUMBER OF */
/* NONZEROES IN THE STRICT UPPER TRIANGLE OF M */
/* V - INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION = MAX */
/* L - INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION = MAX */
/* HEAD - INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION = N */
/* LAST - INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE PERMUTATION */
/* OF THE ROWS AND COLUMNS OF M CORRESPONDING TO THE MINIMUM */
/* DEGREE ORDERING; DIMENSION = N */
/* NEXT - INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE INVERSE OF */
/* THE PERMUTATION RETURNED IN LAST; DIMENSION = N */
/* MARK - INTEGER ONE-DIMENSIONAL WORK ARRAY (MAY BE THE SAME AS V); */
/* DIMENSION = N */
/* FLAG - INTEGER ERROR FLAG; VALUES AND THEIR MEANINGS ARE - */
/* 0 NO ERRORS DETECTED */
/* 11N+1 INSUFFICIENT STORAGE IN MD */
/* DEFINITIONS OF INTERNAL PARAMETERS */
/* ---------+--------------------------------------------------------- */
/* V(S) \ VALUE FIELD OF LIST ENTRY */
/* ---------+--------------------------------------------------------- */
/* L(S) \ LINK FIELD OF LIST ENTRY (0 => END OF LIST) */
/* ---------+--------------------------------------------------------- */
/* L(VI) \ POINTER TO ELEMENT LIST OF UNELIMINATED VERTEX VI */
/* ---------+--------------------------------------------------------- */
/* L(EJ) \ POINTER TO BOUNDARY LIST OF ACTIVE ELEMENT EJ */
/* ---------+--------------------------------------------------------- */
/* HEAD(D) \ VJ => VJ HEAD OF D-LIST D */
/* \ 0 => NO VERTEX IN D-LIST D */
/* \ VI UNELIMINATED VERTEX */
/* \ VI IN EK \ VI NOT IN EK */
/* ---------+-----------------------------+--------------------------- */
/* NEXT(VI) \ UNDEFINED BUT NONNEGATIVE \ VJ => VJ NEXT IN D-LIST */
/* \ \ 0 => VI TAIL OF D-LIST */
/* ---------+-----------------------------+--------------------------- */
/* LAST(VI) \ (NOT SET UNTIL MDP) \ -D => VI HEAD OF D-LIST D */
/* \-VK => COMPUTE DEGREE \ VJ => VJ LAST IN D-LIST */
/* \ EJ => VI PROTOTYPE OF EJ \ 0 => VI NOT IN ANY D-LIST */
/* \ 0 => DO NOT COMPUTE DEGREE \ */
/* ---------+-----------------------------+--------------------------- */
/* MARK(VI) \ MARK(VK) \ NONNEGATIVE TAG < MARK(VK) */
/* \ VI ELIMINATED VERTEX */
/* \ EI ACTIVE ELEMENT \ OTHERWISE */
/* ---------+-----------------------------+--------------------------- */
/* NEXT(VI) \ -J => VI WAS J-TH VERTEX \ -J => VI WAS J-TH VERTEX */
/* \ TO BE ELIMINATED \ TO BE ELIMINATED */
/* ---------+-----------------------------+--------------------------- */
/* LAST(VI) \ M => SIZE OF EI = M \ UNDEFINED */
/* ---------+-----------------------------+--------------------------- */
/* MARK(VI) \ -M => OVERLAP COUNT OF EI \ UNDEFINED */
/* \ WITH EK = M \ */
/* \ OTHERWISE NONNEGATIVE TAG \ */
/* \ < MARK(VK) \ */
/* -----------------------------------------------------------------------
*/
/* ----INITIALIZATION */
/* Parameter adjustments */
--mark;
--next;
--last;
--head;
--l;
--v;
--ja;
--ia;
/* Function Body */
tag = 0;
mdi_(n, &ia[1], &ja[1], max_, &v[1], &l[1], &head[1], &last[1], &next[1],
&mark[1], &tag, flag_);
if (*flag_ != 0) {
return 0;
}
k = 0;
dmin_ = 1;
/* ----WHILE K < N DO */
L1:
if (k >= *n) {
goto L4;
}
/* ------SEARCH FOR VERTEX OF MINIMUM DEGREE */
L2:
if (head[dmin_] > 0) {
goto L3;
}
++dmin_;
goto L2;
/* ------REMOVE VERTEX VK OF MINIMUM DEGREE FROM DEGREE LIST */
L3:
*vk = head[dmin_];
head[dmin_] = next[*vk];
if (head[dmin_] > 0) {
last[head[dmin_]] = -dmin_;
}
/* ------NUMBER VERTEX VK, ADJUST TAG, AND TAG VK */
++k;
next[*vk] = -k;
last[*ek] = dmin_ - 1;
tag += last[*ek];
mark[*vk] = tag;
/* ------FORM ELEMENT EK FROM UNELIMINATED NEIGHBORS OF VK */
mdm_(vk, &tail, &v[1], &l[1], &last[1], &next[1], &mark[1]);
/* ------PURGE INACTIVE ELEMENTS AND DO MASS ELIMINATION */
mdp_(&k, ek, &tail, &v[1], &l[1], &head[1], &last[1], &next[1], &mark[1]);
/* ------UPDATE DEGREES OF UNELIMINATED VERTICES IN EK */
mdu_(ek, &dmin_, &v[1], &l[1], &head[1], &last[1], &next[1], &mark[1]);
goto L1;
/* ----GENERATE INVERSE PERMUTATION FROM PERMUTATION */
L4:
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
next[k] = -next[k];
/* L5: */
last[next[k]] = k;
}
return 0;
} /* md_ */
#undef vk
#undef ek
/* *********************************************************************** */
/* MDI -- INITIALIZATION */
/* *********************************************************************** */
/* Subroutine */ int mdi_(n, ia, ja, max_, v, l, head, last, next, mark, tag,
flag_)
integer *n, *ia, *ja, *max_, *v, *l, *head, *last, *next, *mark, *tag, *flag_;
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
STATIC integer jmin, jmax, j, vi, vj, dvi, sfs;
/* ----INITIALIZE DEGREES, ELEMENT LISTS, AND DEGREE LISTS */
/* Parameter adjustments */
--mark;
--next;
--last;
--head;
--l;
--v;
--ja;
--ia;
/* Function Body */
i__1 = *n;
for (vi = 1; vi <= i__1; ++vi) {
mark[vi] = 1;
l[vi] = 0;
/* L1: */
head[vi] = 0;
}
sfs = *n + 1;
/* ----CREATE NONZERO STRUCTURE */
/* ----FOR EACH NONZERO ENTRY A(VI,VJ) IN STRICT UPPER TRIANGLE */
i__1 = *n;
for (vi = 1; vi <= i__1; ++vi) {
jmin = ia[vi];
jmax = ia[vi + 1] - 1;
if (jmin > jmax) {
goto L3;
}
i__2 = jmax;
for (j = jmin; j <= i__2; ++j) {
vj = ja[j];
if (vi >= vj) {
goto L2;
}
if (sfs >= *max_) {
goto L101;
}
/* ------ENTER VJ IN ELEMENT LIST FOR VI */
++mark[vi];
v[sfs] = vj;
l[sfs] = l[vi];
l[vi] = sfs;
++sfs;
/* ------ENTER VI IN ELEMENT LIST FOR VJ */
++mark[vj];
v[sfs] = vi;
l[sfs] = l[vj];
l[vj] = sfs;
++sfs;
L2:
;
}
L3:
;
}
/* ----CREATE DEGREE LISTS AND INITIALIZE MARK VECTOR */
i__1 = *n;
for (vi = 1; vi <= i__1; ++vi) {
dvi = mark[vi];
next[vi] = head[dvi];
head[dvi] = vi;
last[vi] = -dvi;
if (next[vi] > 0) {
last[next[vi]] = vi;
}
/* L4: */
mark[vi] = *tag;
}
return 0;
/* ** ERROR -- INSUFFICIENT STORAGE */
L101:
*flag_ = *n * 9 + vi;
return 0;
} /* mdi_ */
/* *********************************************************************** */
/* MDM -- FORM ELEMENT FROM UNELIMINATED NEIGHBORS OF VK */
/* *********************************************************************** */
/* Subroutine */ int mdm_(vk, tail, v, l, last, next, mark)
integer *vk, *tail, *v, *l, *last, *next, *mark;
{
/* System generated locals */
integer i__1;
STATIC integer equiv_0[1];
/* Local variables */
STATIC integer b, s, lb;
#define es (equiv_0)
STATIC integer vb, ls;
#define vs (equiv_0)
STATIC integer blpmax, tag, blp;
/* ----INITIALIZE TAG AND LIST OF UNELIMINATED NEIGHBORS */
/* Parameter adjustments */
--mark;
--next;
--last;
--l;
--v;
/* Function Body */
tag = mark[*vk];
*tail = *vk;
/* ----FOR EACH VERTEX/ELEMENT VS/ES IN ELEMENT LIST OF VK */
ls = l[*vk];
L1:
s = ls;
if (s == 0) {
goto L5;
}
ls = l[s];
*vs = v[s];
if (next[*vs] < 0) {
goto L2;
}
/* ------IF VS IS UNELIMINATED VERTEX, THEN TAG AND APPEND TO LIST OF */
/* ------UNELIMINATED NEIGHBORS */
mark[*vs] = tag;
l[*tail] = s;
*tail = s;
goto L4;
/* ------IF ES IS ACTIVE ELEMENT, THEN ... */
/* --------FOR EACH VERTEX VB IN BOUNDARY LIST OF ELEMENT ES */
L2:
lb = l[*es];
blpmax = last[*es];
i__1 = blpmax;
for (blp = 1; blp <= i__1; ++blp) {
b = lb;
lb = l[b];
vb = v[b];
/* ----------IF VB IS UNTAGGED VERTEX, THEN TAG AND APPEND TO LIST OF
*/
/* ----------UNELIMINATED NEIGHBORS */
if (mark[vb] >= tag) {
goto L3;
}
mark[vb] = tag;
l[*tail] = b;
*tail = b;
L3:
;
}
/* --------MARK ES INACTIVE */
mark[*es] = tag;
L4:
goto L1;
/* ----TERMINATE LIST OF UNELIMINATED NEIGHBORS */
L5:
l[*tail] = 0;
return 0;
} /* mdm_ */
#undef vs
#undef es
/* *********************************************************************** */
/* MDP -- PURGE INACTIVE ELEMENTS AND DO MASS ELIMINATION */
/* *********************************************************************** */
/* Subroutine */ int mdp_(k, ek, tail, v, l, head, last, next, mark)
integer *k, *ek, *tail, *v, *l, *head, *last, *next, *mark;
{
/* System generated locals */
integer i__1;
/* Local variables */
STATIC integer ofree, i, s, li, es, vi, ls, ilpmax, tag, evi, ilp, lvi;
/* ----INITIALIZE TAG */
/* Parameter adjustments */
--mark;
--next;
--last;
--head;
--l;
--v;
/* Function Body */
tag = mark[*ek];
/* ----FOR EACH VERTEX VI IN EK */
li = *ek;
ilpmax = last[*ek];
if (ilpmax <= 0) {
goto L12;
}
i__1 = ilpmax;
for (ilp = 1; ilp <= i__1; ++ilp) {
i = li;
li = l[i];
vi = v[li];
/* ------REMOVE VI FROM DEGREE LIST */
if (last[vi] == 0) {
goto L3;
}
if (last[vi] > 0) {
goto L1;
}
head[-last[vi]] = next[vi];
goto L2;
L1:
next[last[vi]] = next[vi];
L2:
if (next[vi] > 0) {
last[next[vi]] = last[vi];
}
/* ------REMOVE INACTIVE ITEMS FROM ELEMENT LIST OF VI */
L3:
ls = vi;
L4:
s = ls;
ls = l[s];
if (ls == 0) {
goto L6;
}
es = v[ls];
if (mark[es] < tag) {
goto L5;
}
ofree = ls;
l[s] = l[ls];
ls = s;
L5:
goto L4;
/* ------IF VI IS INTERIOR VERTEX, THEN REMOVE FROM LIST AND ELIMINATE
*/
L6:
lvi = l[vi];
if (lvi != 0) {
goto L7;
}
l[i] = l[li];
li = i;
++(*k);
next[vi] = -(*k);
--last[*ek];
goto L11;
/* ------ELSE ... */
/* --------CLASSIFY VERTEX VI */
L7:
if (l[lvi] != 0) {
goto L9;
}
evi = v[lvi];
if (next[evi] >= 0) {
goto L9;
}
if (mark[evi] < 0) {
goto L8;
}
/* ----------IF VI IS PROTOTYPE VERTEX, THEN MARK AS SUCH, INITIALIZE
*/
/* ----------OVERLAP COUNT FOR CORRESPONDING ELEMENT, AND MOVE VI TO E
ND */
/* ----------OF BOUNDARY LIST */
last[vi] = evi;
mark[evi] = -1;
l[*tail] = li;
*tail = li;
l[i] = l[li];
li = i;
goto L10;
/* ----------ELSE IF VI IS DUPLICATE VERTEX, THEN MARK AS SUCH AND ADJ
UST */
/* ----------OVERLAP COUNT FOR CORRESPONDING ELEMENT */
L8:
last[vi] = 0;
--mark[evi];
goto L10;
/* ----------ELSE MARK VI TO COMPUTE DEGREE */
L9:
last[vi] = -(*ek);
/* --------INSERT EK IN ELEMENT LIST OF VI */
L10:
v[ofree] = *ek;
l[ofree] = l[vi];
l[vi] = ofree;
L11:
;
}
/* ----TERMINATE BOUNDARY LIST */
L12:
l[*tail] = 0;
return 0;
} /* mdp_ */
/* *********************************************************************** */
/* MDU -- UPDATE DEGREES OF UNELIMINATED VERTICES IN EK */
/* *********************************************************************** */
/* Subroutine */ int mdu_(ek, dmin_, v, l, head, last, next, mark)
integer *ek, *dmin_, *v, *l, *head, *last, *next, *mark;
{
/* System generated locals */
integer i__1, i__2;
STATIC integer equiv_0[1];
/* Local variables */
STATIC integer b, i, s;
#define es (equiv_0)
STATIC integer vb, vi;
#define vs (equiv_0)
STATIC integer blpmax, ilpmax, tag, blp, dvi, evi, ilp;
/* ----INITIALIZE TAG */
/* Parameter adjustments */
--mark;
--next;
--last;
--head;
--l;
--v;
/* Function Body */
tag = mark[*ek] - last[*ek];
/* ----FOR EACH VERTEX VI IN EK */
i = *ek;
ilpmax = last[*ek];
if (ilpmax <= 0) {
goto L11;
}
i__1 = ilpmax;
for (ilp = 1; ilp <= i__1; ++ilp) {
i = l[i];
vi = v[i];
if ((i__2 = last[vi]) < 0) {
goto L1;
} else if (i__2 == 0) {
goto L10;
} else {
goto L8;
}
/* ------IF VI NEITHER PROTOTYPE NOR DUPLICATE VERTEX, THEN MERGE ELEM
ENTS */
/* ------TO COMPUTE DEGREE */
L1:
++tag;
dvi = last[*ek];
/* --------FOR EACH VERTEX/ELEMENT VS/ES IN ELEMENT LIST OF VI */
s = l[vi];
L2:
s = l[s];
if (s == 0) {
goto L9;
}
*vs = v[s];
if (next[*vs] < 0) {
goto L3;
}
/* ----------IF VS IS UNELIMINATED VERTEX, THEN TAG AND ADJUST DEGREE
*/
mark[*vs] = tag;
++dvi;
goto L5;
/* ----------IF ES IS ACTIVE ELEMENT, THEN EXPAND */
/* ------------CHECK FOR OUTMATCHED VERTEX */
L3:
if (mark[*es] < 0) {
goto L6;
}
/* ------------FOR EACH VERTEX VB IN ES */
b = *es;
blpmax = last[*es];
i__2 = blpmax;
for (blp = 1; blp <= i__2; ++blp) {
b = l[b];
vb = v[b];
/* --------------IF VB IS UNTAGGED, THEN TAG AND ADJUST DEGREE */
if (mark[vb] >= tag) {
goto L4;
}
mark[vb] = tag;
++dvi;
L4:
;
}
L5:
goto L2;
/* ------ELSE IF VI IS OUTMATCHED VERTEX, THEN ADJUST OVERLAPS BUT DO
NOT */
/* ------COMPUTE DEGREE */
L6:
last[vi] = 0;
--mark[*es];
L7:
s = l[s];
if (s == 0) {
goto L10;
}
*es = v[s];
if (mark[*es] < 0) {
--mark[*es];
}
goto L7;
/* ------ELSE IF VI IS PROTOTYPE VERTEX, THEN CALCULATE DEGREE BY */
/* ------INCLUSION/EXCLUSION AND RESET OVERLAP COUNT */
L8:
evi = last[vi];
dvi = last[*ek] + last[evi] + mark[evi];
mark[evi] = 0;
/* ------INSERT VI IN APPROPRIATE DEGREE LIST */
L9:
next[vi] = head[dvi];
head[dvi] = vi;
last[vi] = -dvi;
if (next[vi] > 0) {
last[next[vi]] = vi;
}
if (dvi < *dmin_) {
*dmin_ = dvi;
}
L10:
;
}
L11:
return 0;
} /* mdu_ */
#undef vs
#undef es
/* *********************************************************************** */
/* *********************************************************************** */
/* *********************************************************************** */
/* SRO -- SYMMETRIC REORDERING OF SPARSE SYMMETRIC MATRIX */
/* *********************************************************************** */
/* Subroutine */ int sro_(n, ip, ia, ja, a, q, r, dflag)
integer *n, *ip, *ia, *ja;
doublereal *a;
integer *q, *r;
logical *dflag;
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
STATIC integer jmin, jmax, i, j, k, ilast;
STATIC doublereal ak;
STATIC integer jdummy, jak;
/* DESCRIPTION */
/* THE NONZERO ENTRIES OF THE MATRIX M ARE ASSUMED TO BE STORED */
/* SYMMETRICALLY IN (IA,JA,A) FORMAT (I.E., NOT BOTH M(I,J) AND M(J,I)
*/
/* ARE STORED IF I NE J). */
/* SRO DOES NOT REARRANGE THE ORDER OF THE ROWS, BUT DOES MOVE */
/* NONZEROES FROM ONE ROW TO ANOTHER TO ENSURE THAT IF M(I,J) WILL BE
*/
/* IN THE UPPER TRIANGLE OF M WITH RESPECT TO THE NEW ORDERING, THEN */
/* M(I,J) IS STORED IN ROW I (AND THUS M(J,I) IS NOT STORED); WHEREAS
*/
/* IF M(I,J) WILL BE IN THE STRICT LOWER TRIANGLE OF M, THEN M(J,I) IS
*/
/* STORED IN ROW J (AND THUS M(I,J) IS NOT STORED). */
/* ADDITIONAL PARAMETERS */
/* Q - INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION = N */
/* R - INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION = NUMBER OF
*/
/* NONZERO ENTRIES IN THE UPPER TRIANGLE OF M */
/* DFLAG - LOGICAL VARIABLE; IF DFLAG = .TRUE., THEN STORE NONZERO */
/* DIAGONAL ELEMENTS AT THE BEGINNING OF THE ROW */
/* -----------------------------------------------------------------------
*/
/* REAL A(1), AK */
/* --PHASE 1 -- FIND ROW IN WHICH TO STORE EACH NONZERO */
/* ----INITIALIZE COUNT OF NONZEROES TO BE STORED IN EACH ROW */
/* Parameter adjustments */
--r;
--q;
--a;
--ja;
--ia;
--ip;
/* Function Body */
i__1 = *n;
for (i = 1; i <= i__1; ++i) {
/* L1: */
q[i] = 0;
}
/* ----FOR EACH NONZERO ELEMENT A(J) */
i__1 = *n;
for (i = 1; i <= i__1; ++i) {
jmin = ia[i];
jmax = ia[i + 1] - 1;
if (jmin > jmax) {
goto L3;
}
i__2 = jmax;
for (j = jmin; j <= i__2; ++j) {
/* --------FIND ROW (=R(J)) AND COLUMN (=JA(J)) IN WHICH TO STORE
A(J) ... */
k = ja[j];
if (ip[k] < ip[i]) {
ja[j] = i;
}
if (ip[k] >= ip[i]) {
k = i;
}
r[j] = k;
/* --------... AND INCREMENT COUNT OF NONZEROES (=Q(R(J)) IN THAT
ROW */
/* L2: */
++q[k];
}
L3:
;
}
/* --PHASE 2 -- FIND NEW IA AND PERMUTATION TO APPLY TO (JA,A) */
/* ----DETERMINE POINTERS TO DELIMIT ROWS IN PERMUTED (JA,A) */
i__1 = *n;
for (i = 1; i <= i__1; ++i) {
ia[i + 1] = ia[i] + q[i];
/* L4: */
q[i] = ia[i + 1];
}
/* ----DETERMINE WHERE EACH (JA(J),A(J)) IS STORED IN PERMUTED (JA,A) */
/* ----FOR EACH NONZERO ELEMENT (IN REVERSE ORDER) */
ilast = 0;
jmin = ia[1];
jmax = ia[*n + 1] - 1;
j = jmax;
i__1 = jmax;
for (jdummy = jmin; jdummy <= i__1; ++jdummy) {
i = r[j];
if (! (*dflag) || ja[j] != i || i == ilast) {
goto L5;
}
/* ------IF DFLAG, THEN PUT DIAGONAL NONZERO AT BEGINNING OF ROW */
r[j] = ia[i];
ilast = i;
goto L6;
/* ------PUT (OFF-DIAGONAL) NONZERO IN LAST UNUSED LOCATION IN ROW */
L5:
--q[i];
r[j] = q[i];
L6:
--j;
}
/* --PHASE 3 -- PERMUTE (JA,A) TO UPPER TRIANGULAR FORM (WRT NEW ORDERING)
*/
i__1 = jmax;
for (j = jmin; j <= i__1; ++j) {
L7:
if (r[j] == j) {
goto L8;
}
k = r[j];
r[j] = r[k];
r[k] = k;
jak = ja[k];
ja[k] = ja[j];
ja[j] = jak;
ak = a[k];
a[k] = a[j];
a[j] = ak;
goto L7;
L8:
;
}
return 0;
} /* sro_ */
evolver-2.30c.dfsg/src/storage.h 0000644 0001753 0001753 00000030700 11410765113 017032 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/********************************************************************
*
* File: storage.h
*
* Purpose: Header file defining details of storage implementation.
* All machine-dependent gory details should be here
* (for inclusion in other source files that need to know)
* or in storage.c (purely private details).
*
* This version has element ids typed as longs.
* Also implements id as offset from element base.
* All elements of same type in one memory block, extended
* as needed. To be used on at least 32 bit machines.
*/
/* using offset as id is 15% faster overall than using ordinal */
#define NUMELEMENTS 5
/* these values used for identification and as index into skeleton info */
#define VERTEX 0
#define EDGE 1
#define FACET 2
#define BODY 3
#define FACETEDGE 4
/* other object type ids, used in mpi transfers for example */
#define QUANTITY_OBJECT 5
#define INSTANCE_OBJECT 6
#ifdef xelement
/*****************************************************************
*
* Universal element identifier. Don't want to use straight
* pointer since base changes when realloced.
* (not actually used; just for documentation)
*/
typedef struct xelement_id {
unsigned int type : 3; /* see enum below */
unsigned int valid: 1; /* valid id bit */
unsigned int sign : 1; /* set for reverse orientation */
unsigned int offset: 27; /* offset from block start */
} xelement_id;
#endif
#ifndef TASK_ID_BITS
#define TASK_ID_BITS 0
#endif
#define MAX_TASK ((1<> TYPESHIFT)
/* to give switched orientation of first if that of second is inverted */
#define same_sign(id1,id2) ((id1) ^ ((id2) & SIGNMASK))
/* to test whether two elements have the same orientation */
#define like_sign(id1,id2) (((id1) & SIGNMASK) == ((id2) & SIGNMASK))
/* number of elements to allocate memory for at one time */
#define BATCHSIZE 100
/* machine number of id, for MPI */
#define id_task(id) (int)(((id)&TASKMASK) >> TASK_ID_SHIFT)
/* for denoting freed spot in hash table */
#define ELHASH_FREE ((struct element *)1)
/* Macros for getting structure pointer from id */
#ifdef HASH_ID
#define elptr(id) ((struct element *)(elhash_lookup(id)))
#define vptr(v_id) ((struct vertex *)(elhash_lookup(v_id)))
#define eptr(e_id) ((struct edge *)(elhash_lookup(e_id)))
#define fptr(f_id) ((struct facet *)(elhash_lookup(f_id)))
#define bptr(b_id) ((struct body *)(elhash_lookup(b_id)))
#define feptr(fe_id) ((struct facetedge *)(elhash_lookup(fe_id)))
#else
/* lookup in ibase pointer list for each element */
#ifdef MPI_EVOLVER
#define elptr(id) ((struct element *)((id_task(id)==this_task?web.skel[id_type(id)].ibase[(id)&OFFSETMASK]:mpi_remote_elptr(id))))
#define vptr(v_id) ((struct vertex *)((id_task(v_id)==this_task?web.skel[VERTEX].ibase[(v_id)&OFFSETMASK]:mpi_remote_elptr(v_id))))
#define eptr(e_id) ((struct edge *)((id_task(e_id)==this_task?web.skel[EDGE].ibase[(e_id)&OFFSETMASK]:mpi_remote_elptr(e_id))))
#define fptr(f_id) ((struct facet *)((id_task(f_id)==this_task?web.skel[FACET].ibase[(f_id)&OFFSETMASK]:mpi_remote_elptr(f_id))))
#define xxbptr(b_id) ((struct body *)((id_task(b_id)==this_task?web.skel[BODY].ibase[(b_id)&OFFSETMASK]:mpi_remote_elptr(b_id))))
#define bptr(b_id) ((struct body *)(web.skel[BODY].ibase[(b_id)&OFFSETMASK]))
#define feptr(fe_id) ((struct facetedge *)((id_task(fe_id)==this_task?web.skel[FACETEDGE].ibase[(fe_id)&OFFSETMASK]:mpi_remote_elptr(fe_id))))
#else
#define elptr(id) ((struct element *)(web.skel[id_type(id)].ibase[(id)&OFFSETMASK]))
#define vptr(v_id) ((struct vertex *)(web.skel[VERTEX].ibase[(v_id)&OFFSETMASK]))
#define eptr(e_id) ((struct edge *)(web.skel[EDGE].ibase[(e_id)&OFFSETMASK]))
#define fptr(f_id) ((struct facet *)(web.skel[FACET].ibase[(f_id)&OFFSETMASK]))
#define bptr(b_id) ((struct body *)(web.skel[BODY].ibase[(b_id)&OFFSETMASK]))
#define feptr(fe_id) ((struct facetedge *)(web.skel[FACETEDGE].ibase[(fe_id)&OFFSETMASK]))
#endif
/* end HASH_ID */
#endif
#define ordinal(id) (valid_id(id) ? (int)((id) & OFFSETMASK) : -1 )
#ifdef MPI_EVOLVER
#define loc_ordinal(id) (valid_id(id) ? (int)(elptr(id)->local_id & OFFSETMASK) : -1 )
#else
#define loc_ordinal(id) (valid_id(id) ? (int)((id) & OFFSETMASK) : -1 )
#endif
/* Macros for producing element name strings for printing. */
/* Note these use global permanent strings to store return string */
/* so printf's with multiple names should use different ELNAMEs. */
/* ELNAME is unsigned, SELNAME is signed */
extern char elnames[10][30];
#ifdef MPI_EVOLVER
#define ELNAME(id) (valid_id(id) ? (sprintf(elnames[0],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[0]) : "")
#define ELNAME1(id) (valid_id(id) ? (sprintf(elnames[1],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[1]) : "")
#define ELNAME2(id) (valid_id(id) ? (sprintf(elnames[2],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[2]) : "")
#define ELNAME3(id) (valid_id(id) ? (sprintf(elnames[3],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[3]) : "")
#define ELNAME4(id) (valid_id(id) ? (sprintf(elnames[4],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[4]) : "")
#define ELNAME5(id) (valid_id(id) ? (sprintf(elnames[5],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[5]) : "")
#define ELNAME6(id) (valid_id(id) ? (sprintf(elnames[6],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[6]) : "")
#define ELNAME7(id) (valid_id(id) ? (sprintf(elnames[7],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[7]) : "")
#define ELNAME8(id) (valid_id(id) ? (sprintf(elnames[8],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[8]) : "")
#define ELNAME9(id) (valid_id(id) ? (sprintf(elnames[9],"%d@%d",(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[9]) : "")
#define SELNAME(id) (valid_id(id) ? (sprintf(elnames[0],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[0]) : "")
#define SELNAME1(id) (valid_id(id) ? (sprintf(elnames[1],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[1]) : "")
#define SELNAME2(id) (valid_id(id) ? (sprintf(elnames[2],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[2]) : "")
#define SELNAME3(id) (valid_id(id) ? (sprintf(elnames[3],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[3]) : "")
#define SELNAME4(id) (valid_id(id) ? (sprintf(elnames[4],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[4]) : "")
#define SELNAME5(id) (valid_id(id) ? (sprintf(elnames[5],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[5]) : "")
#define SELNAME6(id) (valid_id(id) ? (sprintf(elnames[6],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[6]) : "")
#define SELNAME7(id) (valid_id(id) ? (sprintf(elnames[7],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[7]) : "")
#define SELNAME8(id) (valid_id(id) ? (sprintf(elnames[8],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[8]) : "")
#define SELNAME9(id) (valid_id(id) ? (sprintf(elnames[9],"%s%d@%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1,id_task(id)),elnames[9]) : "")
#else
#define ELNAME(id) (valid_id(id) ? (sprintf(elnames[0],"%d",(int)((id)&OFFSETMASK)+1),elnames[0]) : "")
#define ELNAME1(id) (valid_id(id) ? (sprintf(elnames[1],"%d",(int)((id)&OFFSETMASK)+1),elnames[1]) : "")
#define ELNAME2(id) (valid_id(id) ? (sprintf(elnames[2],"%d",(int)((id)&OFFSETMASK)+1),elnames[2]) : "")
#define ELNAME3(id) (valid_id(id) ? (sprintf(elnames[3],"%d",(int)((id)&OFFSETMASK)+1),elnames[3]) : "")
#define ELNAME4(id) (valid_id(id) ? (sprintf(elnames[4],"%d",(int)((id)&OFFSETMASK)+1),elnames[4]) : "")
#define ELNAME5(id) (valid_id(id) ? (sprintf(elnames[5],"%d",(int)((id)&OFFSETMASK)+1),elnames[5]) : "")
#define ELNAME6(id) (valid_id(id) ? (sprintf(elnames[6],"%d",(int)((id)&OFFSETMASK)+1),elnames[6]) : "")
#define ELNAME7(id) (valid_id(id) ? (sprintf(elnames[7],"%d",(int)((id)&OFFSETMASK)+1),elnames[7]) : "")
#define ELNAME8(id) (valid_id(id) ? (sprintf(elnames[8],"%d",(int)((id)&OFFSETMASK)+1),elnames[8]) : "")
#define ELNAME9(id) (valid_id(id) ? (sprintf(elnames[9],"%d",(int)((id)&OFFSETMASK)+1),elnames[9]) : "")
#define SELNAME(id) (valid_id(id) ? (sprintf(elnames[0],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[0]) : "")
#define SELNAME1(id) (valid_id(id) ? (sprintf(elnames[1],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[1]) : "")
#define SELNAME2(id) (valid_id(id) ? (sprintf(elnames[2],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[2]) : "")
#define SELNAME3(id) (valid_id(id) ? (sprintf(elnames[3],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[3]) : "")
#define SELNAME4(id) (valid_id(id) ? (sprintf(elnames[4],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[4]) : "")
#define SELNAME5(id) (valid_id(id) ? (sprintf(elnames[5],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[5]) : "")
#define SELNAME6(id) (valid_id(id) ? (sprintf(elnames[6],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[6]) : "")
#define SELNAME7(id) (valid_id(id) ? (sprintf(elnames[7],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[7]) : "")
#define SELNAME8(id) (valid_id(id) ? (sprintf(elnames[8],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[8]) : "")
#define SELNAME9(id) (valid_id(id) ? (sprintf(elnames[9],"%s%d",(inverted(id)?"-":""),(int)((id)&OFFSETMASK)+1),elnames[9]) : "")
#endif
/* Macros for manipulating and testing element ids */
#define edge_inverse(id) inverse_id(id)
#define facet_inverse(id) inverse_id(id)
#define fe_inverse(id) inverse_id(id)
#define invert(id) ((id) ^= SIGNMASK)
#define equal_id(a,b) ((a)==(b))
#define equal_element(a,b) (((a)|SIGNMASK) == ((b)|SIGNMASK))
#define valid_id(id) ((int)(((id)&VALIDMASK) >> VALIDSHIFT))
#define inverted(id) ((int)(((id)&SIGNMASK) >> SIGNSHIFT))
#define inverse_id(id) ((id) ^ SIGNMASK)
#define positive_id(id) ((id) & ~SIGNMASK)
typedef int ORDTYPE; /* element numbering type */
typedef struct element *INDIRECT_TYPE;
extern struct blocklist_struct
{ struct element *blockptr; /* allocated block */
int start_ord; /* ordinal of first element */
int count; /* elements in block */
} *blocklist[NUMELEMENTS];
extern int blockcount[NUMELEMENTS]; /* how many blocks allocated */
extern int blockmax[NUMELEMENTS]; /* length of blocklist */
/* individual indirect block pointer arrays */
extern INDIRECT_TYPE *vibase;
extern INDIRECT_TYPE *eibase;
extern INDIRECT_TYPE *fibase;
extern INDIRECT_TYPE *bibase;
extern INDIRECT_TYPE *feibase;
/* for getting id1 with orientation sign of id2 */
#define copy_sign(id1,id2) (((id1)&~SIGNMASK) | ((id2) & SIGNMASK))
evolver-2.30c.dfsg/src/rl_head.h 0000644 0001753 0001753 00000010607 11410765113 016770 0 ustar hazelsct hazelsct "actual_volume",
"alice",
"approx_curvature",
"approximate_curvature",
"area",
"area_fixed",
"area_method_name",
"area_normalization",
"areaweed",
"attribute",
//"attributes",
"autochop",
"autodisplay",
"autopop",
"autorecalc",
"axial_point",
"backbody",
"backcolor",
"bare",
"bezier_basis",
"bodies",
"body",
"bottominfo",
//"boundaries",
"boundary",
"boundary_curvature",
"break",
"burchard",
"bye",
"chdir",
"check",
"clipped_cells",
"close_show",
"color",
"colorfile",
"conducting_knot_energy",
"conformal_metric",
"connected_cells",
"conserved",
"constraint",
"constraint_tolerance",
//"constraints",
"content",
"continue",
"convert_to_quantities",
"convex",
"count",
"counts",
"datafilename",
"date_and_time",
"debug",
"define",
"delete",
"density",
"diffusion",
"dihedral",
"dirichlet",
"dirichlet_mode",
"dissolve",
"do",
"dump",
//"e",
"edge",
"edge_divide",
//"edges",
"edgeswap",
"edgeweed",
"effective_area",
"efixed",
"eigenprobe",
"element_modulus",
"else",
"energy",
"eprint",
"equiangulate",
"errprintf",
"estimate",
"everything_quantities",
"evolver_version",
"exec",
"exit",
"exprint",
"extrapolate",
"face",
//"faces",
//"facet",
"facet_edge",
//"facet_edges",
//"facetedge",
"facetedges",
//"facets",
"fix",
"fixed",
"fixed_area",
"for",
"foreach",
"form_integrand",
"formula",
"frontbody",
"frontcolor",
"function",
//"g",
"gap_constant",
"gauss_curvature",
"geompipe",
"geomview",
"global",
"global_method",
"go",
"gravity",
"gravity_constant",
"gridflag",
"help",
"hessian",
"hessian_menu",
"hessian_seek",
"hessian_special_normal_vector",
"histogram",
"history",
"hit_constraint",
"hit_partner",
"homothety",
"id",
"if",
"ignore_constraints",
"ignore_fixed",
//"imod",
"info_only",
"insulating_knot_energy",
"integer",
"integral_order",
"integral_order_1d",
"integral_order_2d",
//"integration_order",
//"integration_order_1d",
//"integration_order_2d",
"interp_bdry_param",
"is_defined",
"jiggle",
"k_vector_order",
"keep_macros",
"keep_originals",
"keylogfile",
"klein_metric",
"kmetis",
"labelflag",
"lagrange",
"lagrange_multiplier",
"lagrange_order",
"lanczos",
"length",
"length_method_name",
"linear",
"list",
"load",
"load_library",
"local",
"logfile",
"loghistogram",
"longj",
"mean_curvature",
"mean_curvature_integral",
"merit_factor",
"method",
"method_instance",
"metis",
"metis_factor",
"metric",
"midv",
"mobility",
"mobility_tensor",
"move",
"new_body",
"new_edge",
"new_facet",
"new_vertex",
"no_display",
"no_refine",
"nodisplay",
"noncontent",
"nonnegative",
"nonpositive",
"nonwall",
"normal_curvature",
"notch",
"oid",
"ometis",
"on_boundary",
"on_constraint",
"ooglfile",
"opacity",
//"optimise",
//"optimising_parameter",
"optimize",
"optimizing_parameter",
"orientation",
"original",
"parameter",
"parameter_1",
"parameter_file",
"parameters",
"partner_hitting",
"pause",
"pdelta",
"periods",
"permload",
"phase",
"phasefile",
//"pi",
"pop",
"pop_edge_to_tri",
"pop_quad_to_quad",
"pop_tri_to_edge",
"postscript",
"pressure",
"print",
"printf",
"procedure",
"procedures",
"pscale",
"pscolorflag",
"quadratic",
"quantity",
"quiet",
"quietgo",
"quietload",
"quit",
"raw_vertex_average",
"rawest_vertex_average",
"rawestv",
"rawv",
"read",
"real",
"rebody",
"recalc",
"refine",
"renumber_all",
"reorder_storage",
"return",
"ritz",
"runge_kutta",
"saddle",
"scalar_integrand",
"scale",
"scale_limit",
"self",
"set",
"shading",
"shell",
"show",
"show_all_quantities",
"show_expr",
"show_inner",
"show_off",
"show_outer",
"show_trans",
"show_vol",
"showq",
"simplex_representation",
"sizeof",
"soapfilm",
"sobolev_mode",
"sobolev_seek",
"space_dimension",
"spring_constant",
"sprintf",
"sqcurve",
"square_curvature",
"square_gaussian_curvature",
"squared_curvature",
"squared_gaussian_curvature",
"stability_test",
"string",
//"sum",
"surface_dimension",
"surface_energy",
"swap_colors",
"symmetric_content",
"symmetry_group",
"system",
"tag",
"target",
"temperature",
"tension",
"tetra_point",
"then",
"thicken",
"tolerance",
"topinfo",
"torus",
"torus_filled",
"torus_periods",
"total",
"total_time",
"transform_depth",
"transform_expr",
"triple_point",
"ulong",
"unfix",
"unset",
"utest",
"valence",
"value",
"vector_integrand",
"verbose",
"vertex",
"vertex_average",
"vertexnormal",
"vertices",
"view_matrix",
"view_transform_generators",
"view_transforms",
"visibility_test",
"volconst",
"volfixed",
"volume",
"volume_method_name",
"warning_messages",
"where",
"while",
"wrap",
"wrap_vertex",
"wulff",
"zoom",
"zoom_radius",
"zoom_vertex",
evolver-2.30c.dfsg/src/alloca.c 0000644 0001753 0001753 00000001731 11410765113 016616 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************
*
* File: alloca.c
*
* Contents: Kludge substitute for alloca() for those
* systems that do not have it. alloca() is
* an old unix function that allocates memory
* from the stack. The version of YACC I use
* uses alloca in case of parsing stack overflow,
* so alloca should almost never be called.
* Link with this file only if the linker
* complains about not finding alloca.
* This file simply substitutes a call to
* malloc(), so represents a potential
* memory leak.
*/
#include "include.h"
void * alloca(size_t size)
{ return (void*)malloc(size);
}
evolver-2.30c.dfsg/src/calcforc.c 0000644 0001753 0001753 00000057215 11410765113 017147 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: calcforc.c
*
* Contents: Functions calculating energy, volume, and
* their gradients at vertices.
*/
#include "include.h"
#ifdef THREADS
/******************************************************************
*
* function: thread_calc_facet_energy()
*
* purpose: thread-friendly calculation of classic facet energy.
*/
void thread_calc_facet_energy()
{
#ifdef OLDTHNEXT
facet_id f_id;
THREAD_FOR_ALL_FACETS(f_id)
(*calc_facet_energy)(f_id,ALL_ENERGIES);
#else
THREAD_FOR_ALL_NEW(FACET, {(*calc_facet_energy)(*idptr,ALL_ENERGIES);});
#endif
}
/******************************************************************
*
* function: thread_calc_facet_forces()
*
* purpose: thread-friendly calculation of classic facet forces.
*/
void thread_calc_facet_forces()
{
#ifdef OLDTHNEXT
facet_id f_id;
THREAD_FOR_ALL_FACETS(f_id)
{
(*calc_facet_forces)(f_id);
}
#else
THREAD_FOR_ALL_NEW(FACET,(*calc_facet_forces)(*idptr))
#endif
}
#endif
/* THREADS */
/*******************************************************************
*
* Function: calc_energy()
*
* Purpose: Wrapper for total energy calculation.
*
*
*/
void calc_energy()
{
#ifdef MPI_EVOLVER
mpi_calc_energy();
#else
local_calc_energy();
#endif
}
/*******************************************************************
*
* Function: local_calc_energy()
*
* Purpose: Finds total energy of configuration.
* Requires volumes set to calculate pressure energy.
*
*/
void local_calc_energy()
{
int i;
body_id b_id;
edge_id e_id;
web.total_energy = 0.0;
web.total_area = 0.0;
for ( i = 0 ; i < MAXADDENDS ; i++ )
{ web.total_area_addends[i] = 0.0;
web.total_energy_addends[i] = 0.0;
}
web.spring_energy = 0.0;
euclidean_area = 0.0;
if ( web.modeltype == LAGRANGE && !quantities_only_flag )
{ if ( auto_convert_flag ) convert_to_quantities();
else
kb_error(1774,"LAGRANGE model needs convert_to_quantities.\n",RECOVERABLE);
}
if ( min_square_grad_flag ) { web.total_energy = square_grad(); return; }
if ( quantities_only_flag ) goto quantities_only;
if ( square_curvature_flag )
{ if ( globals(square_curvature_param)->value.real == 0.0 )
square_curvature_flag &= ~EVALUATE;
else square_curvature_flag |= EVALUATE;
}
if ( mean_curv_int_flag )
{ if ( globals(square_curvature_param)->value.real == 0.0 )
mean_curv_int_flag &= ~EVALUATE;
else mean_curv_int_flag |= EVALUATE;
}
if ( sqgauss_flag )
{ if ( globals(sqgauss_param)->value.real == 0.0 )
sqgauss_flag &= ~EVALUATE;
else sqgauss_flag |= EVALUATE;
}
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy_init();
if ( web.representation == SIMPLEX )
{ facet_id f_id;
FOR_ALL_FACETS(f_id)
calc_simplex_energy(f_id);
FOR_ALL_EDGES(e_id)
calc_simplex_edge_energy(e_id);
}
else if ( web.representation == STRING )
{ vertex_id v_id;
FOR_ALL_EDGES(e_id)
{ ATTR attr = get_eattr(e_id);
(*calc_edge_energy)(e_id);
if ( attr & BDRY_ENERGY )
calc_constr_energy_e(e_id); /* substitute surface energy */
}
/* boundary energy and square curvature */
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy_string_init();
FOR_ALL_VERTICES(v_id)
{ ATTR attr = get_vattr(v_id);
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy_string(v_id);
if ( attr & BDRY_ENERGY )
{ if ( attr & CONSTRAINT )
calc_constr_energy_v(v_id);
}
}
} /* end STRING */
else /* web.representation == SOAPFILM */
{ facet_id f_id;
if ( threadflag )
thread_launch(TH_CALC_FACET_ENERGY,FACET);
else
{ FOR_ALL_FACETS(f_id)
(*calc_facet_energy)(f_id,ALL_ENERGIES);
}
FOR_ALL_EDGES(e_id)
{ ATTR attr = get_eattr(e_id);
if ( attr & BDRY_ENERGY )
{ if ( attr & CONSTRAINT )
calc_constr_energy_e(e_id);
}
if ( attr & DENSITY )
(*calc_edge_energy)(e_id); /* for triple line energies */
}
} /* end SOAPFILM */
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy_end();
if ( (square_curvature_flag & EVALUATE) && kusner_flag )
kusner_energy();
if ( (square_curvature_flag & EVALUATE) && conf_edge_curv_flag )
conf_edge_curv_energy();
if ( sqgauss_flag & EVALUATE ) sqgauss_energy();
/* Add kludge forces on boundary edges to prevent pulling away */
/* Could use more exact test to see if worth calling these */
if ( (web.modeltype == LINEAR) && (web.convex_flag) )
{
if ( web.bdrymax > 0 )
FOR_ALL_EDGES(e_id)
bdry_spring_energy(e_id);
if ( web.maxcon > 0 )
FOR_ALL_EDGES(e_id)
constr_spring_energy(e_id);
}
quantities_only:
FOR_ALL_BODIES(b_id)
{ REAL fix,vol;
fix = get_body_fixvol(b_id);
vol = get_body_volume(b_id);
if ( web.pressure_flag && (get_battr(b_id) & FIXEDVOL)
&& !quantities_only_flag )
{
if ( !equal_id(b_id,web.outside_body) )
{ binary_tree_add(web.total_energy_addends,
-web.pressure*(fix*log(vol/fix)-(vol-fix)));
if ( valid_id(web.outside_body) )
binary_tree_add(web.total_energy_addends,web.pressure*vol);
set_body_pressure(b_id,web.pressure*fix/vol);
}
}
else if ( (get_battr(b_id) & PRESSURE) && !quantities_only_flag )
binary_tree_add(web.total_energy_addends,-get_body_pressure(b_id)*vol);
}
if ( gen_quant_count )
web.total_energy += calc_quants(Q_ENERGY);
/* finalize web.total_area */
for ( i = 0 ; i < MAXADDENDS ; i++ )
{ web.total_area += web.total_area_addends[i];
web.total_energy += web.total_energy_addends[i];
}
extrap_val[reflevel] = web.total_energy;
} /* end calc_energy() */
/****************************************************************
*
* Function: calc_force()
*
* Purpose: Calls proper energy gradient calculator.
*
*/
void calc_force()
{
#ifdef MPI_EVOLVER
mpi_calc_force();
#else
local_calc_force();
#endif
}
/****************************************************************
*
* Function: calc_force()
*
* Purpose: calculates net force at triangulation vertices due
* to surface tension and constraints
*
*/
void local_calc_force()
{
vertex_id v_id;
facet_id f_id;
edge_id e_id;
int i;
/* zero out vertex cumulative quantities */
MFOR_ALL_VERTICES(v_id)
{ REAL *f = get_force(v_id);
for ( i = 0 ; i < SDIM ; i ++ ) f[i] = 0.0;
set_vertex_star(v_id,0.0);
set_vertex_valence(v_id,0);
}
if ( min_square_grad_flag ) { square_grad_forces(); return; }
if ( quantities_only_flag ) goto grad_quantities_only;
if ( square_curvature_flag )
{ if ( globals(square_curvature_param)->value.real == 0.0 )
square_curvature_flag &= ~EVALUATE;
else square_curvature_flag |= EVALUATE;
}
if ( mean_curv_int_flag )
{ if ( globals(mean_curvature_param)->value.real == 0.0 )
mean_curv_int_flag &= ~EVALUATE;
else mean_curv_int_flag |= EVALUATE;
}
if ( sqgauss_flag )
{ if ( globals(sqgauss_param)->value.real == 0.0 )
sqgauss_flag &= ~EVALUATE;
else sqgauss_flag |= EVALUATE;
}
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_force_init();
if ( unit_normal_flag ) /* for Dennis DeTurck */
{
FOR_ALL_VERTICES(v_id)
{ REAL *f = get_force(v_id);
facetedge_id fe = get_vertex_fe(v_id);
if ( inverted(get_fe_facet(fe)) ) fe = get_next_facet(fe);
calc_vertex_normal(v_id,fe,f);
for ( i = 0 ; i < SDIM ; i++ )
f[i] *= deturck_factor;
}
/* continue with other forces */
}
/* boundary and constraint forces */
if ( web.representation == SIMPLEX )
{ FOR_ALL_EDGES(e_id)
calc_simplex_edge_force(e_id);
}
else if ( web.representation == STRING )
{ if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_energy_string_init();
FOR_ALL_VERTICES(v_id)
{ ATTR attr = get_vattr(v_id);
if ( attr & FIXED ) continue;
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE)
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_force_string(v_id);
if ( !(attr & BDRY_ENERGY) ) continue;
if ( attr & CONSTRAINT )
calc_constr_force_v(v_id);
}
}
else /* SOAPFILM */
{ FOR_ALL_EDGES(e_id)
{ ATTR attr = get_eattr(e_id);
if ( attr & DENSITY )
(*calc_edge_forces)(e_id); /* for triple line energies */
if ( !(attr & BDRY_ENERGY) ) continue;
if ( attr & CONSTRAINT )
calc_constr_force_e(e_id);
}
}
if ( web.representation == SIMPLEX )
{ FOR_ALL_FACETS(f_id)
calc_simplex_forces(f_id);
}
else if ( web.representation == STRING )
{ /* tension forces */
/* add each edge's contribution to its endpoints */
FOR_ALL_EDGES(e_id)
{ ATTR attr = get_eattr(e_id);
(*calc_edge_forces)(e_id);
if ( attr & BDRY_ENERGY )
calc_constr_force_e(e_id); /* substitute surface energy */
}
}
else /* get here only for SOAPFILM */
{ /* tension forces */
/* find each triangle's contribution to forces on its vertices */
if ( threadflag )
thread_launch(TH_CALC_FACET_FORCES,FACET);
else
FOR_ALL_FACETS(f_id)
(*calc_facet_forces)(f_id);
}
if ( ((square_curvature_flag | mean_curv_int_flag) & EVALUATE )
&& !kusner_flag && !conf_edge_curv_flag )
sqcurve_force_end();
if ( (square_curvature_flag & EVALUATE) && kusner_flag )
kusner_force();
if ( (square_curvature_flag & EVALUATE) && conf_edge_curv_flag)
conf_edge_curv_force();
if ( sqgauss_flag & EVALUATE )
sqgauss_force();
/* Add kludge forces on boundary edges to prevent pulling away */
if ( (web.modeltype == LINEAR) & web.convex_flag )
{ FOR_ALL_EDGES(e_id)
{ bdry_force(e_id);
constr_springs(e_id);
}
}
grad_quantities_only:
/* general quantity forces */
calc_quant_grads(Q_ENERGY);
/* derivatives with respect to optimizing parameters */
if ( optparamcount > 0 )
{ struct oldcoord csaved;
csaved.coord = NULL;
save_coords(&csaved,SAVE_SEPARATE);
for ( i = 0 ; i < optparamcount ; i++ )
{ REAL dp;
REAL emid = web.total_energy;
REAL eleft,eright;
dp = globals(optparam[i].pnum)->attr.varstuff.delta;
/* right difference */
globals(optparam[i].pnum)->value.real += dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
{ calc_content(Q_FIXED);
/*volume_restore();*/
/*calc_pressure();*/
}
calc_energy(); /* energy after motion */
eright = web.total_energy;
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
/* left difference */
globals(optparam[i].pnum)->value.real -= dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
{ calc_content(Q_FIXED);
/*volume_restore(); */
/*calc_pressure(); */
}
calc_energy(); /* energy after motion */
eleft = web.total_energy;
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
web.total_energy = emid; /* restore */
optparam[i].grad = (eright - eleft)/2/dp;
}
unsave_coords(&csaved,SAVE_SEPARATE);
}
} /* end calc_force() */
/*********************************************************************
*
* function force_normalization()
*
* purpose: now have total energy gradient (which is a covector) and
* need to convert to a velocity vector, which requires
* multiplication by the inverse of a metric matrix.
* Default is Euclidean (identity matrix).
*/
void force_normalization()
{
vertex_id v_id;
int i,j;
MAT2D(a,MAXPARAM,MAXCOORD);
if ( web.metric_flag && metric_convert_flag )
FOR_ALL_VERTICES(v_id)
{ if ( !(get_attr(v_id) & FIXED) )
metric_form_to_vector(get_coord(v_id),get_force(v_id));
}
/* do area normalization */
if ( web.area_norm_flag && !approx_curve_flag)
{ FOR_ALL_VERTICES(v_id)
{ REAL area = ((web.representation==STRING)?get_vertex_length_star(v_id):
get_vertex_area_star(v_id))/star_fraction;
REAL *force = get_force(v_id);
REAL ff;
if ( get_vattr(v_id) & FIXED ) continue;
if ( effective_area_flag && (web.representation == STRING) )
{ /* calculate effective area */
REAL d;
int valence = get_vertex_valence(v_id);
ff = SDIM_dot(force,force);
if ( ff == 0.0 ) continue;
d = get_edge_density(get_vertex_edge(v_id));
ff /= d*d;
if ( valence == 2 )
{ REAL f2;
f2 = sqrt(ff)/2;
area *= sqrt(1 - ff/4)*f2/asin(f2);
}
else if ( valence == 1 )
{ if ( !(get_vattr(v_id) & (FIXED|CONSTRAINT|BOUNDARY) ) )
{ edge_id e_id = get_vertex_edge(v_id);
vertex_id other_v = get_edge_headv(e_id);
eliminate_edge(e_id);
free_element(e_id);
add_vertex_valence(other_v,-1);
continue;
}
area *= sqrt(1 - ff/4);
}
else if ( valence == 0 )
area = 1.0; /* disconnected pt; no force anyway */
else if ( (valence == 3) && !old_area_flag )
{ /* for density 1 edges only */
edge_id e_id;
REAL ss[3],f[MAXCOORD],side[3][MAXCOORD];
REAL ang12,ang13,det,leg[2][MAXCOORD];
area = 0.0;
e_id = get_vertex_edge(v_id);
for ( i = 0 ; i < 3 ; i++ )
{ get_edge_side(e_id,side[i]);
ss[i] = sqrt(SDIM_dot(side[i],side[i]));
e_id = get_next_tail_edge(e_id);
}
ang12 = acos(SDIM_dot(side[0],side[1])/ss[0]/ss[1]) - 2*M_PI/3;
ang13 = acos(SDIM_dot(side[0],side[2])/ss[0]/ss[2]) - 2*M_PI/3;
for ( j = 0 ; j < SDIM ; j++ )
{ leg[0][j] = side[1][j] - side[0][j];
leg[1][j] = side[0][j] - side[2][j];
}
det = fabs(leg[0][0]*leg[1][1] - leg[0][1]*leg[1][0]);
if ( det != 0.0 )
{ f[0] = (leg[1][0]*ang12 - leg[0][0]*ang13)/det;
f[1] = (leg[1][1]*ang12 - leg[0][1]*ang13)/det;
area = -0.5*(f[0]*force[0]+f[1]*force[1])/ (f[0]*f[0]+f[1]*f[1]);
}
else area = f[0] = f[1] = 0.0;
set_vertex_star(v_id,star_fraction*area);
for ( i = 0 ; i < 2 ; i++ )
force[i] = -2*f[i];
continue;
}
else /* triple point at least */
{ edge_id e_id,start_e;
REAL ss,fs,side[MAXCOORD];
area = 0.0;
e_id = start_e = get_vertex_edge(v_id);
do
{ get_edge_side(e_id,side);
ss = SDIM_dot(side,side);
fs = SDIM_dot(force,side);
ff = SDIM_dot(force,force);
area += 0.5*sqrt(ff*ss - fs*fs);
e_id = get_next_tail_edge(e_id);
}
while ( !equal_id(e_id,start_e) );
}
set_vertex_star(v_id,star_fraction*area);
}
else if ( effective_area_flag && (web.representation == SOAPFILM) )
{ /* crude correction for triple edges and tetra points */
if ( get_vattr(v_id) & TRIPLE_PT )
area /= sqrt(3.);
else if ( get_vattr(v_id) & TETRA_PT )
area /= sqrt(6.);
}
if ( area == 0.0 )
{ sprintf(errmsg,"Zero area around vertex %s.\n",ELNAME(v_id));
kb_error(1453,errmsg,RECOVERABLE);
}
for ( i = 0 ; i < SDIM ; i++ )
force[i] /= area;
}
} /* end web.area_norm_flag && !approx_curve_flag */
/* project to parameter space for boundary points */
FOR_ALL_VERTICES(v_id)
{ int pcount;
REAL *f = get_force(v_id);
REAL tmp[MAXCOORD];
struct boundary *bdry;
int m;
if ( get_vattr(v_id) & FIXED ) continue;
if ( !(get_vattr(v_id) & BOUNDARY) ) continue;
bdry = get_boundary(v_id);
pcount = bdry->pcount;
b_proj(bdry,get_param(v_id),a,PARAMPROJ,v_id);
matvec_mul(a,f,tmp,pcount,SDIM);
for ( m = 0 ; m < pcount ; m++ ) f[m] = tmp[m];
for ( m = pcount ; m < SDIM ; m++ ) f[m] = 0.0;
}
return;
} /* end force_normalization */
/*************************************************************
*
* Function: calc_content()
*
* Purpose: wrapper for local_calc_content, and
* calculates body volumes diffs
*
* Return value: total difference from fixed value constraints
*/
REAL calc_content ARGS1((mode),
int mode)
{ body_id b_id,bi_id;
int k;
REAL diff = 0.0;
struct gen_quant *gq;
facet_id f_id;
/* starting body volumes */
FOR_ALL_BODIES(b_id)
{ int attr = get_battr(b_id);
if ( !everything_quantities_flag || ((attr & FIXEDVOL) && (mode & Q_FIXED))
|| ((attr & PRESSURE) && (mode & (Q_ENERGY|Q_INFO)) )
|| (!(attr & (FIXEDVOL|PRESSURE)) && (mode & Q_INFO)) )
{ set_body_volume(b_id,get_body_volconst(b_id),NOSETSTAMP);
if ( web.representation == STRING )
{ /* kludge for calculating separate facet areas */
facet_id start_f = get_body_facet(b_id);
f_id = start_f;
if ( valid_id(f_id) )
{ do
{ set_facet_area(f_id,0.0);
f_id = get_next_body_facet(f_id);
} while ( !equal_id(f_id,start_f));
}
}
}
}
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
mpi_calc_content(mode);
else
#endif
local_calc_content(mode);
if ( web.torus_flag )
{ /* do volume adjust to get continuity with old volume, or fixed volume */
FOR_ALL_BODIES(b_id)
{ REAL vol = get_body_volume(b_id);
REAL dvol = 0.0;
REAL new_vc;
if ( (get_battr(b_id) & FIXEDVOL) && !web.pressure_flag )
{ REAL ovol = get_body_fixvol(b_id);
dvol = web.torusv*floor((ovol-vol)/web.torusv+0.5);
add_body_volume_plain(b_id,dvol);
save_body_volume(b_id);
}
else if (mode & Q_RENORMALIZE) /* set between 0 and 1 */
{ dvol = -web.torusv*floor(vol/web.torusv);
add_body_volume_plain(b_id,dvol);
save_body_volume(b_id);
}
else /* enforce continuity */
{ REAL ovol = get_body_oldvolume(b_id);
dvol = web.torusv*floor((ovol-vol)/web.torusv+0.5);
add_body_volume_plain(b_id,dvol);
}
new_vc = get_body_volconst(b_id)+dvol;
set_body_volconst(b_id,new_vc);
if ( (web.representation == STRING) && (new_vc != 0.0) )
{ /* apply volconst to most worthy facet */
facet_id f_id = get_body_facet(b_id);
facet_id start_f = f_id;
REAL worst_a = new_vc > 0.0 ? 1e30 : -1e30;
facet_id best_f = NULLID;
if ( valid_id(f_id) )
do
{ REAL a = get_facet_area(f_id);
if ( inverted(f_id) )
a = -a;
if ( ((new_vc > 0.0) && (a < worst_a))
|| ((new_vc < 0.0) && (a > worst_a)) )
{ best_f = f_id;
worst_a = a;
}
f_id = get_next_body_facet(f_id);
} while ( !equal_id(f_id,start_f) );
if ( valid_id(best_f) )
add_facet_area(best_f,new_vc);
}
}
}
if ( mode & Q_RENORMALIZE )
{ /* take care of bodies with declared actual volume */
FOR_ALL_BODIES(b_id)
if ( get_battr(b_id) & ACTUALVOL )
{ REAL calcvol = get_body_volume(b_id);
REAL actual = get_body_actualvolume(b_id);
set_body_volume(b_id,actual,SETSTAMP);
set_body_volconst(b_id,get_body_volconst(b_id)+actual-calcvol);
save_body_volume(b_id);
}
}
web.vol_flag = 1;
/* get total deviation from constraints */
if ( !everything_quantities_flag && !web.pressure_flag )
FOR_ALL_BODIES(bi_id)
{ REAL absvol = get_body_abstotal(b_id);
REAL target = get_body_fixvol(bi_id);
REAL actual = get_body_volume(bi_id);
if ( !(get_battr(bi_id) & FIXEDVOL) ) continue;
diff += fabs(target - actual)/
(web.target_tolerance*(absvol?absvol:1.0));
}
for ( k = 0 ; k < gen_quant_count ; k++ )
{ gq = GEN_QUANT(k);
if ( !(gq->flags & Q_FIXED) ) continue;
if ( gq->tolerance > 0.0 )
diff += fabs(gq->target - gq->value)/(gq->tolerance*gq->abstotal);
else
diff += fabs(gq->target - gq->value)/(web.target_tolerance*gq->abstotal);
}
if ( mode & Q_FIXED )
fixed_volume_timestamp = global_timestamp;
if ( mode & Q_INFO )
info_volume_timestamp = global_timestamp;
return diff;
}
/*************************************************************
*
* Function: local_calc_content()
*
* Purpose: calculates body volumes on local piece of surface.
*
*/
void local_calc_content ARGS1((mode),
int mode) /* Q_FIXED | Q_INFO | Q_RENORMALIZE */
{
facet_id f_id;
facetedge_id fe_id;
body_id b_id;
FOR_ALL_BODIES(b_id)
{ /* initialize binary tree add */
struct body *ptr;
int k;
ptr = bptr(b_id);
for ( k = 0 ; k < MAXADDENDS ; k++ )
ptr->volume_addends[k] = 0;
}
if ( gen_quant_count )
calc_quants(mode);
if ( quantities_only_flag ) return;
if ( web.bodycount == 0 ) return;
if ( web.representation == SIMPLEX )
{ FOR_ALL_FACETS(f_id)
calc_simplex_volume(f_id);
}
else if ( web.representation == STRING )
{ vertex_id v_id;
FOR_ALL_FACETEDGES(fe_id)
(*calc_edge_area)(fe_id);
FOR_ALL_VERTICES(v_id)
{ ATTR attr = get_vattr(v_id);
if ( !(attr & BDRY_CONTENT) ) continue;
if ( attr & CONSTRAINT )
calc_constr_content_v(v_id);
}
}
else if ( web.representation == SOAPFILM )
{ if ( web.torus_flag ) torvol();
else
{ edge_id e_id;
FOR_ALL_FACETS(f_id)
(*calc_facet_volume)(f_id);
FOR_ALL_EDGES(e_id)
{ ATTR attr = get_eattr(e_id);
if ( !(attr & BDRY_CONTENT) ) continue;
if ( attr & CONSTRAINT )
calc_constr_content_e(e_id);
}
}
}
/* finish binary tree accumulation */
FOR_ALL_BODIES(b_id)
{ REAL sum = 0.0;
struct body *ptr = bptr(b_id);
int k;
for ( k = 0 ; k < MAXADDENDS ; k++ )
sum += ptr->volume_addends[k];
add_body_volume_plain(b_id,sum);
}
} /* end local_calc_content() */
/*************************************************************
*
* Function: calc_pressure()
*
* Purpose: calculates body volumes and pressures on faces
*/
void calc_pressure()
{
body_id b_id;
if ( !web.pressure_flag ) return;
calc_content(Q_FIXED);
/* now compute pressure in each body */
FOR_ALL_BODIES(b_id)
{
REAL p;
if ( equal_id(b_id,web.outside_body) )
p = web.pressure;
else if ( get_battr(b_id) & FIXEDVOL )
{ if ( get_body_volume(b_id) > 0.0 )
p = web.pressure*get_body_fixvol(b_id)/get_body_volume(b_id);
else
{ sprintf(errmsg,"Body %s has volume %f\n",ELNAME(b_id),
(DOUBLE)get_body_volume(b_id));
kb_error(1776,errmsg,WARNING);
p = 0.0;
}
}
else
{ p = 0.0;
}
set_body_pressure(b_id,p);
}
} /* end calc_pressure() */
evolver-2.30c.dfsg/src/sqcurve3.c 0000644 0001753 0001753 00000162316 11410765113 017145 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: sqcurve3.c
*
* Purpose: Does calculations needed for including square curvature
* in energy. Linear model only.
* Named quantity methods.
*
* Vertex star approach.
*
* Assumes complete star around vertex. v_info comes in with
* central vertex first, followed by ring in order. Sides
* are in same order.
*/
#include "include.h"
/* some timing results:
4-processor 4400 SGI (polyphemus)
Old methods used processors in 2:1:1:1 ratio. New are 1:1:1:1
So would scale better to more procs.
PLAIN:
Star methods take about same time as old methods, but better load balance
EFFECTIVE AREA, NORMAL_SQ
New methods take same clock time, more total time.
*/
/* local storage max */
#define MAXV 20
REAL star_sqcurve_method_all ARGS((struct qinfo*,int));
static int h0_flag; /* set to use (H - H_0)^2 */
static REAL h0_value; /* value of H_0 */
/***********************************************************************
*
* Function: star_sqcurve_method_init()
*
* Purpose: Initializes data structures for square curvature.
*/
void star_sqcurve_method_init(mode,mi)
int mode; /* METHOD_VALUE or METHOD_GRADIENT */
struct method_instance *mi;
{ int k,n;
struct gen_quant_method *gm;
int eltype;
if ( web.dimension != 2 )
kb_error(1610,"sq_mean_curvature method only for 2D facets.\n",RECOVERABLE);
if ( web.modeltype != LINEAR )
kb_error(1611,"sq_mean_curvature method only for LINEAR model.\n",
RECOVERABLE);
if ( everything_quantities_flag & square_curvature_flag )
GEN_QUANT(sq_mean_curv_quantity_num)->modulus =
globals(square_curvature_param)->value.real;
/* see if using (H - H_0)^2 adjustment */
h0_flag = 0;
h0_attr = find_extra("h_zero",&eltype);
if ( h0_attr >= 0 )
h0_flag = H0_IN_ATTR;
else
{ k = lookup_global("h_zero");
if ( k >= 0 )
{ h0_flag = H0_IN_GLOBAL;
h0_value = globals(k)->value.real;
}
}
if ( star_sq_mean_curvature_mi < 0 )
{ /* see what method indices correspond to what methods */
for ( n=0,gm = basic_gen_methods ; gm->name[0] != ' ' ; gm++,n++ )
{ if ( stricmp(gm->name,"star_sq_mean_curvature") == 0 )
star_sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"star_eff_area_sq_mean_curvature") == 0 )
star_eff_area_sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"star_normal_sq_mean_curvature") == 0 )
star_normal_sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"star_perp_sq_mean_curvature") == 0 )
star_perp_sq_mean_curvature_mi = n;
}
}
if ( mi->gen_method == star_eff_area_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(1612,"star_eff_area_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
if ( mi->gen_method == star_normal_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(1613,"star_normal_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
if ( mi->gen_method == star_perp_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(2810,"star_perp_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
if ( self_similar_flag )
{ int param = lookup_global(SELFSIM_NAME);
kb_error(1614,"Cannot use self-similarity with star_sq_... methods.\n",
RECOVERABLE);
if ( param < 0 ) /* missing, so add */
{ param = add_global(SELFSIM_NAME);
globals(param)->value.real = 1.0; /* default */
globals(param)->flags |= ORDINARY_PARAM | RECALC_PARAMETER | ALWAYS_RECALC;
}
if ( h0_flag == 0 ) { h0_flag = H0_IN_GLOBAL; h0_value = 0.0; }
}
}
/***********************************************************************
*
* function: star_sqcurve_method_all()
*
* purpose: value and gradient calculations using common code.
*
*/
REAL star_sqcurve_method_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
int variety; /* PLAIN_SQ, EFF_SQ, NORMAL_SQ, PERP_SQ */
int pairs;
int i,j,k,ii,kk;
REAL energy=0.0,ff,fn=0.0,nn=0.0,area,g,h=0.0;
REAL dAdv[MAXCOORD], *a, *d, *s1s1, *s1s2, *s2s2;
REAL vnorm[MAXCOORD];
REAL **dAdv1,**dAdv2,***dvnorm1,***dvnorm2,**ds2;
REAL ***ddAdv1dv1,***ddAdv2dv1,***ddAdv1dv2,***ddAdv2dv2;
REAL ***ddss12,***ddss21,***ddss22;
REAL **dfndv1,**dfndv2,**dffdv1,**dffdv2,**dnndv1,**dnndv2;
REAL ***dfdv1,***dfdv2;
REAL *s1,*s2;
REAL **s = v_info->sides[0];
REAL temp[MAXCOORD];
REAL antisymnorm[MAXCOORD][MAXCOORD];
REAL antisymf[MAXCOORD][MAXCOORD];
REAL aa75=0.0,a75=0.0,ffaaa=0.0,ffaa=0.0,an75=0.0,ann75=0.0,fnnna=0.0;
REAL fnna=0.0,fn75=0.0,fnn75=0.0,ffn75=0.0,afnfn=0.0,afffnfn=0.0,fffnfn=0.0;
REAL ffafnfnfn=0.0,afffffnfnfnfn=0.0,fffffnfnfna=0.0,fffffnfnfn=0.0,
fffffnfn=0.0; /* common subexpressions */
REAL aa[MAXV*5];
MAT2D(ds1,12*MAXV,MAXCOORD);
MAT3D(ddss11,16*MAXV,MAXCOORD,MAXCOORD);
REAL vertex_h0;
REAL hh0=0.0; /* curvature adjusted for h-h0 */
int concount; /* number of constraints vertex is on */
int final_edge; /* of pairs; wrap to first for complete star */
MAT2D(proj,MAXCOORD,MAXCOORD);
struct method_instance *mi = METH_INSTANCE(v_info->method);
if ( mi->gen_method
== star_normal_sq_mean_curvature_mi )
variety = NORMAL_SQ;
else if ( mi->gen_method
== star_perp_sq_mean_curvature_mi )
variety = PERP_SQ;
else if ( mi->gen_method
== star_eff_area_sq_mean_curvature_mi )
variety = EFF_SQ;
else variety = PLAIN_SQ;
pairs = (v_info->vcount - 1);
if ( pairs <= 0 ) return 0.0;
if ( v_info->flags & INCOMPLETE_STAR )
{ pairs--;
final_edge = pairs;
}
else
final_edge = 0;
if ( v_info->vcount > MAXV )
{ a = (REAL*)mycalloc(5*pairs,sizeof(REAL));
ds1 = dmatrix(0,12*v_info->vcount,0,SDIM-1);
} else
{ memset((char*)aa,0,sizeof(REAL)*5*pairs);
a = aa;
memset((char*)ds1[0],0,sizeof(REAL)*12*v_info->vcount*MAXCOORD);
}
d = a+pairs; s1s1 = d + pairs; s1s2 = s1s1 + pairs; s2s2 = s1s2 + pairs;
ds2 = ds1 + pairs; dAdv1 = ds2 + pairs; dAdv2 = dAdv1 + pairs;
dfndv1 = dAdv2 + pairs; dfndv2 = dfndv1 + pairs; dffdv1 = dfndv2 + pairs;
dffdv2 = dffdv1 + pairs; dnndv1 = dffdv2 + pairs; dnndv2 = dnndv1 + pairs;
/* basic dot products */
area = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) dAdv[j] = vnorm[j] = 0.0;
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?final_edge:k+1];
s1s1[k] = SDIM_dot(s1,s1);
s1s2[k] = SDIM_dot(s1,s2);
s2s2[k] = SDIM_dot(s2,s2);
d[k] = s1s1[k]*s2s2[k] - s1s2[k]*s1s2[k];
a[k] = 0.5*sqrt(d[k]);
area += a[k];
for ( j = 0 ; j < SDIM ; j++ )
{ ds1[k][j] = 2*(s2s2[k]*s1[j] - s1s2[k]*s2[j]);
ds2[k][j] = 2*(s1s1[k]*s2[j] - s1s2[k]*s1[j]);
dAdv1[k][j] = 0.125/a[k]*ds1[k][j];
dAdv2[k][j] = 0.125/a[k]*ds2[k][j];
dAdv[j] -= dAdv1[k][j] + dAdv2[k][j];
}
if ( variety != PLAIN_SQ )
{ cross_prod(s1,s2,temp);
for ( j = 0 ; j < SDIM ; j++ )
vnorm[j] += 0.5*temp[j];
}
}
/* constraint projection */
concount = constr_proj_matrix_wall(v_info->id,proj);
if ( concount && (v_info->flags & INCOMPLETE_STAR) )
{ /* project force and normal to constraints. This is enough to take
care of energy and gradient, since force and energy occur only in
dot products.
*/
int i;
for ( i = 0 ; i < SDIM ; i++ )
temp[i] = dAdv[i];
matvec_mul(proj,temp,dAdv,SDIM,SDIM);
for ( i = 0 ; i < SDIM ; i++ )
temp[i] = vnorm[i];
matvec_mul(proj,temp,vnorm,SDIM,SDIM);
}
/* energy */
ff = SDIM_dot(dAdv,dAdv);
switch ( variety )
{ case TEST_SQ:
nn = SDIM_dot(vnorm,vnorm);
energy = nn; break;
case PLAIN_SQ:
energy = 0.75/area*ff;
break;
case EFF_SQ:
nn = SDIM_dot(vnorm,vnorm);
if ( nn <= 0.0 ) return 0.0;
energy = 0.75*area*ff/nn;
break;
case NORMAL_SQ:
fn = SDIM_dot(dAdv,vnorm);
if ( fn == 0.0 )
{ ff = 0.0; fn = 1e-6; }
switch ( h0_flag )
{ case H0_IN_GLOBAL: hh0 = ff/fn - 2*h0_value/3; break;
case H0_IN_ATTR: hh0 = ff/fn-2*(*VREAL(v_info->id,h0_attr))/3;
break;
default: hh0 = ff/fn; break;
}
energy = 0.75*area*hh0*hh0;
break;
case PERP_SQ:
fn = SDIM_dot(dAdv,vnorm);
nn = SDIM_dot(vnorm,vnorm);
switch ( h0_flag )
{ case H0_IN_GLOBAL: vertex_h0 = h0_value; break;
case H0_IN_ATTR: vertex_h0 = (*VREAL(v_info->id,h0_attr));
break;
default: vertex_h0 = 0.0; break;
}
if ( nn == 0.0 || (concount == 2 && nn < 0.01*area*area) )
{ /* C2 line, probably, so h = 0 */
fn = 0.0; nn = 1.0;
}
hh0 = (fn/nn - 2*vertex_h0/3);
energy = 0.75*area*hh0*hh0;
break;
}
if ( get_vattr(v_info->id) & AXIAL_POINT )
{ if ( sym_flags & DOUBLE_AXIAL )
energy /= rotorder/2;
else energy /= rotorder;
energy *= rotorder/v_info->axial_order;
}
if ( mode == METHOD_VALUE ) goto all_exit;
/* Gradient */
if ( v_info->vcount > MAXV )
ddss11 = dmatrix3(16*pairs,SDIM,SDIM);
else memset((char*)ddss11[0][0],0,sizeof(REAL)*16*pairs*MAXCOORD*MAXCOORD);
ddss12 = ddss11 + pairs; ddss21 = ddss12 + pairs; ddss22 = ddss21 + pairs;
ddAdv1dv1 = ddss22 + pairs; ddAdv1dv2 = ddAdv1dv1 + pairs;
ddAdv2dv1 = ddAdv1dv2 + pairs; ddAdv2dv2 = ddAdv2dv1 + pairs;
dvnorm1 = ddAdv2dv2 + pairs; dvnorm2 = dvnorm1 + pairs;
dfdv1 = dvnorm2 + pairs; dfdv2 = dfdv1 + pairs;
/* first, some more common terms */
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?final_edge:k+1];
for ( i = 0 ; i < SDIM ; i++ )
{ ddss11[k][i][i] = 2*s2s2[k];
ddss12[k][i][i] = -2*s1s2[k];
ddss21[k][i][i] = -2*s1s2[k];
ddss22[k][i][i] = 2*s1s1[k];
for ( j = 0 ; j < SDIM ; j++ )
{ ddss11[k][i][j] -= 2*s2[i]*s2[j];
ddss12[k][i][j] += 4*s1[i]*s2[j] - 2*s2[i]*s1[j];
ddss21[k][i][j] += 4*s2[i]*s1[j] - 2*s1[i]*s2[j];
ddss22[k][i][j] -= 2*s1[i]*s1[j];
ddAdv1dv1[k][i][j] = -0.125/a[k]/a[k]*dAdv1[k][i]*ds1[k][j]
+ 0.125/a[k]*ddss11[k][i][j];
ddAdv1dv2[k][i][j] = -0.125/a[k]/a[k]*dAdv1[k][i]*ds2[k][j]
+ 0.125/a[k]*ddss12[k][i][j];
dfdv1[k][i][j] = -ddAdv1dv1[k][i][j] - ddAdv1dv2[k][i][j];
ddAdv2dv1[k][i][j] = -0.125/a[k]/a[k]*dAdv2[k][i]*ds1[k][j]
+ 0.125/a[k]*ddss21[k][i][j];
ddAdv2dv2[k][i][j] = -0.125/a[k]/a[k]*dAdv2[k][i]*ds2[k][j]
+ 0.125/a[k]*ddss22[k][i][j];
dfdv2[k][i][j] = -ddAdv2dv1[k][i][j] - ddAdv2dv2[k][i][j];
}
if ( concount )
{ /* project force and normal to constraints. */
for ( j = 0 ; j < SDIM ; j++ )
temp[j] = dfdv1[k][i][j];
matvec_mul(proj,temp,dfdv1[k][i],SDIM,SDIM);
for ( j = 0 ; j < SDIM ; j++ )
temp[j] = dfdv2[k][i][j];
matvec_mul(proj,temp,dfdv2[k][i],SDIM,SDIM);
}
dffdv1[k][i] = 2*SDIM_dot(dfdv1[k][i],dAdv);
dffdv2[k][i] = 2*SDIM_dot(dfdv2[k][i],dAdv);
}
if ( variety == PLAIN_SQ ) continue;
dvnorm1[k][0][1] = -0.5*s2[2];
dvnorm1[k][0][2] = 0.5*s2[1];
dvnorm1[k][1][0] = 0.5*s2[2];
dvnorm1[k][1][2] = -0.5*s2[0];
dvnorm1[k][2][0] = -0.5*s2[1];
dvnorm1[k][2][1] = 0.5*s2[0];
dvnorm2[k][0][1] = 0.5*s1[2];
dvnorm2[k][0][2] = -0.5*s1[1];
dvnorm2[k][1][0] = -0.5*s1[2];
dvnorm2[k][1][2] = 0.5*s1[0];
dvnorm2[k][2][0] = 0.5*s1[1];
dvnorm2[k][2][1] = -0.5*s1[0];
if ( concount )
for ( i = 0 ; i < SDIM ; i++ )
{ /* project force and normal to constraints. */
for ( j = 0 ; j < SDIM ; j++ )
temp[j] = dvnorm1[k][i][j];
matvec_mul(proj,temp,dvnorm1[k][i],SDIM,SDIM);
for ( j = 0 ; j < SDIM ; j++ )
temp[j] = dvnorm2[k][i][j];
matvec_mul(proj,temp,dvnorm2[k][i],SDIM,SDIM);
}
for ( i = 0 ; i < SDIM ; i++ )
{ dfndv1[k][i] = SDIM_dot(dfdv1[k][i],vnorm);
dfndv1[k][i] += SDIM_dot(dAdv,dvnorm1[k][i]);
dfndv2[k][i] = SDIM_dot(dfdv2[k][i],vnorm);
dfndv2[k][i] += SDIM_dot(dAdv,dvnorm2[k][i]);
dnndv1[k][i] = 2*SDIM_dot(vnorm,dvnorm1[k][i]);
dnndv2[k][i] = 2*SDIM_dot(vnorm,dvnorm2[k][i]);
}
}
/* now, the actual gradients */
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
v_info->grad[k][i] = 0.0;
switch ( variety )
{ case TEST_SQ:
for ( k = 0 ; k < pairs ; k++ )
{ REAL *grad2 = (k+1==pairs)?v_info->grad[final_edge+1]:v_info->grad[k+2];
for ( i = 0 ; i < SDIM ; i++ )
{ g = dnndv1[k][i];
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = dnndv2[k][i];
grad2[i] += g;
v_info->grad[0][i] -= g;
}
}
break;
case PLAIN_SQ:
for ( k = 0 ; k < pairs ; k++ )
{ REAL *grad2 = (k+1==pairs)?v_info->grad[final_edge+1]:v_info->grad[k+2];
for ( i = 0 ; i < SDIM ; i++ )
{ g = -0.75*ff/area/area*dAdv1[k][i] + 0.75/area*dffdv1[k][i];
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = -0.75*ff/area/area*dAdv2[k][i] + 0.75/area*dffdv2[k][i];
grad2[i] += g;
v_info->grad[0][i] -= g;
}
}
break;
case EFF_SQ:
for ( k = 0 ; k < pairs ; k++ )
{ REAL *grad2 = (k+1==pairs)?v_info->grad[final_edge+1]:v_info->grad[k+2];
for ( i = 0 ; i < SDIM ; i++ )
{ g = 0.75*ff/nn*dAdv1[k][i]
+ 0.75*area/nn*dffdv1[k][i]
- 0.75*area/nn/nn*ff*dnndv1[k][i];
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = 0.75*ff/nn*dAdv2[k][i]
+ 0.75*area/nn*dffdv2[k][i]
- 0.75*area/nn/nn*ff*dnndv2[k][i];
grad2[i] += g;
v_info->grad[0][i] -= g;
}
}
break;
case NORMAL_SQ:
if ( fn != 0.0 )
for ( k = 0 ; k < pairs ; k++ )
{ REAL *grad2 = (k+1==pairs)?v_info->grad[final_edge+1]:v_info->grad[k+2];
REAL g1,g2,g3;
for ( i = 0 ; i < SDIM ; i++ )
{ g1 = 0.75*hh0*hh0*dAdv1[k][i];
g2 = 1.5*area/fn*hh0*dffdv1[k][i];
g3 = - 1.5*area*ff*hh0/fn/fn*dfndv1[k][i];
g = g1 + g2 + g3;
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g1 = 0.75*hh0*hh0*dAdv2[k][i] ;
g2 = 1.5*area/fn*hh0*dffdv2[k][i];
g3 = - 1.5*area*ff*hh0/fn/fn*dfndv2[k][i];
g = g1 + g2 + g3;
grad2[i] += g;
v_info->grad[0][i] -= g;
}
}
break;
case PERP_SQ:
for ( k = 0 ; k < pairs ; k++ )
{ REAL *grad2 = (k+1==pairs)?v_info->grad[final_edge+1]:v_info->grad[k+2];
for ( i = 0 ; i < SDIM ; i++ )
{ g = 0.75*hh0*hh0*dAdv1[k][i]
+ 1.5*area/nn*hh0*dfndv1[k][i]
- 1.5*area*fn*hh0/nn/nn*dnndv1[k][i];
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = 0.75*hh0*hh0*dAdv2[k][i]
+ 1.5*area/nn*hh0*dfndv2[k][i]
- 1.5*area*fn*hh0/nn/nn*dnndv2[k][i];
grad2[i] += g;
v_info->grad[0][i] -= g;
}
}
break;
}
if ( get_vattr(v_info->id) & AXIAL_POINT )
{ REAL fudge = 1./rotorder;
if ( sym_flags & DOUBLE_AXIAL ) fudge *= 2;
fudge *= rotorder/v_info->axial_order;
for ( i = 0 ; i < v_info->vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
v_info->grad[i][j] *= fudge;
}
if ( mode == METHOD_GRADIENT ) goto all_exit;
/* Hessian */
if ( (variety == EFF_SQ) || (variety==PERP_SQ) || (variety == TEST_SQ) )
{ for ( i = 0 ; i < SDIM ; i++ )
{ antisymnorm[i][(i+1)%SDIM] = vnorm[(i+2)%SDIM]/2;
antisymnorm[(i+1)%SDIM][i] = -vnorm[(i+2)%SDIM]/2;
antisymnorm[i][i] = 0.0;
}
}
if ( (variety == NORMAL_SQ) || (variety==PERP_SQ) || (variety == TEST_SQ) )
{ for ( i = 0 ; i < SDIM ; i++ )
{ antisymf[i][(i+1)%SDIM] = dAdv[(i+2)%SDIM]/2;
antisymf[(i+1)%SDIM][i] = -dAdv[(i+2)%SDIM]/2;
antisymf[i][i] = 0.0;
}
}
if ( h0_flag && (variety != NORMAL_SQ) && (variety != PERP_SQ) )
kb_error(1615,
"Can only use h_zero with star_normal_sq_curve.\n",RECOVERABLE);
switch ( variety )
{ case PLAIN_SQ:
aa75 = 0.75/area/area;
a75 = 0.75/area;
ffaaa = 1.5*ff/area/area/area;
ffaa = 0.75*ff/area/area;
break;
case EFF_SQ:
an75 = 0.75*area/nn;
ann75 = 0.75*area/nn/nn;
fnnna = 1.5*ff/nn/nn/nn*area;
fnna = 0.75*ff/nn/nn*area;
fn75 = 0.75/nn;
fnn75 = 0.75*ff/nn/nn;
ffn75 = 0.75*ff/nn;
break;
case NORMAL_SQ:
afnfn = 1.5*area/fn/fn;
fffnfn = 1.5*hh0/fn;
afffnfn = 1.5*area*hh0/fn;
ffafnfnfn = 1.5*area*(ff/fn + hh0)/fn/fn;
afffffnfnfnfn = 1.5*area*ff*(ff/fn+2*hh0)/fn/fn/fn;
fffffnfnfna = 1.5*ff*hh0/fn/fn*area;
fffffnfnfn = 1.5*ff*hh0/fn/fn;
fffffnfn = 0.75*hh0*hh0;
break;
}
for ( k = 0 ; k < pairs ; k++ )
{ REAL co1 = 0.25/a[k]/a[k]/a[k];
REAL co2 = 0.125/a[k]/a[k];
REAL co3 = 0.125/a[k];
REAL dssf = (SDIM_dot(ds1[k],dAdv)+SDIM_dot(ds2[k],dAdv));
REAL s1f,s2f;
REAL ddssf1[MAXCOORD],ddssf2[MAXCOORD];
for ( i = 0 ; i < SDIM ; i++ )
{ ddssf1[i] =
(SDIM_dot(ddss11[k][i],dAdv)+SDIM_dot(ddss12[k][i],dAdv));
ddssf2[i] =
(SDIM_dot(ddss21[k][i],dAdv)+SDIM_dot(ddss22[k][i],dAdv));
}
s1 = s[k]; s2 = s[(k+1==pairs)?final_edge:k+1];
s1f = SDIM_dot(s1,dAdv);
s2f = SDIM_dot(s2,dAdv);
for ( kk = 0 ; kk < pairs ; kk++ )
{ int nextk = (k+1==pairs) ? final_edge : k+1 ;
int nextkk = (kk+1==pairs) ? final_edge : kk+1 ;
REAL **h11 = v_info->hess[k+1][kk+1];
REAL **h12 = v_info->hess[k+1][nextkk+1];
REAL **h21 = v_info->hess[nextk+1][kk+1];
REAL **h22 = v_info->hess[nextk+1][nextkk+1];
REAL **h00 = v_info->hess[0][0];
REAL **h10 = v_info->hess[k+1][0];
REAL **h02 = v_info->hess[0][nextkk+1];
REAL **h20 = v_info->hess[nextk+1][0];
REAL **h01 = v_info->hess[0][kk+1];
REAL ddff,dddsf,ddnn,ddfn;
for ( i = 0 ; i < SDIM ; i++ )
for ( ii = 0 ; ii < SDIM ; ii++ )
{ /* 11 term */
ddff = SDIM_dot(dfdv1[k][i],dfdv1[kk][ii]);
if ( k == kk )
{
ddff += (-co1*dAdv1[k][i]*dAdv1[k][ii] + co2*ddAdv1dv1[k][i][ii])
*dssf;
ddff += co2*dAdv1[k][i]*ddssf1[ii];
ddff += co2*dAdv1[kk][ii]*ddssf1[i];
dddsf = ((i==ii) ? 4*s2f : 0. )
- 2*s2[i]*dAdv[ii] - 2*s2[ii]*dAdv[i];
ddff -= co3*dddsf;
}
ddff *= 2;
switch ( variety )
{ case TEST_SQ:
h = ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm1[kk][ii]);
break;
case PLAIN_SQ:
h = -aa75*(dffdv1[k][i]*dAdv1[kk][ii]
+ dffdv1[kk][ii]*dAdv1[k][i])
+ ffaaa*dAdv1[k][i]*dAdv1[kk][ii]
+ a75*ddff;
if ( k == kk )
h -= ffaa*ddAdv1dv1[k][i][ii];
break;
case EFF_SQ:
ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm1[kk][ii]);
h = an75*ddff
- ann75*dffdv1[k][i]*dnndv1[kk][ii]
- ann75*dffdv1[kk][ii]*dnndv1[k][i]
+ fnnna*dnndv1[k][i]*dnndv1[kk][ii]
- fnna*ddnn
+ fn75*dffdv1[k][i]*dAdv1[kk][ii]
+ fn75*dffdv1[kk][ii]*dAdv1[k][i]
- fnn75*dAdv1[kk][ii]*dnndv1[k][i]
- fnn75*dnndv1[kk][ii]*dAdv1[k][i];
if ( k == kk )
h += ffn75*ddAdv1dv1[k][i][ii];
break;
case NORMAL_SQ:
ddfn = SDIM_dot(dfdv1[k][i],dvnorm1[kk][ii])
+ SDIM_dot(dvnorm1[k][i],dfdv1[kk][ii]);
if ( k == kk )
{
ddfn += (-co1*dAdv1[k][i]*dAdv1[k][ii]
+ co2*ddAdv1dv1[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv1[k][i]*
(SDIM_dot(ddss11[kk][ii],vnorm)
+SDIM_dot(ddss12[kk][ii],vnorm));
ddfn += co2*dAdv1[kk][ii]*
(SDIM_dot(ddss11[k][i],vnorm)
+SDIM_dot(ddss12[k][i],vnorm));
dddsf = ((i==ii) ? 4*SDIM_dot(s2,vnorm) : 0. )
- 2*s2[i]*vnorm[ii] - 2*s2[ii]*vnorm[i];
ddfn -= co3*dddsf;
}
h = afnfn*dffdv1[k][i]*dffdv1[kk][ii]
+ afffnfn*ddff
+ fffnfn*dffdv1[k][i]*dAdv1[kk][ii]
+ fffnfn*dAdv1[k][i]*dffdv1[kk][ii]
- ffafnfnfn*dffdv1[k][i]*dfndv1[kk][ii]
- ffafnfnfn*dfndv1[k][i]*dffdv1[kk][ii]
+ afffffnfnfnfn*dfndv1[k][i]*dfndv1[kk][ii]
- fffffnfnfna*ddfn
- fffffnfnfn*dfndv1[k][i]*dAdv1[kk][ii]
- fffffnfnfn*dAdv1[k][i]*dfndv1[kk][ii];
if ( k == kk )
h += fffffnfn*ddAdv1dv1[k][i][ii];
break;
case PERP_SQ:
ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm1[kk][ii]);
ddfn = SDIM_dot(dfdv1[k][i],dvnorm1[kk][ii])
+ SDIM_dot(dvnorm1[k][i],dfdv1[kk][ii]);
if ( k == kk )
{
ddfn += (-co1*dAdv1[k][i]*dAdv1[k][ii]
+ co2*ddAdv1dv1[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv1[k][i]*
(SDIM_dot(ddss11[kk][ii],vnorm)
+SDIM_dot(ddss12[kk][ii],vnorm));
ddfn += co2*dAdv1[kk][ii]*
(SDIM_dot(ddss11[k][i],vnorm)
+SDIM_dot(ddss12[k][i],vnorm));
dddsf = ((i==ii) ? 4*SDIM_dot(s2,vnorm) : 0. )
- 2*s2[i]*vnorm[ii] - 2*s2[ii]*vnorm[i];
ddfn -= co3*dddsf;
}
h = 1.5*hh0*dAdv1[k][i]*(dfndv1[kk][ii]/nn-fn/nn/nn*dnndv1[kk][ii])
+ 1.5*hh0*dAdv1[kk][ii]*(dfndv1[k][i]/nn-fn/nn/nn*dnndv1[k][i])
+ 1.5*area*(dfndv1[k][i]/nn-fn/nn/nn*dnndv1[k][i])*
(dfndv1[kk][ii]/nn-fn/nn/nn*dnndv1[kk][ii])
+ 1.5*area*hh0*(ddfn/nn - dfndv1[k][i]*dnndv1[kk][ii]/nn/nn
- dfndv1[kk][ii]*dnndv1[k][i]/nn/nn
+2*fn*dnndv1[k][i]*dnndv1[kk][ii]/nn/nn/nn
- fn*ddnn/nn/nn);
if ( k == kk )
h += 0.75*ddAdv1dv1[k][i][ii]*hh0*hh0;
break;
}
if ( !is_finite(h) )
{ sprintf(errmsg,
"Star sq curvature hessian infinite at vertex %s\n",
ELNAME(v_info->id));
kb_error(3617,errmsg,RECOVERABLE);
}
h11[i][ii] += h;
h01[i][ii] -= h;
h10[i][ii] -= h;
h00[i][ii] += h;
/* 12 term */
ddff = SDIM_dot(dfdv1[k][i],dfdv2[kk][ii]);
if ( k == kk )
{ ddff += (-co1*dAdv1[k][i]*dAdv2[k][ii] + co2*ddAdv1dv2[k][i][ii])
*dssf;
ddff += co2*dAdv1[k][i]*ddssf2[ii];
ddff += co2*dAdv2[kk][ii]*ddssf1[i];
dddsf = 4*dAdv[i]*s2[ii] -2*dAdv[ii]*s2[i]
- 2*((i==ii) ? s2f : 0.0)
+ 4*dAdv[ii]*s1[i] - 2*dAdv[i]*s1[ii]
- 2*((i==ii) ? s1f : 0.0);
ddff -= co3*dddsf;
}
ddff *= 2;
switch ( variety )
{ case TEST_SQ:
ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm2[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[i][ii];
h = ddnn;
break;
case PLAIN_SQ:
h = -aa75*dffdv1[k][i]*dAdv2[kk][ii]
- aa75*dffdv2[kk][ii]*dAdv1[k][i]
+ ffaaa*dAdv1[k][i]*dAdv2[kk][ii]
+ a75*ddff;
if ( k == kk )
h -= ffaa*ddAdv1dv2[k][i][ii];
break;
case EFF_SQ:
ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm2[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[i][ii];
h = an75*ddff
- ann75*dffdv1[k][i]*dnndv2[kk][ii]
- ann75*dffdv2[kk][ii]*dnndv1[k][i]
+ fnnna*dnndv1[k][i]*dnndv2[kk][ii]
- fnna*ddnn
+ fn75*dffdv1[k][i]*dAdv2[kk][ii]
+ fn75*dffdv2[kk][ii]*dAdv1[k][i]
- fnn75*dAdv2[kk][ii]*dnndv1[k][i]
- fnn75*dnndv2[kk][ii]*dAdv1[k][i];
if ( k == kk )
h += ffn75*ddAdv1dv2[k][i][ii];
break;
case NORMAL_SQ:
ddfn = SDIM_dot(dfdv1[k][i],dvnorm2[kk][ii])
+ SDIM_dot(dvnorm1[k][i],dfdv2[kk][ii]);
if ( k == kk ) ddfn += antisymf[i][ii];
if ( k == kk )
{
ddfn += (-co1*dAdv1[k][i]*dAdv2[k][ii]
+ co2*ddAdv1dv2[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv1[k][i]*
(SDIM_dot(ddss21[kk][ii],vnorm)
+SDIM_dot(ddss22[kk][ii],vnorm));
ddfn += co2*dAdv2[kk][ii]*
(SDIM_dot(ddss11[k][i],vnorm)
+SDIM_dot(ddss12[k][i],vnorm));
dddsf = 4*vnorm[i]*s2[ii] -2*vnorm[ii]*s2[i]
- 2*((i==ii) ? SDIM_dot(s2,vnorm) : 0.0)
+ 4*vnorm[ii]*s1[i] - 2*vnorm[i]*s1[ii]
- 2*((i==ii) ? SDIM_dot(s1,vnorm) : 0.0);
ddfn -= co3*dddsf;
}
h = afnfn*dffdv1[k][i]*dffdv2[kk][ii]
+ afffnfn*ddff
- ffafnfnfn*dffdv1[k][i]*dfndv2[kk][ii]
+ fffnfn*dffdv1[k][i]*dAdv2[kk][ii]
+ fffnfn*dAdv1[k][i]*dffdv2[kk][ii]
- ffafnfnfn*dfndv1[k][i]*dffdv2[kk][ii]
+ afffffnfnfnfn*dfndv1[k][i]*dfndv2[kk][ii]
- fffffnfnfna*ddfn
- fffffnfnfn*dfndv1[k][i]*dAdv2[kk][ii]
- fffffnfnfn*dAdv1[k][i]*dfndv2[kk][ii];
if ( k == kk )
h += fffffnfn*ddAdv1dv2[k][i][ii];
break;
case PERP_SQ:
ddnn = 2*SDIM_dot(dvnorm1[k][i],dvnorm2[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[i][ii];
ddfn = SDIM_dot(dfdv1[k][i],dvnorm2[kk][ii])
+ SDIM_dot(dvnorm1[k][i],dfdv2[kk][ii]);
if ( k == kk ) ddfn += antisymf[i][ii];
if ( k == kk )
{
ddfn += (-co1*dAdv1[k][i]*dAdv2[k][ii]
+ co2*ddAdv1dv2[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv1[k][i]*
(SDIM_dot(ddss21[kk][ii],vnorm)
+SDIM_dot(ddss22[kk][ii],vnorm));
ddfn += co2*dAdv2[kk][ii]*
(SDIM_dot(ddss11[k][i],vnorm)
+SDIM_dot(ddss12[k][i],vnorm));
dddsf = 4*vnorm[i]*s2[ii] -2*vnorm[ii]*s2[i]
- 2*((i==ii) ? SDIM_dot(s2,vnorm) : 0.0)
+ 4*vnorm[ii]*s1[i] - 2*vnorm[i]*s1[ii]
- 2*((i==ii) ? SDIM_dot(s1,vnorm) : 0.0);
ddfn -= co3*dddsf;
}
h = 1.5*hh0*dAdv1[k][i]*(dfndv2[kk][ii]/nn-fn/nn/nn*dnndv2[kk][ii])
+ 1.5*hh0*dAdv2[kk][ii]*(dfndv1[k][i]/nn-fn/nn/nn*dnndv1[k][i])
+ 1.5*area*(dfndv1[k][i]/nn-fn/nn/nn*dnndv1[k][i])*
(dfndv2[kk][ii]/nn-fn/nn/nn*dnndv2[kk][ii])
+ 1.5*area*hh0*(ddfn/nn - dfndv1[k][i]*dnndv2[kk][ii]/nn/nn
- dfndv2[kk][ii]*dnndv1[k][i]/nn/nn
+2*fn*dnndv1[k][i]*dnndv2[kk][ii]/nn/nn/nn
- fn*ddnn/nn/nn);
if ( k == kk )
h += 0.75*ddAdv1dv2[k][i][ii]*hh0*hh0;
break;
}
if ( !is_finite(h) )
{ sprintf(errmsg,
"Star sq curvature hessian infinite at vertex %s\n",
ELNAME(v_info->id));
kb_error(3618,errmsg,RECOVERABLE);
}
h12[i][ii] += h;
h02[i][ii] -= h;
h10[i][ii] -= h;
h00[i][ii] += h;
/* 21 term */
ddff = SDIM_dot(dfdv2[k][i],dfdv1[kk][ii]);
if ( k == kk )
{ ddff += (-co1*dAdv2[k][i]*dAdv1[k][ii] + co2*ddAdv2dv1[k][i][ii])
*dssf;
ddff += co2*dAdv2[k][i]*ddssf1[ii];
ddff += co2*dAdv1[kk][ii]*ddssf2[i];
dddsf = 4*dAdv[i]*s1[ii] -2*dAdv[ii]*s1[i]
- 2*((i==ii) ? s1f: 0.0)
+ 4*dAdv[ii]*s2[i] - 2*dAdv[i]*s2[ii]
- 2*((i==ii) ? s2f : 0.0);
ddff -= co3*dddsf;
}
ddff *= 2;
switch ( variety )
{ case TEST_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm1[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[ii][i];
h = ddnn;
break;
case PLAIN_SQ:
h = -aa75*dffdv2[k][i]*dAdv1[kk][ii]
- aa75*dffdv1[kk][ii]*dAdv2[k][i]
+ ffaaa*dAdv2[k][i]*dAdv1[kk][ii]
+ a75*ddff;
if ( k == kk )
h -= ffaa*ddAdv2dv1[k][i][ii];
break;
case EFF_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm1[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[ii][i];
h = an75*ddff
- ann75*dffdv2[k][i]*dnndv1[kk][ii]
- ann75*dffdv1[kk][ii]*dnndv2[k][i]
+ fnnna*dnndv2[k][i]*dnndv1[kk][ii]
- fnna*ddnn
+ fn75*dffdv2[k][i]*dAdv1[kk][ii]
+ fn75*dffdv1[kk][ii]*dAdv2[k][i]
- fnn75*dAdv1[kk][ii]*dnndv2[k][i]
- fnn75*dnndv1[kk][ii]*dAdv2[k][i];
if ( k == kk )
h += ffn75*ddAdv2dv1[k][i][ii];
break;
case NORMAL_SQ:
ddfn = SDIM_dot(dfdv2[k][i],dvnorm1[kk][ii])
+ SDIM_dot(dvnorm2[k][i],dfdv1[kk][ii]);
if ( k == kk ) ddfn += antisymf[ii][i];
if ( k == kk )
{
ddfn += (-co1*dAdv2[k][i]*dAdv1[k][ii]
+ co2*ddAdv2dv1[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv2[k][i]*
(SDIM_dot(ddss11[kk][ii],vnorm)
+SDIM_dot(ddss12[kk][ii],vnorm));
ddfn += co2*dAdv1[kk][ii]*
(SDIM_dot(ddss21[k][i],vnorm)
+SDIM_dot(ddss22[k][i],vnorm));
dddsf = 4*vnorm[i]*s1[ii] -2*vnorm[ii]*s1[i]
- 2*((i==ii) ? SDIM_dot(s1,vnorm) : 0.0)
+ 4*vnorm[ii]*s2[i] - 2*vnorm[i]*s2[ii]
- 2*((i==ii) ? SDIM_dot(s2,vnorm) : 0.0);
ddfn -= co3*dddsf;
}
h = afnfn*dffdv2[k][i]*dffdv1[kk][ii]
+ afffnfn*ddff
- ffafnfnfn*dffdv2[k][i]*dfndv1[kk][ii]
+ fffnfn*dffdv2[k][i]*dAdv1[kk][ii]
- ffafnfnfn*dfndv2[k][i]*dffdv1[kk][ii]
+ afffffnfnfnfn*dfndv2[k][i]*dfndv1[kk][ii]
- fffffnfnfna*ddfn
- fffffnfnfn*dfndv2[k][i]*dAdv1[kk][ii]
+ fffnfn*dAdv2[k][i]*dffdv1[kk][ii]
- fffffnfnfn*dAdv2[k][i]*dfndv1[kk][ii];
if ( k == kk )
h += fffffnfn*ddAdv2dv1[k][i][ii];
break;
case PERP_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm1[kk][ii]);
if ( k == kk ) ddnn += 2*antisymnorm[ii][i];
ddfn = SDIM_dot(dfdv2[k][i],dvnorm1[kk][ii])
+ SDIM_dot(dvnorm2[k][i],dfdv1[kk][ii]);
if ( k == kk ) ddfn += antisymf[ii][i];
if ( k == kk )
{
ddfn += (-co1*dAdv2[k][i]*dAdv1[k][ii]
+ co2*ddAdv2dv1[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv2[k][i]*
(SDIM_dot(ddss11[kk][ii],vnorm)
+SDIM_dot(ddss12[kk][ii],vnorm));
ddfn += co2*dAdv1[kk][ii]*
(SDIM_dot(ddss21[k][i],vnorm)
+SDIM_dot(ddss22[k][i],vnorm));
dddsf = 4*vnorm[i]*s1[ii] -2*vnorm[ii]*s1[i]
- 2*((i==ii) ? SDIM_dot(s1,vnorm) : 0.0)
+ 4*vnorm[ii]*s2[i] - 2*vnorm[i]*s2[ii]
- 2*((i==ii) ? SDIM_dot(s2,vnorm) : 0.0);
ddfn -= co3*dddsf;
}
h = 1.5*hh0*dAdv2[k][i]*(dfndv1[kk][ii]/nn-fn/nn/nn*dnndv1[kk][ii])
+ 1.5*hh0*dAdv1[kk][ii]*(dfndv2[k][i]/nn-fn/nn/nn*dnndv2[k][i])
+ 1.5*area*(dfndv2[k][i]/nn-fn/nn/nn*dnndv2[k][i])*
(dfndv1[kk][ii]/nn-fn/nn/nn*dnndv1[kk][ii])
+ 1.5*area*hh0*(ddfn/nn - dfndv2[k][i]*dnndv1[kk][ii]/nn/nn
- dfndv1[kk][ii]*dnndv2[k][i]/nn/nn
+2*fn*dnndv2[k][i]*dnndv1[kk][ii]/nn/nn/nn
- fn*ddnn/nn/nn);
if ( k == kk )
h += 0.75*ddAdv2dv1[k][i][ii]*hh0*hh0;
break;
}
if ( !is_finite(h) )
{ sprintf(errmsg,
"Star sq curvature hessian infinite at vertex %s\n",
ELNAME(v_info->id));
kb_error(3619,errmsg,RECOVERABLE);
}
h21[i][ii] += h;
h01[i][ii] -= h;
h20[i][ii] -= h;
h00[i][ii] += h;
/* 22 term */
ddff = SDIM_dot(dfdv2[k][i],dfdv2[kk][ii]);
if ( k == kk )
{ ddff += (-co1*dAdv2[k][i]*dAdv2[k][ii] + co2*ddAdv2dv2[k][i][ii])
*dssf;
ddff += co2*dAdv2[k][i]*ddssf2[ii];
ddff += co2*dAdv2[kk][ii]*ddssf2[i];
dddsf = ((i==ii) ? 4*s1f : 0. )
- 2*s1[i]*dAdv[ii] - 2*s1[ii]*dAdv[i];
ddff -= co3*dddsf;
}
ddff *= 2;
switch ( variety )
{ case TEST_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm2[kk][ii]);
h = ddnn;
break;
case PLAIN_SQ:
h = -aa75*dffdv2[k][i]*dAdv2[kk][ii]
- aa75*dffdv2[kk][ii]*dAdv2[k][i]
+ ffaaa*dAdv2[k][i]*dAdv2[kk][ii]
+ a75*ddff;
if ( k == kk )
h -= ffaa*ddAdv2dv2[k][i][ii];
break;
case EFF_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm2[kk][ii]);
h = an75*ddff
- ann75*dffdv2[k][i]*dnndv2[kk][ii]
- ann75*dffdv2[kk][ii]*dnndv2[k][i]
+ fnnna*dnndv2[k][i]*dnndv2[kk][ii]
- fnna*ddnn
+ fn75*dffdv2[k][i]*dAdv2[kk][ii]
+ fn75*dffdv2[kk][ii]*dAdv2[k][i]
- fnn75*dAdv2[kk][ii]*dnndv2[k][i]
- fnn75*dnndv2[kk][ii]*dAdv2[k][i];
if ( k == kk )
h += ffn75*ddAdv2dv2[k][i][ii];
break;
case NORMAL_SQ:
ddfn = SDIM_dot(dfdv2[k][i],dvnorm2[kk][ii])
+ SDIM_dot(dvnorm2[k][i],dfdv2[kk][ii]);
if ( k == kk )
{
ddfn += (-co1*dAdv2[k][i]*dAdv2[k][ii]
+ co2*ddAdv2dv2[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv2[k][i]*
(SDIM_dot(ddss21[kk][ii],vnorm)
+SDIM_dot(ddss22[kk][ii],vnorm));
ddfn += co2*dAdv2[kk][ii]*
(SDIM_dot(ddss21[k][i],vnorm)
+SDIM_dot(ddss22[k][i],vnorm));
dddsf = ((i==ii) ? 4*SDIM_dot(s1,vnorm) : 0. )
- 2*s1[i]*vnorm[ii] - 2*s1[ii]*vnorm[i];
ddfn -= co3*dddsf;
}
h = afnfn*dffdv2[k][i]*dffdv2[kk][ii]
+ afffnfn*ddff
- ffafnfnfn*dffdv2[k][i]*dfndv2[kk][ii]
+ fffnfn*dffdv2[k][i]*dAdv2[kk][ii]
- ffafnfnfn*dfndv2[k][i]*dffdv2[kk][ii]
+ afffffnfnfnfn*dfndv2[k][i]*dfndv2[kk][ii]
- fffffnfnfna*ddfn
- fffffnfnfn*dfndv2[k][i]*dAdv2[kk][ii]
+ fffnfn*dAdv2[k][i]*dffdv2[kk][ii]
- fffffnfnfn*dAdv2[k][i]*dfndv2[kk][ii];
if ( k == kk )
h += fffffnfn*ddAdv2dv2[k][i][ii];
break;
case PERP_SQ:
ddnn = 2*SDIM_dot(dvnorm2[k][i],dvnorm2[kk][ii]);
ddfn = SDIM_dot(dfdv2[k][i],dvnorm2[kk][ii])
+ SDIM_dot(dvnorm2[k][i],dfdv2[kk][ii]);
if ( k == kk )
{
ddfn += (-co1*dAdv2[k][i]*dAdv2[k][ii]
+ co2*ddAdv2dv2[k][i][ii])
*(SDIM_dot(ds1[k],vnorm)+SDIM_dot(ds2[k],vnorm));
ddfn += co2*dAdv2[k][i]*
(SDIM_dot(ddss21[kk][ii],vnorm)
+SDIM_dot(ddss22[kk][ii],vnorm));
ddfn += co2*dAdv2[kk][ii]*
(SDIM_dot(ddss21[k][i],vnorm)
+SDIM_dot(ddss22[k][i],vnorm));
dddsf = ((i==ii) ? 4*SDIM_dot(s1,vnorm) : 0. )
- 2*s1[i]*vnorm[ii] - 2*s1[ii]*vnorm[i];
ddfn -= co3*dddsf;
}
h = 1.5*hh0*dAdv2[k][i]*(dfndv2[kk][ii]/nn-fn/nn/nn*dnndv2[kk][ii])
+ 1.5*hh0*dAdv2[kk][ii]*(dfndv2[k][i]/nn-fn/nn/nn*dnndv2[k][i])
+ 1.5*area*(dfndv2[k][i]/nn-fn/nn/nn*dnndv2[k][i])*
(dfndv2[kk][ii]/nn-fn/nn/nn*dnndv2[kk][ii])
+ 1.5*area*hh0*(ddfn/nn - dfndv2[k][i]*dnndv2[kk][ii]/nn/nn
- dfndv2[kk][ii]*dnndv2[k][i]/nn/nn
+2*fn*dnndv2[k][i]*dnndv2[kk][ii]/nn/nn/nn
- fn*ddnn/nn/nn);
if ( k == kk )
h += 0.75*ddAdv2dv2[k][i][ii]*hh0*hh0;
break;
}
if ( !is_finite(h) )
{ sprintf(errmsg,
"Star sq curvature hessian infinite at vertex %s\n",
ELNAME(v_info->id));
kb_error(3620,errmsg,RECOVERABLE);
}
h22[i][ii] += h;
h02[i][ii] -= h;
h20[i][ii] -= h;
h00[i][ii] += h;
} /* end for i, ii */
} /* end for kk */
} /* end for k */
if ( get_vattr(v_info->id) & AXIAL_POINT )
{ REAL fudge = 1./rotorder;
if ( sym_flags & DOUBLE_AXIAL ) fudge *= 2;
fudge *= rotorder/v_info->axial_order;
for ( i = 0 ; i < v_info->vcount ; i++ )
for ( ii = 0 ; ii < v_info->vcount ; ii++ )
for ( k = 0 ; k < SDIM ; k++ )
for ( kk = 0 ; kk < SDIM ; kk++ )
v_info->hess[i][ii][k][kk] *= fudge;
}
all_exit:
if ( v_info->vcount > MAXV )
{ myfree((char*)a);
free_matrix(ds1);
if ( mode != METHOD_VALUE ) free_matrix3(ddss11);
}
return energy;
} /* end star_sq_curve_method_all() */
/*************************************************************************
*
* function: star_sqcurve_method_value()
*
* purpose: calculate squared mean curvature of given vertex
* from precalculated data.
*
*/
REAL star_sqcurve_method_value(v_info)
struct qinfo *v_info;
{
#define USE_ALL
#ifdef USE_ALL
return star_sqcurve_method_all(v_info,METHOD_VALUE);
#else
/* following is streamlined for just energy */
int variety; /* PLAIN_SQ, EFF_SQ, NORMAL_SQ */
int pairs;
int j,k;
REAL energy,ff,fn,nn,area;
REAL dAdv[MAXCOORD], a, d, s1s1, s1s2, s2s2;
REAL vnorm[MAXCOORD];
REAL ds1,ds2,coeff;
REAL *s1,*s2;
REAL **s = v_info->sides[0];
REAL temp[MAXCOORD];
MAT2D(proj,MAXCOORD,MAXCOORD); /* for constraint projection */
int concount; /* number of constraints vertex is on */
int final_edge; /* of pairs; wrap to first for complete star */
if ( METH_INSTANCE(v_info->method)->gen_method
== star_normal_sq_mean_curvature_mi )
variety = NORMAL_SQ;
else
{ if ( h0_flag )
kb_error(1617,"Can only use star_normal_sq_mean_curvature with h_zero.\n",
RECOVERABLE);
if ( METH_INSTANCE(v_info->method)->gen_method
== star_eff_area_sq_mean_curvature_mi )
variety = EFF_SQ;
else variety = PLAIN_SQ;
}
pairs = (v_info->vcount - 1);
if ( pairs <= 0 ) return 0.0;
if ( v_info->flags & INCOMPLETE_STAR )
{ pairs--;
final_edge = pairs;
}
else
final_edge = 0;
/* constraint projection */
concount = constr_proj_matrix(v_info->id,proj);
/* basic dot products */
area = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) dAdv[j] = vnorm[j] = 0.0;
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?final_edge:k+1];
s1s1 = SDIM_dot(s1,s1);
s1s2 = SDIM_dot(s1,s2);
s2s2 = SDIM_dot(s2,s2);
d = s1s1*s2s2 - s1s2*s1s2;
a = sqrt(d);
area += a;
coeff = 0.5/a;
for ( j = 0 ; j < SDIM ; j++ )
{ ds1 = (s2s2*s1[j] - s1s2*s2[j]);
ds2 = (s1s1*s2[j] - s1s2*s1[j]);
dAdv[j] -= coeff*(ds1 + ds2);
}
if ( variety != PLAIN_SQ )
{ cross_prod(s1,s2,temp);
for ( j = 0 ; j < SDIM ; j++ )
vnorm[j] += 0.5*temp[j];
}
}
area *= 0.5;
if ( concount )
{ /* project force and normal to constraints. This is enough to take
care of energy and gradient, since force and energy occur only in
dot products.
*/
int i;
for ( i = 0 ; i < SDIM ; i++ )
temp[i] = dAdv[i];
matvec_mul(proj,temp,dAdv,SDIM,SDIM);
for ( i = 0 ; i < SDIM ; i++ )
temp[i] = vnorm[i];
matvec_mul(proj,temp,vnorm,SDIM,SDIM);
}
/* energy */
ff = SDIM_dot(dAdv,dAdv);
switch ( variety )
{ case PLAIN_SQ:
energy = 0.75/area*ff;
break;
case EFF_SQ:
nn = SDIM_dot(vnorm,vnorm);
energy = 0.75*area*ff/nn;
break;
case NORMAL_SQ:
{ REAL h0_val;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h0_val = h0_value; break;
case H0_IN_ATTR: h0_val = *VREAL(v_info->id,h0_attr); break;
default: h0_val = 0;
}
fn = SDIM_dot(dAdv,vnorm);
if ( fn == 0.0 ) energy = 0.0;
else energy = 0.75*area*(ff/fn-2*h0_val/3)*(ff/fn-2*h0_val/3);
break;
}
}
if ( get_vattr(v_info->id) & AXIAL_POINT )
{ energy /= rotorder;
if ( sym_flags & DOUBLE_AXIAL ) energy *= 2;
energy *= rotorder/v_info->axial_order;
}
return energy;
#endif
}
/*************************************************************************
*
* function: star_sqcurve_method_grad()
*
* purpose: Convert square curvature data into forces for a vertex.
*
*/
REAL star_sqcurve_method_grad(v_info)
struct qinfo *v_info;
{
#ifdef USE_ALL
return star_sqcurve_method_all(v_info,METHOD_GRADIENT);
#else
/* version optimized for gradient */
int variety; /* PLAIN_SQ, EFF_SQ, NORMAL_SQ */
int pairs;
int i,j,k;
REAL energy,ff,fn,nn,area,g;
REAL dAdv[MAXCOORD], *a=NULL, *d, *s1s1, *s1s2, *s2s2;
REAL vnorm[MAXCOORD];
REAL **dAdv1,**dAdv2,dvnorm1[MAXCOORD][MAXCOORD]
,dvnorm2[MAXCOORD][MAXCOORD],**ds2;
REAL *s1,*s2;
REAL **s = v_info->sides[0];
REAL temp[MAXCOORD],ea,a15,ef1,ef2,ns1,ns2;
REAL aa[MAXV*5];
MAT2D(ds1,12*MAXV,MAXCOORD);
REAL h0adj;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h0adj = 2./3*h0_value; break;
case H0_IN_ATTR: h0adj = 2./3*(*VREAL(v_info->id,h0_attr)); break;
default: h0adj = 0.0; break;
}
for ( i = 0 ; i < SDIM ; i++ )
dvnorm1[i][i] = dvnorm2[i][i] = 0.0;
if ( METH_INSTANCE(v_info->method)->gen_method
== star_normal_sq_mean_curvature_mi )
variety = NORMAL_SQ;
else if ( METH_INSTANCE(v_info->method)->gen_method
== star_eff_area_sq_mean_curvature_mi )
variety = EFF_SQ;
else variety = PLAIN_SQ;
pairs = (v_info->vcount - 1);
if ( pairs <= 0 ) return 0.0;
if ( v_info->vcount > MAXV )
{ a = (REAL*)mycalloc(5*pairs,sizeof(REAL));
ds1 = dmatrix(0,12*v_info->vcount,0,SDIM-1);
} else
{ memset((char*)aa,0,sizeof(REAL)*5*pairs);
a = aa;
memset((char*)ds1[0],0,sizeof(REAL)*12*v_info->vcount*MAXCOORD);
}
d = a+pairs; s1s1 = d + pairs; s1s2 = s1s1 + pairs; s2s2 = s1s2 + pairs;
ds2 = ds1 + pairs; dAdv1 = ds2 + pairs; dAdv2 = dAdv1 + pairs;
/* basic dot products */
area = 0.0;
for ( j = 0 ; j < SDIM ; j++ ) dAdv[j] = vnorm[j] = 0.0;
for ( k = 0 ; k < pairs ; k++ )
{ s1 = s[k]; s2 = s[(k+1==pairs)?0:k+1];
s1s1[k] = SDIM_dot(s1,s1);
s1s2[k] = SDIM_dot(s1,s2);
s2s2[k] = SDIM_dot(s2,s2);
d[k] = s1s1[k]*s2s2[k] - s1s2[k]*s1s2[k];
a[k] = 0.5*sqrt(d[k]);
area += a[k];
for ( j = 0 ; j < SDIM ; j++ )
{ ds1[k][j] = 2*(s2s2[k]*s1[j] - s1s2[k]*s2[j]);
ds2[k][j] = 2*(s1s1[k]*s2[j] - s1s2[k]*s1[j]);
dAdv1[k][j] = 0.125/a[k]*ds1[k][j];
dAdv2[k][j] = 0.125/a[k]*ds2[k][j];
dAdv[j] -= dAdv1[k][j] + dAdv2[k][j];
}
if ( variety != PLAIN_SQ )
{ cross_prod(s1,s2,temp);
for ( j = 0 ; j < SDIM ; j++ )
vnorm[j] += 0.5*temp[j];
}
}
/* energy */
ff = SDIM_dot(dAdv,dAdv);
switch ( variety )
{ case PLAIN_SQ:
energy = 0.75/area*ff;
a15 = 1.5/area; /* coefficient for later */
break;
case EFF_SQ:
nn = SDIM_dot(vnorm,vnorm);
energy = 0.75*area*ff/nn;
ef1 = 1.5*area/nn; /* coefficients for later */
ef2 = 1.5*area/nn/nn*ff;
break;
case NORMAL_SQ:
fn = SDIM_dot(dAdv,vnorm);
if ( fn == 0.0 ) energy = 0.0;
else
{ energy = 0.75*area*(ff/fn-h0adj)*(ff/fn-h0adj);
ns1 = 3*area/fn*(ff/fn-h0adj); /* coefficients for later */
ns2 = 1.5*area*(ff/fn-h0adj)*ff/fn/fn;
}
break;
}
/* gradient */
ea = energy/area;
for ( k = 0 ; k < pairs ; k++ )
{ REAL co = 0.25/a[k];
REAL coco = 0.5*co/a[k];
REAL *grad2 = (k+1==pairs)?v_info->grad[1]:v_info->grad[k+2];
s1 = s[k]; s2 = s[(k+1==pairs)?0:k+1];
if ( variety != PLAIN_SQ )
{ dvnorm1[0][1] = -0.5*s2[2];
dvnorm1[0][2] = 0.5*s2[1];
dvnorm1[1][0] = 0.5*s2[2];
dvnorm1[1][2] = -0.5*s2[0];
dvnorm1[2][0] = -0.5*s2[1];
dvnorm1[2][1] = 0.5*s2[0];
dvnorm2[0][1] = 0.5*s1[2];
dvnorm2[0][2] = -0.5*s1[1];
dvnorm2[1][0] = -0.5*s1[2];
dvnorm2[1][2] = 0.5*s1[0];
dvnorm2[2][0] = 0.5*s1[1];
dvnorm2[2][1] = -0.5*s1[0];
}
for ( i = 0 ; i < SDIM ; i++ )
{ REAL coeff1 = coco*dAdv1[k][i];
REAL coeff2 = coco*dAdv2[k][i];
REAL dAdn1,dAdn2;
REAL ddAdv1dv,ddAdv2dv;
dAdn1 = dAdn2 = ddAdv1dv = ddAdv2dv = 0.0;
for ( j = 0 ; j < SDIM ; j++ )
{
REAL ddss11,ddss12,ddss21,ddss22;
REAL t1,t2;
ddss11 = -s2[i]*s2[j];
ddss12 = 2*s1[i]*s2[j] - s2[i]*s1[j];
ddss21 = 2*s2[i]*s1[j] - s1[i]*s2[j];
ddss22 = -s1[i]*s1[j];
if ( i == j )
{ ddss11 += s2s2[k];
ddss12 -= s1s2[k];
ddss21 -= s1s2[k];
ddss22 += s1s1[k];
}
t1 = (coeff1*(ds1[k][j]+ds2[k][j]) - co*(ddss11 + ddss12));
ddAdv1dv += dAdv[j]*t1;
t2 = (coeff2*(ds1[k][j]+ds2[k][j]) - co*(ddss21 + ddss22));
ddAdv2dv += dAdv[j]*t2;
if ( variety == NORMAL_SQ )
{ dAdn1 += vnorm[j]*t1; dAdn2 += vnorm[j]*t2; }
}
switch ( variety )
{ case PLAIN_SQ:
g = a15*ddAdv1dv - ea*dAdv1[k][i] ;
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = a15*ddAdv2dv - ea*dAdv2[k][i];
grad2[i] += g;
v_info->grad[0][i] -= g;
break;
case EFF_SQ:
g = ea*dAdv1[k][i] + ef1*ddAdv1dv
- ef2*SDIM_dot(dvnorm1[i],vnorm);
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = ea*dAdv2[k][i] + ef1*ddAdv2dv
- ef2*SDIM_dot(dvnorm2[i],vnorm);
grad2[i] += g;
v_info->grad[0][i] -= g;
break;
case NORMAL_SQ:
if ( fn != 0.0 )
{ g = ea*dAdv1[k][i] + ns1*ddAdv1dv
- ns2*(dAdn1 + SDIM_dot(dvnorm1[i],dAdv));
v_info->grad[k+1][i] += g;
v_info->grad[0][i] -= g;
g = ea*dAdv2[k][i] + ns1*ddAdv2dv
- ns2*(dAdn2 + SDIM_dot(dvnorm2[i],dAdv));
grad2[i] += g;
v_info->grad[0][i] -= g;
}
break;
}
}
}
if ( get_vattr(v_info->id) & AXIAL_POINT )
{ REAL fudge = 1./rotorder;
if ( sym_flags & DOUBLE_AXIAL ) fudge *= 2;
fudge *= rotorder/v_info->axial_order;
energy *= fudge;
for ( i = 0 ; i < v_info->vcount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
v_info->grad[i][j] *= fudge;
}
if ( v_info->vcount > MAXV )
{ myfree((char*)a);
free_matrix(ds1);
}
return energy;
#endif
}
/*************************************************************************
*
* function: star_sqcurve_method_hess()
*
*
*/
REAL star_sqcurve_method_hess(v_info)
struct qinfo *v_info;
{
return star_sqcurve_method_all(v_info,METHOD_HESSIAN);
}
/*************************************************************************
**************************************************************************
Method circle_willmore
Alexander Bobenko's circle-based discrete Willmore energy.
Is conformally invariant.
At each vertex, energy is the sum of the angles between facet
circumcircles - 2*pi. More simply done as edge quantity, since
angles at each end are the same.
For edge e, if adjacent facet edge loops are a e d and b c -e, then
circle angle beta for edge has
cos(beta) = (--)/|a|/|b|/|c|/|d|
For now, assumes all vertices are faceted, and fully starred.
Severe numerical difficulties: Not smooth when angle beta is zero,
which is all too common. Set of zero angles should be codimension 2,
which means generally avoided, but still crops up.
**************************************************************************/
void circle_willmore_init(mode,mi)
int mode; /* METHOD_VALUE or METHOD_GRADIENT */
struct method_instance *mi;
{ REAL vertex_adjust;
if ( web.modeltype != LINEAR )
kb_error(4007,"circle_willmore method requires the LINEAR model.\n",
RECOVERABLE);
if ( web.representation != SOAPFILM )
kb_error(3222,"circle_willmore method requires the SOAPFILM model.\n",
RECOVERABLE);
vertex_adjust = -M_PI*web.skel[VERTEX].count;
binary_tree_add(mi->value_addends,vertex_adjust);
}
REAL circle_willmore_all(e_info,mode)
struct qinfo *e_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{ REAL *q = e_info->sides[0][0];
REAL *p = e_info->sides[0][1];
REAL *r = e_info->sides[0][2];
REAL pp = dot(p,p,SDIM);
REAL qq = dot(q,q,SDIM);
REAL rr = dot(r,r,SDIM);
REAL pq = dot(p,q,SDIM);
REAL pr = dot(p,r,SDIM);
REAL qr = dot(q,r,SDIM);
REAL value;
REAL cosbeta;
REAL dcdp[MAXCOORD],dcdq[MAXCOORD],dcdr[MAXCOORD];
REAL coeff;
int i;
cosbeta = (rr*pq - qq*pr - pp*rr + pp*qr)/sqrt(pp)/sqrt(rr)/
sqrt(qq-2*pq+pp)/sqrt(rr-2*qr+qq);
if ( fabs(cosbeta) > 1.0 )
{ sprintf(errmsg,"edge %s cosine of angle out of range in circular_willmore",
ELNAME(e_info->id));
kb_error(3850,errmsg,WARNING);
}
value = acos(cosbeta);
if ( mode == METHOD_VALUE )
return value;
/* Gradient */
if ( cosbeta*cosbeta >= 1.0 ) coeff = 0.0;
coeff = -1/sqrt(1 - cosbeta*cosbeta);
for ( i = 0 ; i < SDIM ; i++ )
{ dcdp[i] = (rr*q[i] - qq*r[i] - 2*rr*p[i] + 2*qr*p[i])/sqrt(pp)/sqrt(rr)/
sqrt(qq-2*pq+pp)/sqrt(rr-2*qr+qq)
- cosbeta/pp*p[i]
- cosbeta/(qq-2*pq+pp)*(-q[i] + p[i]);
dcdq[i] = (rr*p[i] - 2*pr*q[i] + pp*r[i])/sqrt(pp)/sqrt(rr)/
sqrt(qq-2*pq+pp)/sqrt(rr-2*qr+qq)
- cosbeta/(qq-2*pq+pp)*(q[i] - p[i])
- cosbeta/(rr-2*qr+qq)*(-r[i] + q[i]);
dcdr[i] = (2*r[i]*pq - qq*p[i] - 2*pp*r[i]+ pp*q[i])/sqrt(pp)/sqrt(rr)/
sqrt(qq-2*pq+pp)/sqrt(rr-2*qr+qq)
- cosbeta/rr*r[i]
- cosbeta/(rr-2*qr+qq)*(r[i] - q[i]);
e_info->grad[1][i] = coeff*dcdq[i];
e_info->grad[0][i] -= coeff*dcdq[i];
e_info->grad[2][i] = coeff*dcdp[i];
e_info->grad[0][i] -= coeff*dcdp[i];
e_info->grad[3][i] = coeff*dcdr[i];
e_info->grad[0][i] -= coeff*dcdr[i];
}
if ( mode == METHOD_GRADIENT )
return value;
/* Hessian */
return value;
}
REAL circle_willmore_value(e_info)
struct qinfo *e_info;
{ return circle_willmore_all(e_info,METHOD_VALUE);
}
REAL circle_willmore_grad(e_info)
struct qinfo *e_info;
{ return circle_willmore_all(e_info,METHOD_GRADIENT);
}
REAL circle_willmore_hess(e_info)
struct qinfo *e_info;
{ return circle_willmore_all(e_info,METHOD_HESSIAN);
}
evolver-2.30c.dfsg/src/hessian2.c 0000644 0001753 0001753 00000136603 11410765113 017106 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* FILE: hessian2.c
*
* Contents: more hessian routines
*/
#include "include.h"
REAL difference_lagrangian ARGS((void));
int sturm ARGS((int,REAL*,REAL*,REAL));
REAL ev_bisect ARGS((REAL,REAL,int,int,int,REAL*,REAL*));
/***************************************************************************
*
* function: difference_lagrangian()
*
* purpose: calculate lagrangian E - \lambda Q for difference_hessian,
* where E is energy and Q is constraint with lagrange multiplier
* \lambda
*/
REAL difference_lagrangian()
{ REAL sum;
body_id b_id;
struct gen_quant *q;
int k;
sum = web.total_energy;
FOR_ALL_BODIES(b_id)
if ( get_battr(b_id) & FIXEDVOL )
sum -= get_body_pressure(b_id)*get_body_volume(b_id);
for ( k = 0 ; k < gen_quant_count ; k++ )
{ q = GEN_QUANT(k);
if ( q->flags & Q_FIXED )
sum -= q->pressure*q->value;
}
return sum;
}
/**************************************************************************
*
* function: difference_hessian()
*
* purpose: calculation of hessian by differences in energies.
* meant only for checking other hessian calculations.
*
*/
void difference_hessian(S,verhead,rhs)
struct linsys *S;
struct hess_verlist *verhead; /* main vertex list */
REAL *rhs;
{ REAL dx = 0.00001; /* wiggle size */
REAL first[MAXCOORD];
MAT2D(second,MAXCOORD,MAXCOORD);
REAL e1,e2,e3,e4;
vertex_id v_id,vv_id;
int i,j;
REAL energyuu,energyud,energydu,energydd; /* really Lagrangians */
/* right hand side and self second derivatives */
/* move vertices 1 by 1 */
FOR_ALL_VERTICES(v_id)
{
int ord = loc_ordinal(v_id);
struct hess_verlist *v = verhead+ord;
REAL *x = get_coord(v_id);
if ( v->freedom == 0 ) continue;
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j <= i ; j++ )
{
x[i] += dx;
x[j] += dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
energyuu = difference_lagrangian();
x[j] -= 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
energyud = difference_lagrangian();
x[i] -= 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
energydd = difference_lagrangian();
x[j] += 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
energydu = difference_lagrangian();
x[i] += dx; x[j] -= dx; /* back to normal */
first[i] = (energyuu - energydu + energyud - energydd)/4/dx;
second[i][j] = second[j][i] =
(energyuu - energyud - energydu + energydd)/4/dx/dx;
}
fill_grad(S,v,first,rhs);
if ( hess_flag )
fill_self_entry(S,v_id,second);
}
/* second derivatives, go through all pairs of vertices */
if ( hess_flag )
FOR_ALL_VERTICES(v_id)
{
int ord = loc_ordinal(v_id);
struct hess_verlist *v = verhead+ord;
REAL *x = get_coord(v_id);
if ( v->freedom == 0 ) continue;
FOR_ALL_VERTICES(vv_id)
{
int ordd = loc_ordinal(vv_id);
struct hess_verlist *vv = verhead+ordd;
REAL *xx = get_coord(vv_id);
if ( vv->freedom == 0 ) continue;
if ( ord <= ordd ) continue; /* hessian is lower triangular */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{
x[i] += dx;
xx[j] += dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
e1 = difference_lagrangian();
x[i] -= 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
e2 = difference_lagrangian();
xx[j] -= 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
e3 = difference_lagrangian();
x[i] += 2*dx; global_timestamp++; calc_energy(); calc_content(Q_FIXED);
e4 = difference_lagrangian();
second[i][j] = (e1 - e2 + e3 - e4)/4/dx/dx;
x[i] -= dx; xx[j] += dx;
}
fill_mixed_entry(S,v_id,vv_id,second);
}
}
calc_energy(); calc_content(Q_FIXED); /* cleanup */
} /* end difference_hessian */
/******************************************************************
*
* function: dirichlet()
*
* Purpose: Minimization via Dirichlet integral,
* as done by Pinkall and Polthier.
*
* Argument: 0 for stepsize 1 (to minimum); 1 for seek minimum
*
* Return: stepsize
*/
/* Notes on method:
Idea is to minimize Dirichlet energy of image of current
surface. Dirichlet energy of image of triangle is
0.25*\sum_i cot(\alpha_i)*a_i^2
where \alpha_i is angle of vertex in facet in domain
and a_i is length of opposite edge in image. Hence energy
is pure quadratic and susceptible to exact solution.
When equilibrium is reached, identity map is conformal
so area is minimized.
Numerical solution uses mechanisms of hessian minimization.
*/
REAL dirichlet(seekmode)
int seekmode; /* 1 if want to search in direction of min */
{
REAL side[FACET_EDGES][MAXCOORD];
REAL *x,*y;
int r,s;
REAL area;
REAL cota;
int i,j;
facet_id f_id;
edge_id e_id;
vertex_id v[3];
facetedge_id fe;
REAL ss[FACET_VERTS],sd[FACET_VERTS];
int ii,iii;
REAL **rs; /* one right side for each coordinate */
REAL **xx; /* one solution vector for each coordinate */
struct hess_verlist *vc; /* current vertex */
struct hess_verlist *rv,*sv;
REAL scale;
REAL best_scale;
struct linsys S;
vertex_id v_id;
if ( fixed_constraint_flag )
kb_error(2081,"Cannot do dirichlet with constraints.\n",RECOVERABLE);
hmode = SINGLE_DEGREE; /* same hessian for each coordinate */
hessian_init(&S,NULL);
rs = dmatrix(0,SDIM-1,0,S.A_rows); /* right side for each coord */
xx = dmatrix(0,SDIM-1,0,S.A_rows); /* solution vector for each coord */
/* differences from current */
/* fill in */
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ e_id = get_fe_edge(fe);
get_edge_side(e_id,side[i]);
v[i] = get_edge_tailv(e_id);
fe = get_next_edge(fe);
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
sd[i] = SDIM_dot(side[i],side[(i+2)%FACET_VERTS]);
}
area = sqrt(ss[0]*ss[2] - sd[0]*sd[0]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ii = (i+1)%FACET_VERTS; iii = (i+2)%FACET_VERTS;
x = get_coord(v[ii]);
y = get_coord(v[iii]);
rv = get_vertex_vhead(v[ii]);
sv = get_vertex_vhead(v[iii]);
r = rv->rownum;
s = sv->rownum;
cota = -sd[i]/area;
if ( get_vattr(v[ii]) & FIXED )
if ( get_vattr(v[iii]) & FIXED )
continue;
else /* rhs contribution */
{
sp_hash_search(&S,sv->rownum,sv->rownum,0.5*cota);
for ( j = 0 ; j < SDIM ; j++ )
rs[j][s] += 0.5*cota*(y[j] - x[j]);
}
else
if ( get_vattr(v[iii]) & FIXED )
{ /* rhs contribution */
sp_hash_search(&S,rv->rownum,rv->rownum,0.5*cota);
for ( j = 0 ; j < SDIM ; j++ )
rs[j][r] += 0.5*cota*(x[j] - y[j]);
}
else /* main hessian contribution */
{
sp_hash_search(&S,rv->rownum,rv->rownum,0.5*cota);
sp_hash_search(&S,sv->rownum,sv->rownum,0.5*cota);
if ( sv->rownum < rv->rownum )
sp_hash_search(&S,sv->rownum,rv->rownum,-0.5*cota);
else
sp_hash_search(&S,rv->rownum,sv->rownum,-0.5*cota);
for ( j = 0 ; j < SDIM ; j++ )
{ rs[j][r] += cota/2*(x[j] - y[j]);
rs[j][s] += cota/2*(y[j] - x[j]);
}
}
}
}
/* extract stuff from hash table */
sp_hash_end(&S,S.A_rows,S.total_rows,A_OFF);
/* solve system */
memset((char*)&S,0,sizeof(struct linsys));
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
sp_factor(&S);
(*sp_hess_project_setup_func)(&S);
for ( i = 0 ; i < SDIM ; i++ )
sp_hessian_solve(&S,rs[i],xx[i],NO_SET_PRESSURE);
/* move vertices */
if ( seekmode == 0 ) { best_scale = 1.0; }
else
{ REAL energies[3];
REAL denom;
int k;
vertex_id v_id;
save_coords(&saved,SAVE_IN_ATTR); /* in case this doesn't work */
energies[0] = web.total_energy;
for ( scale = 1.0, k = 1 ; k < 3 ; scale += 1.0, k++ )
{
FOR_ALL_VERTICES(v_id)
{ REAL *coord;
vc = get_vertex_vhead(v_id);
if ( vc->freedom == 0 ) continue;
coord = get_coord(v_id);
for ( j = 0 ; j < SDIM ; j++ )
coord[j] = coord[j] - scale*xx[j][vc->rownum];
}
global_timestamp++;
calc_energy(); /* energy after motion */
if ( hess_debug || itdebug )
#ifdef LONGDOUBLE
printf("scale %f energy %*.*Lf\n",(DOUBLE)scale,DWIDTH,DPREC,web.total_energy);
#else
printf("scale %f energy %20.15f\n",(DOUBLE)scale,web.total_energy);
#endif
energies[k] = web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
}
denom = energies[0] - 2*energies[1] + energies[2];
if ( denom <= 0.0 )
best_scale = 1.0; /* energy not convex */
else best_scale = 0.5*(3*energies[0]-4*energies[1]+energies[2])/denom;
}
scale = best_scale;
FOR_ALL_VERTICES(v_id)
{ REAL *coord;
vc = get_vertex_vhead(v_id);
if ( vc->freedom == 0 ) continue;
coord = get_coord(vc->v_id);
for ( j = 0 ; j < SDIM ; j++ )
coord[j] = coord[j] - scale*xx[j][vc->rownum];
}
free_matrix(rs);
free_matrix(xx);
free_system(&S);
hessian_exit(NULL);
return best_scale;
} /* end dirichlet() */
/******************************************************************
*
* function: sobolev()
*
* Purpose: Minimization via Sobolev inner product,
* as done by Renka and Neuberger.
*
* Argument: seekmode - 0 for jump to quadratic min, 1 to seek
*
* Return: stepsize
*/
/* Notes on method:
R & N's method of using a Sobolev inner product to calculate
the gradient is equivalent to using a positive definite
quadratic form approximation for the area, and minimizing
the quadratic form.
Numerical solution uses mechanisms of hessian minimization.
*/
REAL sobolev(seekmode)
int seekmode; /* 1 if seek for best stepsize */
{
REAL side[FACET_EDGES][MAXCOORD];
int r;
REAL area;
int i,j,k,n;
facet_id f_id;
edge_id e_id;
vertex_id v[3];
vertex_id v_id;
facetedge_id fe;
REAL ss[FACET_VERTS],sd[FACET_VERTS];
int ii,iii;
REAL *rs,*rstmp; /* one right side for each coordinate */
REAL *rs_save;
struct hess_verlist *vc; /* current vertex */
struct hess_verlist *rv,*sv;
REAL scale;
REAL best_scale;
struct linsys S;
if ( fixed_constraint_flag )
kb_error(2082,"Cannot do sobolev with constraints.\n",RECOVERABLE);
kb_error(2083,"Sobolev not working properly.\n",WARNING);
hmode = UNRESTRICTED; /* full hessian needed */
hessian_init(&S,NULL);
rs = (REAL*)temp_calloc(S.A_rows,sizeof(REAL)); /* right side for each coord */
rs_save = (REAL*)temp_calloc(S.A_rows,sizeof(REAL)); /* right side for each coord */
rstmp = (REAL*)temp_calloc(S.A_rows,sizeof(REAL)); /* right side for each coord */
/* fill in */
FOR_ALL_FACETS(f_id)
{ fe = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ e_id = get_fe_edge(fe);
get_edge_side(e_id,side[i]);
v[i] = get_edge_tailv(e_id);
fe = get_next_edge(fe);
}
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
sd[i] = SDIM_dot(side[i],side[(i+2)%FACET_VERTS]);
}
area = sqrt(ss[0]*ss[2] - sd[0]*sd[0]);
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ ii = (i+1)%FACET_VERTS; iii = (i+2)%FACET_VERTS;
rv = get_vertex_vhead(v[ii]);
sv = get_vertex_vhead(v[iii]);
r = rv->rownum;
/* vertex self-term */
if ( !(get_vattr(v[iii]) & FIXED) )
{
for ( j = 0 ; j < SDIM ; j++ )
{
sp_hash_search(&S,sv->rownum+j,sv->rownum+j,ss[i]/area);
for ( k = j+1 ; k < SDIM ; k++ )
sp_hash_search(&S,sv->rownum+j,sv->rownum+k,
-side[i][j]*side[i][k]/area);
}
}
/* edge cross-term */
if ( !(get_vattr(v[iii]) & FIXED) && !(get_vattr(v[ii]) & FIXED) )
for ( j = 0 ; j < SDIM ; j++ )
{
if ( rv->rownum > sv->rownum )
{ sp_hash_search(&S,sv->rownum+j,rv->rownum+j,sd[i]/area);
for ( k = 0 ; k < SDIM ; k++ )
sp_hash_search(&S,sv->rownum+k,rv->rownum+j,
-side[i][j]*side[iii][k]/area);
}
else
{
for ( k = 0 ; k < SDIM ; k++ )
sp_hash_search(&S,rv->rownum+k,sv->rownum+j,
-side[i][j]*side[iii][k]/area);
}
}
/* right side */
if ( !(get_vattr(v[ii]) & FIXED) )
for ( j = 0 ; j < SDIM ; j++ )
rs[r+j] -= (sd[i]*side[iii][j] - ss[iii]*side[i][j])/area;
}
}
if ( hess_debug )
{ printf("Gradient: \n");
FOR_ALL_VERTICES(v_id)
{ vc = get_vertex_vhead(v_id);
if ( vc->freedom == 0 ) continue;
printf("n: %s ",ELNAME(v_id));
for ( j = 0 ; j < SDIM ; j++ ) printf ("%f ",(DOUBLE)rs[vc->rownum+j]);
printf("\n");
}
}
/* extract stuff from hash table */
sp_hash_end(&S,S.A_rows,S.total_rows,A_OFF);
/* solve system */
memcpy((char*)rs_save,(char*)rs,sizeof(REAL)*S.A_rows);
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
sp_factor(&S);
(*sp_hess_project_setup_func)(&S);
sp_hessian_solve(&S,rs,rstmp,NO_SET_PRESSURE);
for ( j = 0 ; j < S.N ; j++ ) rs[j] = rstmp[j];
if ( hess_debug )
{ printf("Motion: \n");
for ( n = 0, vc = vhead ; n < vhead_count ; n++, vc++ )
{ if ( vc->freedom == 0 ) continue;
printf("n: %d ",n);
for ( j = 0 ; j < SDIM ; j++ ) printf ("%f ",(DOUBLE)rs[vc->rownum+j]);
printf("\n");
}
printf("Dot with gradient: %f\n",(DOUBLE)dot(rs,rs_save,S.A_rows));
}
/* move vertices */
if ( seekmode == 0 ) { best_scale = 1.0; }
else
{ REAL energies[3];
REAL denom;
int k;
save_coords(&saved,SAVE_IN_ATTR); /* in case this doesn't work */
energies[0] = web.total_energy;
for ( scale = 1.0, k = 1 ; k < 3 ; scale += 1.0, k++ )
{ FOR_ALL_VERTICES(v_id)
{ REAL *coord;
vc = get_vertex_vhead(v_id);
if ( vc->freedom == 0 ) continue;
coord = get_coord(v_id);
for ( j = 0 ; j < SDIM ; j++ )
coord[j] = coord[j] - scale*rs[vc->rownum+j];
}
global_timestamp++;
calc_energy(); /* energy after motion */
if ( hess_debug || itdebug )
#ifdef LONGDOUBLE
printf("scale %f energy %*.*Lf\n",(DOUBLE)scale,DWIDTH,DPREC,web.total_energy);
#else
printf("scale %f energy %20.15f\n",(DOUBLE)scale,web.total_energy);
#endif
energies[k] = web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
}
denom = energies[0] - 2*energies[1] + energies[2];
if ( denom <= 0.0 )
best_scale = 1.0; /* energy not convex */
else best_scale = 0.5*(3*energies[0]-4*energies[1]+energies[2])/denom;
}
scale = best_scale;
FOR_ALL_VERTICES(v_id)
{ REAL *coord;
vc = get_vertex_vhead(v_id);
if ( vc->freedom == 0 ) continue;
coord = get_coord(v_id);
for ( j = 0 ; j < SDIM ; j++ )
coord[j] = coord[j] - scale*rs[vc->rownum+j];
}
temp_free((char*)rs);
temp_free((char*)rs_save);
temp_free((char*)rstmp);
free_system(&S);
hessian_exit(NULL);
return best_scale;
}
/***************************************************************************
Lanczos routines, for solving hessian for motion or eigenvectors
without factoring.
***************************************************************************/
/********************************************************************
*
* function: householder()
*
* purpose: perform Householder reduction.
* returns b so (I-bvv^T)x = 0 mostly
*/
REAL householder ARGS((REAL*,REAL*,int));
REAL householder(x,v,n)
REAL *x; /* vector to be zeroed, except first element */
REAL *v; /* vector used to generate transformation */
int n; /* size of x,v */
{ REAL maxx;
REAL a = 0.0,b;
int i;
for ( maxx = 0.0, i = 0 ; i < n ; i++ )
if ( fabs(x[i]) > maxx ) maxx = fabs(x[i]);
for ( i = 0 ; i < n ; i++ )
{ v[i] = x[i]/maxx;
a += v[i]*v[i];
}
a = sqrt(a);
b = 1/a/(a+fabs(v[0]));
v[0] += v[0]<0.0 ? -a : a;
return b;
}
/******************************************************************
*
* function: sturm()
*
* purpose: Sturm sequence for number of eigenvalues below x
* for tridiagonal matrix
*/
int sturm(n,alpha,beta,x)
int n; /* size of matrix */
REAL *alpha; /* main diagonal, size n */
REAL *beta; /* subdiagonal, size n-1 */
REAL x; /* test eigenvalue */
{ int i;
int changes;
REAL p,pp,t;
/* Sturm sequence for number of eigenvalues below x */
pp = 1.0;
p = alpha[0] - x;
changes = p < 0.0 ? 1 : 0;
for ( i = 1 ; i < n ; i++ )
{ t = (alpha[i] - x)*p - beta[i-1]*beta[i-1]*pp;
if ( t*p < 0.0 ) changes++;
pp = p; p = t;
}
return changes;
}
/*****************************************************************
*
* function: ev_bisect()
*
* purpose: returns smallest eigenvalue in interval
*
*/
REAL ev_bisect(left,right,cleft,cright,n,alpha,beta)
REAL left; /* left endpoint of interval */
REAL right; /* right endpoint of interval */
int cleft; /* sturm changes at left endpoint of interval */
int cright; /* sturm changes at right endpoint of interval */
int n; /* size of matrix */
REAL *alpha; /* main diagonal, size n */
REAL *beta; /* subdiagonal, size n-1 */
{ int cmid;
REAL mid;
REAL lowev = 0.0;
mid = (left+right)/2;
if ( right-left < 3*machine_eps )
{
#ifdef LONGDOUBLE
sprintf(msg,"%d at %2.*Lg\n",DPREC,cright-cleft,mid);
#else
sprintf(msg,"%d at %2.15g\n",cright-cleft,mid);
#endif
outstring(msg);
return mid;
}
cmid = sturm(n,alpha,beta,mid);
if ( cmid < cright )
lowev = ev_bisect(mid,right,cmid,cright,n,alpha,beta);
if ( cleft < cmid )
lowev = ev_bisect(left,mid,cleft,cmid,n,alpha,beta);
return lowev;
}
/**************************************************************************
*
* function: chebychev_ev()
*
* purpose: use Chebychev iteration to solve for eigenvalue and
* eigenvector.
*
*/
void chebychev_ev(S)
struct linsys *S;
{
REAL *v,*w; /* working vectors */
REAL *r;
REAL t; /* temp */
int i,k;
REAL maxev; /* eigenvalue upper bound */
REAL minev; /* eigenvalue lower bound */
REAL nextev;
REAL coeffA,coeffc;
REAL rayleigh=1.0; /* Rayleigh quotient */
int maxk;
char response[20];
REAL *X;
v = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
w = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
r = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
X = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
/* first, need to find upper bound on eigenvalues */
maxev = 1.0;
nextev = 0.0;
minev = 0.0;
do
{
prompt("Max iterations: ",response,sizeof(response));
maxk = atoi(response);
do
{
coeffA = 2/(maxev-nextev);
coeffc = -2*nextev/(maxev-nextev) - 1;
if ( minev >= 0.0 )
for ( i = 0 ; i < S->N ; i++ ) w[i] = drand48() - .5;
(*sp_mul_func)(S,w,v);
for ( i = 0 ; i < S->N ; i++ )
r[i] = coeffA*v[i] + coeffc*w[i];
coeffA *= 2; coeffc *= 2;
for ( k = 0 ; k < maxk ; k++ )
{ REAL *tmp;
REAL norm;
tmp = r; r = w; w = tmp;
(*sp_mul_func)(S,w,v);
for ( i = 0 ; i < S->N ; i++ )
r[i] = coeffA*v[i] + coeffc*w[i] - r[i];
/* periodically check Rayleigh quotient to see if bound needs raising */
norm = dot(w,w,S->N);
rayleigh = dot(w,v,S->N)/norm;
if ( rayleigh > maxev )
{ maxev = 1.2*rayleigh + .5; break; }
/* just some checking */
if ( (k % 50)==0 )
printf("%4d. rayleigh %2.15g maxev %g\n",k,(DOUBLE)rayleigh,(DOUBLE)maxev);
/* renormalize occasionally */
if ( (norm > 25.0) || (norm < .04) )
{ t = 1/sqrt(norm);
for ( i = 0 ; i < S->N ; i++ )
{ w[i] *= t; r[i] *= t; }
}
}
if ( rayleigh < minev-.00000001 )
{ minev = rayleigh; nextev = 0.99*rayleigh; }
} while ( k < maxk );
} while ( k > 0 );
printf("%4d. rayleigh %2.15g\n",k,(DOUBLE)rayleigh);
last_eigenvalue = rayleigh;
/* else try again with increased maxev */
/* now have got eigenvector for neg eigenvalue */
t = 1/sqrt(dot(r,r,S->N));
for ( i = 0 ; i < S->N ; i++ ) X[i] = t*r[i]; /* normalized */
temp_free((char*)w);
temp_free((char*)v);
temp_free((char*)r);
temp_free((char*)X);
} /* end chebychev_ev() */
/**************************************************************************
*
* function: chebychev_hess()
*
* purpose: use Chebychev iteration to solve for Hessian minimum.
* Requires semidefinite hessian.
*
*/
void chebychev_hess(S)
struct linsys *S;
{
REAL *v,*w; /* working vectors */
REAL *r;
REAL t; /* temp */
int i,k;
REAL maxev; /* eigenvalue upper bound */
REAL minev; /* eigenvalue lower bound */
REAL nextev;
REAL coeffA,coeffc;
REAL rayleigh=0.0; /* Rayleigh quotient */
REAL *X;
v = (REAL *)temp_calloc(S->N+1,sizeof(REAL));
w = (REAL *)temp_calloc(S->N+1,sizeof(REAL));
r = (REAL *)temp_calloc(S->N+1,sizeof(REAL));
X = (REAL *)temp_calloc(S->N+1,sizeof(REAL));
/* first, need to find upper bound on eigenvalues */
maxev = 1.0;
nextev = 0.0;
minev = 0.0;
do
{
coeffA = 2/(maxev-nextev);
coeffc = -2*nextev/(maxev-nextev) - 1;
if ( minev >= 0.0 )
for ( i = 0 ; i < S->N ; i++ ) w[i] = drand48() - .5;
(*sp_mul_func)(S,w,v);
for ( i = 0 ; i < S->N ; i++ )
r[i] = coeffA*v[i] + coeffc*w[i];
coeffA *= 2; coeffc *= 2;
for ( k = 0 ; k < 200 ; k++ )
{ REAL *tmp;
REAL norm;
tmp = r; r = w; w = tmp;
(*sp_mul_func)(S,w,v);
for ( i = 0 ; i < S->N ; i++ )
r[i] = coeffA*v[i] + coeffc*w[i] - r[i];
/* periodically check Rayleigh quotient to see if bound needs raising */
norm = dot(w,w,S->N);
rayleigh = dot(w,v,S->N)/norm;
if ( rayleigh > maxev )
{ maxev = rayleigh + .5; break; }
/* just some checking */
if ( (k % 50)==0 )
printf("%4d. rayleigh %2.15g maxev %g\n",k,(DOUBLE)rayleigh,(DOUBLE)maxev);
/* renormalize occasionally */
if ( (k&0xFFF0) == 0 )
{ t = 1/sqrt(norm);
for ( i = 0 ; i < S->N ; i++ )
{ w[i] *= t; r[i] *= t; }
}
}
if ( rayleigh < minev-.00000001 )
{ minev = rayleigh; nextev = 0.9*rayleigh; k = 0; continue; }
} while ( k < 200 );
printf("%4d. rayleigh %2.15g\n",k,(DOUBLE)rayleigh);
/* else try again with increased maxev */
/* now have got eigenvector for neg eigenvalue */
t = 1/sqrt(dot(r,r,S->N));
for ( i = 0 ; i < S->N ; i++ ) X[i] = t*r[i]; /* normalized */
temp_free((char*)w);
temp_free((char*)v);
temp_free((char*)r);
temp_free((char*)X);
} /* end chebychev_hess() */
/****************************************************************************
*
* function: eigenprobe_command()
*
* purpose: handle "eigenprobe lambda" command from command line
*
*/
void eigenprobe_command(lambda,iters)
REAL lambda;
int iters; /* iteration bound */
{ struct linsys S;
int i,k;
REAL t,oldt;
REAL *W = NULL; /* for use when metric is needed */
REAL *X = NULL; /* for eigenvector */
hmode = hessian_normal_flag;
hessian_init(&S,NULL);
hess_flag = 1; rhs_flag = 0;
hessian_fill(&S,NULL);
S.lambda = lambda;
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
if ( hessian_linear_metric_flag )
{
linear_metric_setup(&S,&Met);
}
else if ( web.area_norm_flag )
{
star_metric_setup(&S,&Met);
}
sp_factor(&S);
(*sp_hess_project_setup_func)(&S);
sprintf(msg,"Eigencounts: %d <, %d ==, %d > \n",S.neg,S.zero,S.pos);
outstring(msg);
if ( iters <= 0 ) goto ep_exit;
if ( web.area_norm_flag || hessian_linear_metric_flag )
W = (REAL*)temp_calloc(S.N,sizeof(REAL));
X = (REAL*)temp_calloc(S.N,sizeof(REAL));
/* inverse iteration */
/* random starting vector */
for ( i = 0 ; i < S.N ; i++ ) X[i] = drand48();
t = 1/sqrt(dot(X,X,S.N));
for ( i = 0 ; i < S.N ; i++ ) X[i] *= t;
oldt = 1e30; /* for convergence test */
for ( k = 0 ; k < iters ; k++ )
{ REAL oldv0=1.0; /* for sign */
int oldvi=0; /* index of nonzero component */
REAL eps = 1/sqrt((REAL)(S.N))/2;
for ( i = 0, oldv0 = 0.0 ; i < S.N ; i++ )
if ( fabs(X[i]) > eps ) { oldvi = i; oldv0 = X[i]; break; }
if ( web.area_norm_flag || hessian_linear_metric_flag )
(*sp_mul_func)(&Met,X,W);
else W = X;
sp_hessian_solve(&S,W,X,NO_SET_PRESSURE);
if ( web.area_norm_flag || hessian_linear_metric_flag )
t = 1/sqrt(sparse_metric_dot(X,X,&Met));
else t = 1/sqrt(dot(X,X,S.N));
if ( X[oldvi]*oldv0 < 0. ) t = -t; /* get sign right */
#ifdef LONGDOUBLE
if ( k % 10 == 0 ) printf("%d ev = %*.*Lf\n",k,DWIDTH,DPREC,S.lambda+t);
#else
if ( k % 10 == 0 ) printf("%d ev = %20.15f\n",k,S.lambda+t);
#endif
for ( i = 0 ; i < S.N ; i++ ) X[i] *= t;
if ( fabs(t-oldt) <= 100*machine_eps*fabs(t) )
{
break;
}
oldt = t;
}
#ifdef LONGDOUBLE
printf("%d ev = %*.*Lf\n",k,DWIDTH,DPREC,S.lambda+t);
#else
printf("%d ev = %20.15f\n",k,S.lambda+t);
#endif
if ( S.zero != 0 ) last_eigenvalue = S.lambda;
else
last_eigenvalue = S.lambda+t;
if ( web.area_norm_flag || hessian_linear_metric_flag )
temp_free((char*)W);
ep_exit:
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
hessian_exit(X);
temp_free((char*)X);
} /* end eigenprobe_command() */
/****************************************************************************
*
* function: lanczos_command()
*
* purpose: handle "lanczos lambda" command from command line
*
*/
void lanczos_command(lambda,krydim)
REAL lambda;
int krydim; /* dimension of Krylov subspace */
{ struct linsys S;
REAL evalues[NPRINT];
int i,nprint;
hmode = hessian_normal_flag;
hessian_init(&S,NULL);
hess_flag = 1; rhs_flag = 0;
hessian_fill(&S,NULL);
S.lambda = lambda;
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
if ( hessian_linear_metric_flag )
{
linear_metric_setup(&S,&Met);
}
else if ( web.area_norm_flag )
{
star_metric_setup(&S,&Met);
}
sp_factor(&S);
(*sp_hess_project_setup_func)(&S);
sprintf(msg,"Eigencounts: %d <, %d ==, %d > \n",S.neg,S.zero,S.pos);
outstring(msg);
nprint = lanczos(&S,krydim,evalues,NPRINT);
/* list, ones near probe value */
for ( i = 0 ; i < nprint ; i++ )
{
#ifdef LONGDOUBLE
sprintf(msg,"%d %*.*Lf\n",i+1,DWIDTH,DPREC,evalues[i]);
#else
sprintf(msg,"%d %20.15f\n",i+1,evalues[i]);
#endif
outstring(msg);
}
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
hessian_exit(NULL);
} /* end lanczos_command() */
/*****************************************************************************
*
* function: lanczos()
*
* purpose: find eigenvalues near probe value
* returns number distinct ones found
*
*/
int realabs_comp ARGS((REAL*,REAL*));
int realabs_comp(a,b)
REAL *a,*b;
{if(fabs(*a)fabs(*b))return 1;return 0;}
int lanczos(S,krydim,evalues,nprint)
struct linsys *S;
int krydim; /* dimension of krylov space to use */
REAL *evalues; /* for return of eigenvalues */
int nprint; /* number to return */
{ REAL *diag; /* main diagonal of tridiagonal */
REAL *subdiag; /* subdiagonal */
REAL *v,*w,*mw; /* working vectors; w is Lanczos vector */
REAL *r;
REAL t; /* temp */
int i,j;
if ( krydim > S->N-S->CN ) krydim = S->N-S->CN;
if ( nprint > krydim ) nprint = krydim;
diag = (REAL *)temp_calloc(krydim+1,sizeof(REAL));
subdiag = (REAL *)temp_calloc(krydim+1,sizeof(REAL));
v = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
w = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
r = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
if ( web.area_norm_flag || hessian_linear_metric_flag )
mw = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
else mw = NULL;
/* Lanczos iteration to tridiagonal, starting at index 1 in diag and subdiag */
/* not doing any re-orthogonalization, so multiple eigenvalues can
let large eigenvalues creep in spuriously multiple */
for ( i = 0 ; i < S->N ; i++ ) w[i] = drand48() - .5;
if ( web.area_norm_flag || hessian_linear_metric_flag )
t = 1/sqrt(sparse_metric_dot(w,w,&Met));
else t = 1/sqrt(dot(w,w,S->N));
for ( i = 0 ; i < S->N ; i++ ) w[i] *= t;
subdiag[0] = 1.0;
for ( j = 0 ; j < krydim ; )
{ if ( subdiag[j] == 0.0 )
{ outstring("premature subdiag = 0\n"); break; }
if ( j > 0 )
{ for ( i = 0 ; i < S->N ; i++ )
{ t = w[i]; w[i] = v[i]/subdiag[j]; v[i] = -subdiag[j]*t; }
}
/* v = Aw + v */
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ bk_mul(&Met,w,mw);
sp_hessian_solve(S,mw,r,NO_SET_PRESSURE);
}
else sp_hessian_solve(S,w,r,NO_SET_PRESSURE);
for ( i = 0 ; i < S->N ; i++ ) v[i] += r[i];
j = j + 1;
if ( web.area_norm_flag || hessian_linear_metric_flag )
diag[j] = sparse_metric_dot(w,v,&Met);
else diag[j] = dot(w,v,S->N);
for ( i = 0 ; i < S->N ; i++ ) v[i] -= diag[j]*w[i];
if ( web.area_norm_flag || hessian_linear_metric_flag )
subdiag[j] = sqrt(sparse_metric_dot(v,v,&Met));
else subdiag[j] = sqrt(dot(v,v,S->N));
}
/* solve tridiagonal */
tridiag_QL(diag+1,subdiag+1,krydim);
/* sort eigenvalues */
qsort((char*)(diag+1),krydim,sizeof(REAL),FCAST realabs_comp);
/* unshift */
for ( i = 1 ; i <= krydim ; i++ )
if ( diag[i] == 0.0 ) diag[i] = S->lambda;
else diag[i] = S->lambda + 1/diag[i];
/* uniqify */
for ( i = 2, j = 1; i <= krydim ; i++ )
{ if ( fabs(diag[j] - diag[i]) < 100*machine_eps ) continue;
diag[++j] = diag[i];
}
krydim = j;
if ( nprint > krydim ) nprint = krydim;
/* list, ones near probe value */
for ( i = 0 ; i < nprint ; i++ ) evalues[i] = diag[krydim-i];
temp_free((char*)diag);
temp_free((char*)subdiag);
temp_free((char*)v);
temp_free((char*)w);
temp_free((char*)r);
if ( mw ) temp_free((char*)mw);
return nprint;
} /* end lanczos() */
/*****************************************************************************
*
* function: selective_lanczos()
*
* purpose: find eigenvalues near probe value using selective
* reorthogonalization, i.e. saves basis vectors for which Av
* grows significantly. Does not do uniqifying of eigenvalues.
* returns number found
*
*/
int selective_lanczos(S,krydim,evalues,nprint)
struct linsys *S;
int krydim; /* dimension of krylov space to use */
REAL *evalues; /* for return of eigenvalues */
int nprint; /* number to return */
{ REAL *diag; /* main diagonal of tridiagonal */
REAL *subdiag; /* subdiagonal */
REAL *v,*w,*mw; /* working vectors; w is Lanczos vector */
REAL *r;
REAL t; /* temp */
int i,j,k;
REAL **basis; /* for saving basis vectors for reortho */
REAL *rayleigh; /* rayleigh quotients associated to basis vectors */
int basis_count = 0; /* how many basis vectors saved */
REAL growth;
if ( krydim > S->N ) krydim = S->N;
if ( nprint > krydim ) nprint = krydim;
diag = (REAL *)temp_calloc(krydim+1,sizeof(REAL));
subdiag = (REAL *)temp_calloc(krydim+1,sizeof(REAL));
v = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
w = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
r = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
if ( web.area_norm_flag || hessian_linear_metric_flag )
mw = (REAL *)temp_calloc(S->N+S->concount+1,sizeof(REAL));
else mw = NULL;
basis = dmatrix(0,nprint-1,0,S->N-1);
rayleigh = (REAL*)temp_calloc(nprint,sizeof(REAL));
/* Lanczos iteration to tridiagonal, starting at index 1 in diag and subdiag */
for ( i = 0 ; i < S->N ; i++ ) w[i] = drand48() - .5;
if ( web.area_norm_flag || hessian_linear_metric_flag )
t = 1/sqrt(sparse_metric_dot(w,w,&Met));
else t = 1/sqrt(dot(w,w,S->N));
for ( i = 0 ; i < S->N ; i++ ) w[i] *= t;
subdiag[0] = 1.0;
for ( j = 0 ; j < krydim ; )
{ if ( subdiag[j] == 0.0 )
{ outstring("premature subdiag = 0\n"); break; }
if ( j > 0 )
{ for ( i = 0 ; i < S->N ; i++ )
{ t = w[i]; w[i] = v[i]/subdiag[j]; v[i] = -subdiag[j]*t; }
}
/* v = Aw + v */
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ bk_mul(&Met,w,mw);
sp_hessian_solve(S,mw,r,NO_SET_PRESSURE);
}
else sp_hessian_solve(S,w,r,NO_SET_PRESSURE);
for ( i = 0 ; i < S->N ; i++ ) v[i] += r[i];
j = j + 1;
if ( web.area_norm_flag || hessian_linear_metric_flag )
diag[j] = sparse_metric_dot(w,v,&Met);
else diag[j] = dot(w,v,S->N);
for ( i = 0 ; i < S->N ; i++ ) v[i] -= diag[j]*w[i];
/* reorthogonalize */
for ( k = 0 ; k < basis_count ; k++ )
{ REAL d;
REAL *p = basis[k];
if ( web.area_norm_flag || hessian_linear_metric_flag )
d = sparse_metric_dot(basis[k],v,&Met);
else d = dot(basis[k],v,S->N);
for ( i = 0 ; i < S->N ; i++,p++ ) v[i] -= d*(*p);
}
if ( web.area_norm_flag || hessian_linear_metric_flag )
subdiag[j] = sqrt(sparse_metric_dot(v,v,&Met));
else subdiag[j] = sqrt(dot(v,v,S->N));
/* maybe save this basis vector for orthogonalization */
growth =
sqrt(subdiag[j]*subdiag[j]+diag[j]*diag[j]+subdiag[j-1]*subdiag[j-1]);
if ( growth > 1.0 )
{ /* save */
int which = -1; /* which to replace, with non-replace initial value */
if ( basis_count < nprint ) which = basis_count++;
else /* maybe replace smaller growth vector */
{ REAL diff = 0.0;
for ( i = 0 ; i < basis_count ; i++ )
if ( growth - rayleigh[i] > diff )
{ diff = growth - rayleigh[i]; which = i; }
}
if ( which >= 0 )
{ rayleigh[which] = growth;
memcpy((char*)(basis[which]),(char*)w,S->N*sizeof(REAL));
}
}
}
/* solve tridiagonal */
tridiag_QL(diag+1,subdiag+1,krydim);
/* sort eigenvalues */
qsort((char*)(diag+1),krydim,sizeof(REAL),FCAST realabs_comp);
/* unshift */
for ( i = 1 ; i <= krydim ; i++ )
diag[i] = S->lambda + 1/diag[i];
/* list, ones near probe value */
for ( i = 0 ; i < nprint ; i++ ) evalues[i] = diag[krydim-i];
temp_free((char*)diag);
temp_free((char*)subdiag);
temp_free((char*)v);
temp_free((char*)w);
if ( mw ) temp_free((char*)mw);
temp_free((char*)r);
temp_free((char*)rayleigh);
free_matrix(basis);
return nprint;
} /* end selective_lanczos() */
/***************************************************************************
*
* function: tridiag_QL()
*
* purpose: QL algorithm with implicit shifts to determine eigenvalues
* of a tridiagonal matrix. From Numerical Recipes in C.
*/
#define SIGN(a,b) ((b)<0.0 ? -fabs(a) : fabs(a))
void tridiag_QL(d,e,n)
REAL *d; /* n diagonal elements, d[0] in a[0][0] */
REAL *e; /* n-1 subdiagonal, e[0] in a[1][0], plus an extra! */
int n; /* size */
{ int m,l,iter,i;
REAL s,r,p,g,f,dd,c,b;
d--;e--; /* to agree with Numerical Recipes indexing */
e[n] = 0.0;
for ( l = 1 ;l <= n ; l++ )
{ iter = 0;
do
{ for ( m=l ; m <= n-1 ; m++ ) /* test matrix splitting */
{ dd = fabs(d[m]) + fabs(d[m+1]);
if ( fabs(e[m]) + dd == dd ) break;
}
if ( m != l )
{ if ( iter++ >= 30 )
kb_error(1654,"Over 30 iterations in QL algorithm solving for eigenvalues.\n",RECOVERABLE);
g = (d[l+1]-d[l])/(2*e[l]); /* form shift */
r = sqrt(g*g+1.0);
g = d[m] - d[l] + e[l]/(g + SIGN(r,g));
s = c = 1.0;
p = 0.0;
for ( i = m-1 ; i >= l ; i-- )
{ f = s*e[i];
b = c*e[i];
if ( fabs(f) >= fabs(g) )
{ c = g/f;
r = sqrt(c*c + 1.0);
e[i+1] = f*r;
c *= (s = 1/r);
}
else
{ s = f/g;
r = sqrt(s*s + 1.0);
e[i+1] = g*r;
s *= (c = 1/r);
}
g = d[i+1] - p;
r = (d[i] - g)*s + 2*c*b;
p = s*r;
d[i+1] = g + p;
g = c*r - b;
}
d[l] -= p;
e[l] = g;
e[m] = 0.0;
}
} while ( m != l );
}
} /* end tridiagonal_QL () */
/****************************************************************************
*
* function: LQ_decomp()
*
* purpose: orthonormalize rows of a rectangular matrix A by Gram-Schmidt and
* return factorizion into A = LQ where L is lower
* triangular and Q is orthonormal, Q M Q^T = I.
*/
void LQ_decomp(A,rows,cols,Q,L,M)
REAL **A; /* input */
int rows; /* number of rows in A */
int cols; /* number of columns in A */
REAL **Q; /* orthonormal rows, size rows * cols */
REAL **L; /* factor, size rows * rows */
struct linsys *M; /* metric to use; NULL if Euclidean */
{ int i,j,k;
REAL t;
for ( i = 0 ; i < rows ; i++ )
{ if ( Q != A )/* copy over */
for ( k = 0 ; k < cols ; k++ )
Q[i][k] = A[i][k];
for ( j = 0 ; j < i ; j++ )
{ t = M ? sparse_metric_dot(Q[j],Q[i],M) : dot(Q[j],Q[i],cols);
L[i][j] = t;
for ( k = 0 ; k < cols ; k++ )
Q[i][k] -= t*Q[j][k];
}
t = M ? sparse_metric_dot(Q[i],Q[i],M) : dot(Q[i],Q[i],cols);
if ( t != 0.0 )
{ L[i][i] = t = sqrt(t);
t = 1/t;
for ( k = 0 ; k < cols ; k++ )
Q[i][k] *= t;
}
}
} /* end LQ_decomp() */
/****************************************************************************
*
* function: QR_full()
*
* purpose: QR algorithm for eigenvalues of dense symmetric matrix
* Not too good, since doesn't shift. Has problem with
* multiple eigenvalues.
*
*/
void QR_full ARGS((REAL **,REAL *,int, struct linsys *));
void QR_full(A,evalues,n,M)
REAL **A; /* input, destroyed */
REAL *evalues; /* for reporting eigenvalues */
int n; /* size of system */
struct linsys *M; /* metric, NULL for Euclidean */
{ REAL **Q,**L;
int i,j;
REAL resid;
int count = 0;
Q = dmatrix(0,n-1,0,n-1);
L = dmatrix(0,n-1,0,n-1);
do
{ LQ_decomp(A,n,n,Q,L,M);
mat_mult(Q,L,A,n,n,n);
for ( i = 0, resid = 0.0 ; i < n ; i++ )
for ( j = 0 ; j < i ; j++ )
resid += fabs(A[i][j]);
#ifdef LONGDOUBLE
sprintf(msg,"QR residual %*.*Lf\n",DWIDTH,DPREC,resid);
#else
sprintf(msg,"QR residual %20.15f\n",resid);
#endif
outstring (msg);
} while ( (resid > 1000*machine_eps) && (count++ < 20) );
for ( i = 0 ; i < n ; i++ ) evalues[i] = A[i][i];
} /* end QR_full() */
/****************************************************************************
*
* function: ritz_command()
*
* purpose: handle "ritz(lambda,eigencount)" command from command line
*
*/
void ritz_command(lambda,ritzdim)
REAL lambda; /* probe value */
int ritzdim; /* dimension of Rayleigh-Ritz subspace */
{ struct linsys S;
REAL *rhs;
memset((char*)&S,0,sizeof(struct linsys));
hmode = hessian_normal_flag;
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 0;
hessian_fill(&S,&rhs);
if ( sparse_constraints_flag )
(*sp_AIJ_setup_func)(S.total_rows,&S);
else
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
if ( hessian_linear_metric_flag )
{
linear_metric_setup(&S,&Met);
}
else if ( web.area_norm_flag )
{
star_metric_setup(&S,&Met);
}
do_ritz(&S,lambda,ritzdim,NULL);
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
temp_free((char*)rhs);
hessian_exit(NULL);
} /* end ritz_command() */
/**************************************************************************
*
* function: do_ritz()
*
* purpose: Do Ritz subspace iteration
* Hessian already set up.
* Input: If ritzdim over 1000, ritzdim/1000 is the number of extra
* vectors to include in the Ritz subspace, in hopes that
* including a few extra will find an eigenvalue gap big enough
* to speed convergence.
*/
REAL *evalues;
void do_ritz(S,lambda,ritzdim,ritzvec)
struct linsys *S; /* Hessian */
REAL lambda; /* shift value */
int ritzdim; /* dimension of subspace */
REAL **ritzvec; /* non-null if want eigenvectors returned */
{
int i,j;
REAL **Lmat,**rbasis,**Arbasis;
REAL resid;
REAL **A;
REAL *oldevalues;
REAL **evectors;
int converged; /* number of eigenvectors converged */
int iter;
REAL diff = 1e30,olddiff=1e30;
REAL **mw;
struct linsys *M; /* metric to use */
REAL *work;
int ritzwanted;
int maxritz;
int old_breakflag;
/* see if user wants extra ritz vectors */
ritzwanted = ritzdim % 1000;
ritzdim = (ritzdim/1000) + ritzwanted;
if ( ritzdim < 0 )
{ outstring("Ritz dimension cannot be negative.\n"); return; }
S->lambda = lambda;
sp_factor(S);
(*sp_hess_project_setup_func)(S);
sprintf(msg,"Eigencounts: %d <, %d ==, %d > \n",S->neg,S->zero,S->pos);
outstring(msg);
if ( ritzdim == 0 ) return;
maxritz = S->N - (augmented_hessian_mode ? 2 : 1)* S->CN;
if ( ritzdim > maxritz )
ritzdim = maxritz;
if ( ritzwanted > ritzdim ) ritzwanted = ritzdim;
/* now find near-invariant subspace by power iteration and orthog */
Lmat = dmatrix(0,ritzdim-1,0,ritzdim-1); /* for QR decomp */
if ( ritzvec ) rbasis = ritzvec;
else
rbasis = dmatrix(0,ritzdim-1,0,S->N-1+S->concount);
Arbasis = dmatrix(0,ritzdim-1,0,S->N-1+S->concount); /* multiplied basis */
A = dmatrix(0,ritzdim-1,0,ritzdim-1);
mw = dmatrix(0,ritzdim-1,0,S->N+S->concount);
evalues = (REAL*)realloc(evalues,ritzdim*sizeof(REAL));
oldevalues = (REAL*)temp_calloc(ritzdim,sizeof(REAL));
work = (REAL*)temp_calloc(2*S->N,sizeof(REAL));
for ( i = 0 ; i < ritzdim ; i++ ) oldevalues[i] = -1e18; /* unlikely value */
evectors = dmatrix(0,ritzdim-1,0,ritzdim-1);
/* for augmented hessian, want augmented part of rhs 0 always */
for ( i = 0 ; i < ritzdim ; i++ )
for ( j = 0 ; j < S->A_rows ; j++ ) rbasis[i][j] = drand48() - .5;
iter = 0;
converged = 0;
iterate_flag = 1; /* for politer interrupt message */
if ( web.area_norm_flag || hessian_linear_metric_flag ) M = &Met;
else M = NULL;
old_breakflag = breakflag;
do
{
if ( web.area_norm_flag || hessian_linear_metric_flag )
{ for ( i = converged ; i < ritzdim ; i++ )
bk_mul(&Met,rbasis[i],mw[i]);
sp_hessian_solve_multi(S,mw+converged,Arbasis+converged,
ritzdim-converged);
}
else sp_hessian_solve_multi(S,rbasis+converged,Arbasis+converged,
ritzdim-converged);
if ( augmented_hessian_mode )
{ /* set augmented part to 0 */
for ( i = converged ; i < ritzdim ; i++ )
for ( j = S->A_rows ; j < S->N ; j++ )
Arbasis[i][j] = 0.0;
}
LQ_decomp(Arbasis,ritzdim,S->A_rows,rbasis,Lmat,M);
iter ++;
/* add up off-diagonal residuals */
for ( i = 0, resid = 0.0 ; i < ritzdim ; i++ )
for ( j = 0 ; j < i ; j++ )
resid += fabs(Lmat[i][j]);
/* get matrix in Rayleigh-Ritz subspace */
for ( i = converged ; i < ritzdim ; i++ )
{ if ( web.area_norm_flag || hessian_linear_metric_flag )
{ bk_mul(&Met,rbasis[i],mw[i]);
memcpy((char*)(rbasis[i]),(char*)(mw[i]),Met.N*sizeof(REAL));
}
}
sp_hessian_solve_multi(S,rbasis+converged,Arbasis+converged,
ritzdim-converged);
if ( augmented_hessian_flag )
{ /* set augmented part to 0 */
for ( i = converged ; i < ritzdim ; i++ )
for ( j = S->A_rows ; j < S->N ; j++ )
Arbasis[i][j] = 0.0;
}
mat_mul_tr(rbasis+converged,Arbasis+converged,A,ritzdim-converged,
S->A_rows,ritzdim-converged);
jacobi_eigenpairs(A,ritzdim-converged,evalues+converged,evectors+converged,work);
msg[0] = 0 ;
/* get eigenvector basis for subspace */
tr_mat_mul(evectors+converged,Arbasis+converged,rbasis+converged,
ritzdim-converged,ritzdim-converged,S->A_rows);
for ( i = converged ; i < ritzdim ; i++ )
if ( evalues[i] == oldevalues[i] )
{ converged++;
#ifdef LONGDOUBLE
sprintf(msg,"%3d. %*.*Lf\n",converged,DWIDTH,DPREC,1/evalues[i]+lambda);
#else
sprintf(msg,"%3d. %20.15f\n",converged,1/evalues[i]+lambda);
#endif
outstring(msg);
}
else break;
olddiff = diff;
for ( diff = 0.0 ; i < ritzwanted ; i++ )
{ diff += fabs(evalues[i] - oldevalues[i]);
oldevalues[i] = evalues[i];
}
} while ( (iter<1000) && ((diff < olddiff)||(diff > 10*S->N*machine_eps))
&& (diff > 100*machine_eps) && !breakflag );
breakflag = old_breakflag;
/* normalize eigenvectors */
for ( i = 0 ; i < ritzdim ; i++ )
{ REAL mag;
if ( M ) mag = 1/sqrt(sparse_metric_dot(rbasis[i],rbasis[i],M));
else mag = 1/sqrt(dot(rbasis[i],rbasis[i],S->A_rows));
for ( j = 0 ; j < S->A_rows ; j++ ) rbasis[i][j] *= mag;
}
/* list, ones near probe value */
/* convert and insertion sort */
for ( i = 0 ; i < ritzwanted ; i++ )
{ REAL eig;
REAL *rtmp;
if ( evalues[i] == 0.0 ) eig = 1e30;
else eig = 1/evalues[i] + lambda;
rtmp = rbasis[i];
for ( j = i ; j > converged ; j-- )
{ if ( evalues[j-1] > eig )
{ evalues[j] = evalues[j-1]; rbasis[j] = rbasis[j-1]; }
else break;
}
evalues[j] = eig;
rbasis[j] = rtmp;
}
for ( i = converged ; i < ritzwanted ; i++ )
{ if ( evalues[i] > 1e29 ) sprintf(msg,"%3d. Singular??\n",i+1);
#ifdef LONGDOUBLE
else sprintf(msg,"%3d. %*.*Lf\n",i+1,DWIDTH,DPREC,evalues[i]);
#else
else sprintf(msg,"%3d. %18.13f\n",i+1,evalues[i]);
#endif
outstring(msg);
}
sprintf(msg,
"Iterations: %d. Total eigenvalue changes in last iteration: %10.8g\n",
iter,(DOUBLE)diff);
outstring(msg);
if ( S->zero != 0 ) last_eigenvalue = S->lambda;
else
last_eigenvalue = evalues[0];
set_eigenvalue_list_global(evalues,ritzdim);
free_matrix(Lmat);
free_matrix(A);
if ( ritzvec == NULL ) free_matrix(rbasis);
free_matrix(Arbasis);
free_matrix(evectors);
temp_free((char*)oldevalues);
temp_free((char*)work);
free_matrix(mw);
} /* end do_ritz() */
evolver-2.30c.dfsg/src/stringq.c 0000644 0001753 0001753 00000025141 11410765113 017053 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************************
*
* File: stringq.c
*
* Purpose:
* Functions to calculate area, length, and energy according to
* the QUADRATIC STRING model.
*/
#include "include.h"
/* combining coefficients for coordinates of interpolation pts */
/* initialized in scoeff_init() */
REAL gcombo[EDGE_CTRL][EDGE_INTERP];
/* antisymmetric coefficients for area integral */
/* with diagonal elements to give area over x-axis for torus ease */
REAL scoeff[EDGE_CTRL][EDGE_CTRL] = {
{ 0.5, -2.0/3, 1.0/6 },{2.0/3, 0.0, -2.0/3},{-1.0/6, 2.0/3, -0.5} } ;
/* length gradient coefficients for string forces */
/* sdip[control][eval] - eval is integration index
control is control point index for grad */
REAL sdip[EDGE_CTRL][EDGE_INTERP];
/* integration coefficients for string forces */
/* ssimp[control][eval] */
REAL ssimp[EDGE_CTRL][EDGE_INTERP];
/* three-point gaussian integration on [0,2] */
REAL gauss2pt[EDGE_INTERP] = { 0.225403330758517, 1.0, 1.774596669241483 };
REAL gauss2wt[EDGE_INTERP] = { 5.0/9, 8.0/9, 5.0/9 };
REAL interpoly(k,u)
int k;
REAL u;
{
switch ( k )
{
case 0: return (1 - u)*(2 - u)/2;
case 1: return u*(2 - u);
case 2: return u*(u - 1)/2;
}
return 0.0; /* error return */
}
REAL interpolyderiv(k,u)
int k;
REAL u;
{
switch ( k )
{
case 0: return u - 1.5;
case 1: return 2 - 2*u;
case 2: return u - 0.5;
}
return 0.0; /* error return */
}
void scoeff_init()
{
int i,j;
for ( i = 0 ; i < EDGE_CTRL ; i++ )
for ( j = 0 ; j < EDGE_INTERP ; j++ )
{
gcombo[i][j] = interpoly(i,gauss2pt[j]);
sdip[i][j] = interpolyderiv(i,gauss2pt[j]);
ssimp[i][j] = gauss2wt[j]*sdip[i][j];
}
}
/************************************************************************
*
* Calculates all forces on control points due to edge and
* accumulates them at each control point.
* Quadratic version.
*/
void edge_force_q(e_id)
edge_id e_id;
{
REAL *x[EDGE_CTRL],*force[EDGE_CTRL],etang[EDGE_INTERP][MAXCOORD];
REAL norm[MAXCOORD];
REAL len;
REAL density = get_edge_density(e_id);
vertex_id hv = get_edge_headv(e_id);
vertex_id mv = get_edge_midv(e_id);
vertex_id tv = get_edge_tailv(e_id);
REAL torusx[MAXCOORD]; /* for unwrapping head in torus */
int i,j,k;
x[0] = get_coord(tv);
x[1] = get_coord(mv);
x[2] = get_coord(hv);
force[0] = get_force(tv);
force[1] = get_force(mv);
force[2] = get_force(hv);
if ( web.torus_flag )
{ /* unwrap head */
(*sym_wrap)(x[2],torusx,get_edge_wrap(e_id));
x[2] = torusx;
}
for ( i = 0 ; i < EDGE_INTERP ; i++ )
{
for ( j = 0 ; j < SDIM ; j ++ )
{
etang[i][j] = 0.0;
for ( k = 0 ; k < EDGE_CTRL ; k++ )
etang[i][j] += sdip[k][i]*x[k][j];
}
norm[i] = sqrt(SDIM_dot(etang[i],etang[i]));
if ( norm[i] > 0.0 )
for ( j = 0 ; j < SDIM ; j ++ )
etang[i][j] /= norm[i];
}
for ( i = 0 ; i < EDGE_CTRL ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < EDGE_INTERP ; k++ )
force[i][j] -= density*ssimp[i][k]*etang[k][j];
len = 0.0;
for ( i = 0 ; i < EDGE_INTERP ; i++ )
len += gauss2wt[i]*norm[i];
set_edge_length(e_id,len);
if ( web.area_norm_flag )
{ add_vertex_star(hv,len);
add_vertex_star(mv,len);
add_vertex_star(tv,len);
}
/* calculate gravitational forces */
if ( web.gravflag && !( get_eattr(e_id) & NONCONTENT) )
{ REAL z;
REAL gdensity = edge_grav_density(e_id);
if ( gdensity != 0.0 )
{ for ( i = 0 ; i < EDGE_INTERP ; i++ )
{ z = 0.0;
for ( j = 0 ; j < EDGE_CTRL ; j++ )
z += gcombo[j][i]*x[j][1];
for ( j = 0 ; j < EDGE_CTRL ; j++ )
{ force[j][1] -= -gdensity*z*etang[i][0]*gcombo[j][i];
force[j][0] -= -0.5*gdensity*z*z*sdip[j][i];
}
}
}
}
}
/************************************************************************
*
* Returns energy due to one edge.
*
* Quadratic version.
*/
void edge_energy_q(e_id)
edge_id e_id;
{
REAL *x[EDGE_CTRL];
REAL etang[MAXCOORD];
vertex_id v[EDGE_CTRL];
REAL len;
int i,j,k;
REAL z;
REAL density = edge_grav_density(e_id);
REAL torusx[MAXCOORD]; /* for unwrapping head in torus */
v[0] = get_edge_tailv(e_id);
v[1] = get_edge_midv(e_id);
v[2] = get_edge_headv(e_id);
for ( i = 0 ; i < EDGE_CTRL ; i++ )
x[i] = get_coord(v[i]);
if ( web.torus_flag )
{ /* unwrap head */
(*sym_wrap)(x[2],torusx,get_edge_wrap(e_id));
x[2] = torusx;
}
/* calculate tangents at integration points and accumulate */
len = 0.0;
for ( i = 0 ; i < EDGE_INTERP ; i++ )
{ for ( j = 0 ; j < SDIM ; j ++ )
{ etang[j] = 0.0;
for ( k = 0 ; k < EDGE_CTRL ; k++ )
etang[j] += sdip[k][i]*x[k][j];
}
len += gauss2wt[i]*sqrt(SDIM_dot(etang,etang));
/* calculate gravitational energy */
if ( web.gravflag && (density != 0.0) && !(get_eattr(e_id) & NONCONTENT) )
{ for ( i = 0 ; i < EDGE_INTERP ; i++ )
{ z = 0.0;
for ( j = 0 ; j < EDGE_CTRL ; j++ )
z += gcombo[j][i]*x[j][1];
binary_tree_add(web.total_energy_addends,-0.5*density*z*z*etang[0]);
}
}
}
set_edge_length(e_id,len);
/* following three lines for area normalization option */
add_vertex_star(v[0],len);
add_vertex_star(v[1],len);
add_vertex_star(v[2],len);
binary_tree_add(web.total_energy_addends,len*get_edge_density(e_id));
if ( web.representation == STRING ) /* don't count triple junction as area */
web.total_area += len;
}
/**********************************************************************
*
* Adds contribution of edge to areas of neighboring facets, via
* Green's theorem. x-y plane only.
*
*/
void edge_area_q(fe_id)
facetedge_id fe_id;
{
body_id b_id1,b_id2;
facet_id f_id1,f_id2;
REAL *x[EDGE_CTRL];
REAL area = 0.0;
vertex_id v[EDGE_CTRL];
int i,j;
edge_id e_id = get_fe_edge(fe_id);
if ( get_eattr(e_id) & NONCONTENT ) return;
/* be sure have original orientation of edge so torus midpoints
have same wrap as tail */
if ( inverted(e_id) )
{ invert(e_id); invert(fe_id); }
f_id1 = get_fe_facet(fe_id);
f_id2 = facet_inverse(get_fe_facet(fe_id));
if ( !valid_id(f_id1) && !valid_id(f_id2) ) return; /* no facets */
b_id1 = get_facet_body(f_id1);
b_id2 = get_facet_body(f_id2);
v[0] = get_edge_tailv(e_id);
v[1] = get_edge_midv(e_id);
v[2] = get_edge_headv(e_id);
for ( i = 0 ; i < EDGE_CTRL ; i++ )
x[i] = get_coord(v[i]);
if ( web.torus_flag )
{ MAT2D(u,EDGE_CTRL,MAXCOORD);
int wy; /* wraps */
WRAPTYPE wrap = get_edge_wrap(e_id);
mat_mul_tr(x,web.inverse_periods,u,EDGE_CTRL,SDIM,SDIM);
for ( i = 0 ; i < EDGE_CTRL ; i++ )
for ( j = 0 ; j < EDGE_CTRL ; j ++ )
area += scoeff[i][j]*u[i][1]*u[j][0];
wy = WRAPNUM((wrap>>TWRAPBITS) & WRAPMASK);
area += wy*u[2][0];
area *= web.torusv;
}
else
for ( i = 0 ; i < EDGE_CTRL ; i++ )
for ( j = 0 ; j < EDGE_CTRL ; j ++ )
area += scoeff[i][j]*x[i][1]*x[j][0];
/* add to body areas */
if ( valid_id(f_id1 ) )
add_facet_area(f_id1, area);
if ( valid_id(b_id1 ) )
add_body_volume(b_id1, area);
if ( valid_id(b_id2 ) )
add_body_volume(b_id2, -area);
}
/*****************************************************************
*
* Function: string_grad_q()
*
* Purpose: Calculate area gradients at vertices.
*/
void string_grad_q()
{
body_id bi_id; /* identifier for body i */
body_id bj_id; /* identifier for body j */
facetedge_id fe_id;
REAL *x[EDGE_CTRL];
int i,j,k;
vertex_id v[EDGE_CTRL];
volgrad *vgptr;
MAT2D(u,EDGE_CTRL,MAXCOORD); /* affine coordinates of vertices */
MAT2D(g,EDGE_CTRL,MAXCOORD);
MAT2D(grad,EDGE_CTRL,MAXCOORD);
int wrap,wrapnum;
FOR_ALL_FACETEDGES(fe_id)
{
edge_id e_id = get_fe_edge(fe_id);
if ( get_eattr(e_id) & NONCONTENT ) continue;
/* be sure have original orientation of edge so torus midpoints
have same wrap as tail */
if ( inverted(e_id) )
{ invert(e_id); invert(fe_id); }
bi_id = get_facet_body(get_fe_facet(fe_id));
bj_id = get_facet_body(get_fe_facet(get_next_facet(fe_inverse(fe_id))));
if ( !(valid_id(bi_id) && (get_battr(bi_id) & (FIXEDVOL|PRESSURE)))
&& !(valid_id(bj_id) && (get_battr(bj_id) & (FIXEDVOL|PRESSURE))) )
continue;
v[0] = get_fe_tailv(fe_id);
v[1] = get_fe_midv(fe_id);
v[2] = get_fe_headv(fe_id);
for ( i = 0 ; i < EDGE_CTRL ; i++ )
x[i] = get_coord(v[i]);
if ( web.torus_flag )
{ /* get affine coordinates of vertices */
mat_mul_tr(x,web.inverse_periods,u,edge_ctrl,SDIM,SDIM);
/* main integral over edge */
for ( i = 0 ; i < EDGE_CTRL ; i++ )
for ( j = 0 ; j < EDGE_CTRL ; j++ )
{ REAL v = scoeff[j][i];
if ( v == 0.0 ) continue;
g[i][0] += v*u[j][1];
g[j][1] += v*u[i][0];
}
/* wrap correction */
wrap = (get_edge_wrap(e_id)>>TWRAPBITS) & WRAPMASK;
wrapnum = WRAPNUM(wrap);
g[2][0] += wrapnum;
for ( k = 0 ; k < EDGE_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
g[k][j] *= web.torusv;
mat_mult(g,web.inverse_periods,grad,EDGE_CTRL,SDIM,SDIM);
}
else
{ for ( i = 0 ; i < EDGE_CTRL ; i++ )
{ grad[i][0] = grad[i][1] = 0.0;
for ( k = 0 ; k < EDGE_CTRL ; k++ )
{ grad[i][0] += scoeff[k][i]*x[k][1];
grad[i][1] += scoeff[i][k]*x[k][0];
}
}
}
if ( valid_id(bi_id) && (get_battr(bi_id) & (FIXEDVOL|PRESSURE)) )
{ for ( i = 0 ; i < EDGE_CTRL ; i++ )
{ vgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),v[i]);
vgptr->bb_id = bi_id;
vgptr->grad[0] += grad[i][0];
vgptr->grad[1] += grad[i][1];
}
}
if ( valid_id(bj_id) && !equal_id(bj_id,bi_id) &&
(get_battr(bj_id) & (FIXEDVOL|PRESSURE)) )
{ for ( i = 0 ; i < EDGE_CTRL ; i++ )
{
vgptr = get_bv_new_vgrad(get_body_fixnum(bj_id),v[i]);
vgptr->bb_id = bj_id;
vgptr->grad[0] -= grad[i][0];
vgptr->grad[1] -= grad[i][1];
}
}
}
}
evolver-2.30c.dfsg/src/lexinit2.c 0000644 0001753 0001753 00000317620 11410765113 017130 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: lexinit2.c
*
* Purpose: Routines used by initialize() in lexinit.c
* Split because lexinit.c got too big for Mac
*
*/
#include "include.h"
#include "lex.h"
#include "ytab.h"
#define yylex() kb_yylex(NULL)
/*********************************************************************
*
* function: torus_period_init()
*
* purpose: set up torus period arrays.
*/
void torus_period_init()
{ int i;
if ( web.torus_period ) return;
web.torus_period = dmatrix(0,SDIM-1,0,SDIM-1);
web.inverse_periods = dmatrix(0,SDIM-1,0,SDIM-1);
set_torus_periods_global();
set_inverse_periods_global();
for ( i = 0 ; i < SDIM ; i++ )
web.torus_period[i][i] = web.inverse_periods[i][i] = 1.0;
web.torusv = 1.0;
}
/*********************************************************************
*
* function: torus_display_period_init()
*
* purpose: set up torus period arrays.
*/
void torus_display_period_init()
{ int i;
if ( web.torus_display_period ) return;
web.torus_display_period = dmatrix(0,SDIM-1,0,SDIM-1);
web.inverse_display_periods = dmatrix(0,SDIM-1,0,SDIM-1);
for ( i = 0 ; i < SDIM ; i++ )
web.torus_display_period[i][i] = web.inverse_display_periods[i][i] = 1.0;
}
/****************************************************************
*
* Function: read_periods()
*
* Purpose: Reads torus periods.
*/
void read_periods()
{
int i,j;
torus_period_init();
/* read in torus periods */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ int esize;
esize = exparse(0,&torus_period_expr[i][j],USERCOPY);
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad torus_period[%d][%d] definition. Check space dimension\n",
i+1,j+1);
kb_error(3903,errmsg,DATAFILE_ERROR);
return;
}
sprintf(torus_period_expr[i][j].name,"torus period [%d][%d]",i,j);
}
calc_periods(ADJUST_VOLUMES);
}
/****************************************************************
*
* Function: read_display_periods()
*
* Purpose: Reads torus periods for display.
*/
void read_display_periods()
{
int i,j;
torus_display_period_init();
/* read in display periods */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ int esize;
esize = exparse(0,&torus_display_period_expr[i][j],USERCOPY);
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad display_period[%d][%d] definition. Check space dimension\n",
i+1,j+1);
kb_error(1670,errmsg,DATAFILE_ERROR);
return;
}
sprintf(torus_display_period_expr[i][j].name,"display period [%d][%d]",i,j);
}
calc_periods(ADJUST_VOLUMES);
}
/****************************************************************
*
* Function: read_parameter()
*
* Purpose: Reads one adjustable parameter.
*/
void read_parameter()
{
int n=0;
struct global *p;
int oldtok = tok; /* whether variable */
tok = yylex(); /* dispose of PARAMETER */
if ( tok == IDENT_ )
{ p = globals(yylval.i);
if ( !(p->flags & LEFTOVER) && !addload_flag )
{ sprintf(errmsg,"Redefinition of identifier '%s'.\n",yytext);
kb_error(1671,errmsg,DATAFILE_ERROR);
}
p->flags &= ~LEFTOVER;
}
else
{ if ( tok != NEWIDENT_ )
{ kb_error(1672,"Need PARAMETER identifier.\n",WARNING);
return;
}
if ( strlen(yytext) < 2 )
kb_error(1480,"Identifiers must be at least two characters long.\n",
DATAFILE_ERROR);
n = add_global(yytext);
if ( n < 0 )
kb_error(1350,"Duplicate parameter name.\n",DATAFILE_ERROR);
p = globals(n);
}
p->value.real = 0.0; /* default */
p->type = REAL_TYPE;
p->flags |= ORDINARY_PARAM;
p->attr.varstuff.delta = OPTPARAM_DELTA;
p->attr.varstuff.pscale = 1.0;
if ( oldtok == OPTIMIZING_PARAMETER_ )
{ p->flags |= OPTIMIZING_PARAMETER;
if ( optparamcount >= MAXOPTPARAM-1 )
kb_error(1674,"Too many optimizing parameters. Change MAXOPTPARAM in extern.h if you really need more.\n",DATAFILE_ERROR);
else optparam[optparamcount++].pnum = n;
}
tok = yylex(); /* dispose of IDENT_ */
if ( (tok == '=') || (tok == ASSIGN_) ) /* have initial value */
{ if ( read_const(&p->value.real) < 0 )
kb_error(1351,"Need constant expression for initial value.\n",DATAFILE_ERROR);
else tok = yylex(); /* get back token exparse pushed back */
if ( tok == ';' ){ verb_flag = 0; tok = yylex(); /* permit ; */ }
}
else if ( tok == PARAMETER_FILE_ )
{
tok = yylex();
if ( tok == QUOTATION_ )
{ FILE *pfd = path_open(yytext,NOTDATAFILENAME);
int k;
REAL val;
if ( pfd == NULL )
{
sprintf(errmsg, "Cannot open parameter file %s.\n",yytext);
kb_error(1356,errmsg, DATAFILE_ERROR);
return;
}
p->value.file.value_file = mycalloc(strlen(yytext)+1,1);
strcpy(p->value.file.value_file,yytext);
p->value.file.values = (REAL *)mycalloc(1000,sizeof(REAL));
while ( fgets(msg,msgmax,pfd) )
{
#ifdef LONGDOUBLE
sscanf(msg,"%d %Lf",&k,&val);
#else
sscanf(msg,"%d %lf",&k,&val);
#endif
if ( k >= 1000 )
{ kb_error(1677,"Too high element number in parameter file.\n",WARNING);
break;
}
p->value.file.values[k] = val;
}
fclose(pfd);
p->flags |= FILE_VALUES;
tok = yylex();
}
else
kb_error(1678,"Parameter file name missing.\n",DATAFILE_ERROR);
}
else
{ unput_tok();
if ( read_const(&p->value.real) >= 0 )
kb_error(2672,"Missing '=' after parameter name.\n",WARNING);
tok = yylex(); /* get back token exparse pushed back */
if ( tok == ';' ){ verb_flag = 0; tok = yylex(); /* permit ; */ }
}
for (;;)
{
if ( (tok == DELTA_) || ( stricmp(yytext,"delta") == 0) )
{ tok = yylex(); /* dispose of IDENT_ */
if ( (tok == '=') || (tok == ASSIGN_) ) /* have initial value */
{ if ( read_const(&p->attr.varstuff.delta) < 0 )
kb_error(1675,"Need constant expression for delta.\n",DATAFILE_ERROR);
else tok = yylex(); /* get back token exparse pushed back */
}
}
else if ( tok == SCALE_ )
{ tok = yylex(); /* dispose of IDENT_ */
if ( (tok == '=') || (tok == ASSIGN_) ) /* have initial value */
{ if ( read_const(&p->attr.varstuff.pscale) < 0 )
kb_error(1676,"Need constant expression for scale.\n",DATAFILE_ERROR);
else tok = yylex(); /* get back token exparse pushed back */
}
}
else break;
}
recovery_flag = 0;
}
/*************************************************************************
*
* Reads and parses information for one free boundary specification.
* Current line starts with BOUNDARY keyword.
* Returns boundary number, or -1 in case of early error.
*/
int read_boundary()
{
int bnum=0; /* boundary number */
int pcount; /* number of parameters */
int i,k;
int esize;
struct boundary *bdry;
if ( V_BOUNDARY_ATTR == 0 )
{ int one = 1;
V_BOUNDARY_ATTR =
add_attribute(VERTEX,"__v_boundary",INTEGER_TYPE,0,&one,0,NULL);
E_BOUNDARY_ATTR =
add_attribute(EDGE,"__e_boundary",INTEGER_TYPE,0,&one,0,NULL);
F_BOUNDARY_ATTR =
add_attribute(FACET,"__f_boundary",INTEGER_TYPE,0,&one,0,NULL);
}
tok = yylex(); /* eat BOUNDARY token */
if ( (tok != INTEGER_) && (tok != NEWIDENT_) && (tok != BOUNDARY_NAME_) )
{ kb_error(1679,"Need boundary number or name.\n",DATAFILE_ERROR);
return -1;
}
if ( tok == INTEGER_ )
{ bnum = yylval.i; /* boundary number */
if ( bnum < 0 )
{ sprintf(errmsg,"Bad boundary number: %d.\n",bnum);
kb_error(1680,errmsg,DATAFILE_ERROR);
tok = yylex();
return -1;
}
if ( bnum >= web.bdrymax )
{ web.boundaries = (struct boundary *)kb_realloc((char*)web.boundaries,
(bnum+10)*sizeof(struct boundary));
web.bdrymax = bnum+10;
}
if ( bnum > web.highbdry )
web.highbdry = bnum;
if ( web.boundaries[bnum].attr & IN_USE )
{ int moved_flag = 0;
if ( web.boundaries[bnum].attr & NAMED_THING )
/* move named boundary */
do
{ for ( i = 0 ; i < web.bdrymax ; i++ )
if ( !(web.boundaries[i].attr & IN_USE) )
{ web.boundaries[i] = web.boundaries[bnum];
web.boundaries[i].num = i;
k = lookup_global(web.boundaries[i].name);
globals(k)->value.bnum = i;
if ( i > web.highbdry )
web.highbdry = i;
moved_flag = 1;
break;
}
if ( i >= web.bdrymax )
{ web.boundaries = (struct boundary *)kb_realloc((char*)web.boundaries,
(web.bdrymax+10)*sizeof(struct boundary));
web.bdrymax = web.bdrymax+10;
}
} while ( !moved_flag );
else if ( !(web.boundaries[bnum].attr & BDRY_FORWARD_DEF) && !addload_flag)
{ sprintf(errmsg,"Boundary number %d already defined.\n",bnum);
kb_error(2120,errmsg,DATAFILE_ERROR);
tok = yylex();
return -1;
}
}
}
else /* name */
{
for ( i = 0 ; i < web.bdrymax ; i++ )
{
if ( !(web.boundaries[i].attr & IN_USE) )
{ bnum = i; break; }
if ( stricmp(yytext,web.boundaries[i].name) == 0 )
{ if ( (datafile_flag == IN_DATAFILE) && !addload_flag
&& !(web.boundaries[i].attr & BDRY_FORWARD_DEF))
{ sprintf(errmsg,"Boundary name %s already used.\n",yytext);
kb_error(2121,errmsg,DATAFILE_ERROR);
tok = yylex();
return -1;
}
else
{ bnum = i;
break;
}
}
}
if ( i > web.highbdry )
web.highbdry = i;
if ( i >= web.bdrymax )
{ web.boundaries = (struct boundary *)kb_realloc((char*)web.boundaries,
(web.bdrymax+10)*sizeof(struct boundary));
web.bdrymax = web.bdrymax+10;
bnum = i;
}
if ( tok == NEWIDENT_ )
{ k = add_global(yytext);
globals(k)->flags |= BOUNDARY_NAME;
globals(k)->value.bnum = bnum;
}
}
bdry = web.boundaries + bnum;
memset((char*)bdry,0,sizeof(struct boundary));
bdry->num = bnum;
bdry->attr |= IN_USE;
if ( tok == INTEGER_ )
sprintf(web.boundaries[bnum].name,"%d",bnum);
else
{ strncpy(bdry->name,yytext,BDRYNAMESIZE-1);
bdry->attr |= NAMED_THING;
}
tok = yylex();
if ( tok == ';' )
{ bdry->attr |= BDRY_FORWARD_DEF;
verb_flag = 0; /* set by ';' */
tok = yylex();
return bnum;
}
if ( tok != PARAMETERS_ )
{ sprintf(errmsg,"Expecting PARAMETERS keyword for boundary %s.\n",bdry->name);
kb_error(1683,errmsg,DATAFILE_ERROR);
pcount = bdry->pcount = 1;
/* try to continue */
}
else
{ tok = gettok(INTEGER_);
bdry->pcount = pcount = yylval.i;
}
if ( pcount > web.maxparam ) web.maxparam = pcount;
if ( (pcount < 0) || (tok != INTEGER_) )
{ sprintf(errmsg,"Bad parameter count %d for boundary %s. Assuming 1.\n",
pcount,bdry->name);
kb_error(1684,errmsg,DATAFILE_ERROR);
pcount = bdry->pcount = 1; /* try to continue */
}
if ( pcount > MAXPARAM )
{ sprintf(errmsg,
"Parameter count for boundary %s exceeds %d. Assuming %d.\n",
bdry->name,MAXPARAM,MAXPARAM);
kb_error(1685,errmsg,DATAFILE_ERROR);
bdry->pcount = pcount = MAXPARAM; /* try to continue */
}
tok = yylex();
for (;;)
switch (tok )
{ case CONVEX_:
web.convex_flag = 1;
bdry->attr |= B_CONVEX;
tok = yylex();
break;
case CONTENT_RANK_:
{ REAL rank;
if ( read_const(&rank) < 0 )
kb_error(3467,"Need integer value for content_rank.\n",
DATAFILE_ERROR);
bdry->content_rank = (int)rank;
tok = yylex(); /* lookahead */
break;
}
case NONWALL_:
bdry->attr |= NONWALL;
tok = yylex();
break;
case PARTNER_HITTING_:
bdry->attr |= PARTNER_HITTING;
tok = yylex();
break;
default: goto read_coord_funcs;
}
read_coord_funcs:
/* read and parse coordinate functions */
bdry->coordf[0] = (struct expnode *)mycalloc(SDIM+2*MAXCOORD,
sizeof(struct expnode));
for ( i = 1 ; i < SDIM ; i++ )
bdry->coordf[i] = bdry->coordf[0] + i;
for ( i = 0 ; i < SDIM ; i++ )
{
if ( (tok != COORD_ ) || ( yylval.i != 1 + i ))
{ sprintf(errmsg,
"Bad coordinate %d definition for boundary %s.\n",i+1,bdry->name);
goto berr;
}
boundary_expr_flag = 1;
esize = exparse(pcount,bdry->coordf[i],USERCOPY);
boundary_expr_flag = 0;
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad coordinate %d definition for boundary %s.\n",i+1,bdry->name);
goto berr;
}
sprintf(msg,"boundary %s component %d",bdry->name,i+1);
strncpy(bdry->coordf[i]->name,msg,EXPNAMESIZE-1);
}
/* various integrands */
for ( i = 0 ; i < MAXCOORD ; i++ )
{ bdry->envect[i] = bdry->coordf[0] + SDIM + i;
bdry->convect[i] = bdry->coordf[0] + SDIM + MAXCOORD + i;
}
for (;;)
switch ( tok )
{
case ENERGY_:
/* read and parse energy function */
tok = yylex();
for ( i = 0 ; i < MAXCOORD ; i++ )
{
if ( (tolower(yytext[0]) != 'e') || (yytext[1] != '1' + i) )
break;
esize = exparse(SDIM,bdry->envect[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad energy component %d definition for boundary %s.\n",
i+1,bdry->name);
kb_error(1367,errmsg,DATAFILE_ERROR);
return bnum;
}
sprintf(msg,"boundary %s energy component %d",bdry->name,i+1);
strncpy(bdry->envect[i]->name,msg,EXPNAMESIZE-1);
}
if ( i == 0 )
{ sprintf(errmsg,"Missing energy components for boundary %s\n",
bdry->name);
kb_error(5932,errmsg,DATAFILE_ERROR);
}
bdry->compcount = i;
bdry->attr |= CON_ENERGY;
break;
case CONTENT_:
/* read and parse content vector potential */
tok = yylex();
bdry->attr |= CON_CONTENT;
for ( i = 0 ; i < SDIM ; i++ )
{
if ( (tolower(yytext[0]) != 'c') || (yytext[1] != '1' + i) )
break;
esize = exparse(SDIM,bdry->convect[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad content component %d definition for boundary %s.\n",
i+1,bdry->name);
kb_error(1378,errmsg,DATAFILE_ERROR);
return bnum;
}
sprintf(msg, "boundary %s content component %d", bdry->name,i+1);
strncpy(bdry->convect[i]->name,msg,EXPNAMESIZE-1);
}
/* check consistency of number of components */
if ( bdry->compcount )
{ if ( bdry->compcount != i )
kb_error(1381,
"Inconsistent number of components in content integrand.\n",
WARNING);
}
else
{ if ( (i != 1) && (i != SDIM) )
kb_error(1449,"Illegal number of components in content integrand.\n",
DATAFILE_ERROR);
bdry->compcount = i;
}
bdry->attr |= CON_CONTENT;
break;
default: return bnum;
} /* end switch for integrands */
berr:
kb_error(1686,errmsg,DATAFILE_ERROR);
return bnum;
} /* end read_boundary() */
/*************************************************************************
*
* Reads and parses information for one free constraint specification.
* Current line starts with constraint keyword.
* Returns constraint number.
*/
int read_constraint()
{
int cnum=0; /* constraint number */
int i,k;
int esize;
int more_attr;
struct constraint *con;
int done_flag;
tok = yylex(); /* eat CONSTRAINT */
if ( (tok != INTEGER_) && (tok != NEWIDENT_) && ( tok != CONSTRAINT_NAME_) )
{ kb_error(1687,"Need constraint number or name.\n",DATAFILE_ERROR);
return -1;
}
if ( tok == INTEGER_ )
{ cnum = yylval.i; /* constraint number */
if ( cnum < 0 )
{ kb_error(1688,"Constraint number must be positive.\n",DATAFILE_ERROR);
tok = yylex();
return -1;
}
while ( cnum >= web.maxcon )
{ int newcons = web.maxcon ? 2*web.maxcon : 16;
web.constraints = (struct constraint *) kb_realloc((char*)web.constraints,
newcons*sizeof(struct constraint));
web.maxcon = newcons;
}
if ( cnum > web.highcon )
web.highcon = cnum;
con = get_constraint(cnum);
if ( con->attr & IN_USE )
{ int moved_flag = 0;
if ( con->attr & NAMED_THING )
do
{ /* Oops. Move the named constraint */
for ( i = 0 ; i < web.maxcon ; i++ )
{ struct constraint *c = get_constraint(i);
if ( !(c->attr & IN_USE) )
{ struct global *g;
*c = *con;
k = lookup_global(c->name);
g = globals(k);
g->value.cnum = i;
moved_flag = 1;
if ( i > web.highcon )
web.highcon = i;
break;
}
}
if ( i >= web.maxcon )
{ int newcons = 2*web.maxcon;
web.constraints =
(struct constraint *) kb_realloc((char*)web.constraints,
newcons*sizeof(struct constraint));
web.maxcon = newcons;
con = get_constraint(cnum);
}
} while ( !moved_flag );
else if ( datafile_flag & !(con->attr & CON_FORWARD_DEF)
& !addload_flag )
{ sprintf(errmsg,"Constraint number %d already defined.\n",cnum);
kb_error(1690,errmsg,DATAFILE_ERROR);
tok = yylex();
return -1;
}
else
con->attr &= ~CON_FORWARD_DEF;
}
}
else /* named constraint */
{
for ( i = 0 ; i < web.maxcon ; i++ )
{ con = get_constraint(i);
if ( !(con->attr & IN_USE) )
{ cnum = i; break; }
if ( stricmp(yytext,get_constraint(i)->name) == 0 )
{ if ( datafile_flag == IN_DATAFILE && !(con->attr & CON_FORWARD_DEF)
&& !addload_flag )
{ sprintf(errmsg,"Constraint name %s already used.\n",yytext);
kb_error(2122,errmsg,DATAFILE_ERROR);
tok = yylex();
return -1;
}
else
{ cnum = i;
con->attr &= ~CON_FORWARD_DEF;
break;
}
}
}
if ( i >= web.maxcon )
{ int newcons = web.maxcon ? 2*web.maxcon : 16;
web.constraints = (struct constraint *) kb_realloc((char*)web.constraints,
newcons*sizeof(struct constraint));
cnum = web.maxcon;
web.maxcon = newcons;
}
if ( i > web.highcon )
web.highcon = i;
if ( tok == NEWIDENT_ )
{ k = add_global(yytext);
globals(k)->flags |= CONSTRAINT_NAME;
globals(k)->value.cnum = cnum;
}
}
con = GETCONSTR(cnum);
memset((char*)con,0,sizeof(struct constraint));
if ( tok == INTEGER_ )
sprintf(con->name,"%d",cnum);
else
{ strncpy(con->name,yytext,CONNAMESIZE-1);
con->attr |= NAMED_THING;
}
con->attr |= IN_USE;
tok = yylex();
if ( tok == ';' )
{ con->attr |= CON_FORWARD_DEF;
verb_flag = 0; /* ';' sets verb_flag */
tok = yylex();
return cnum;
}
for ( more_attr = 1 ; more_attr ; )
switch ( tok )
{
case CONTENT_RANK_:
{ REAL rank;
if ( read_const(&rank) < 0 )
kb_error(3467,"Need integer value for content_rank.\n",
DATAFILE_ERROR);
con->content_rank = (int)rank;
tok = yylex(); /* lookahead */
break;
}
case CONVEX_:
web.convex_flag = 1;
con->attr |= B_CONVEX;
tok = yylex();
break;
case NONWALL_:
con->attr |= NONWALL;
tok = yylex();
break;
case NONNEGATIVE_:
web.constr_flag = 1;
con->attr |= NONNEGATIVE;
one_sided_present = 1;
tok = yylex();
break;
case NONPOSITIVE_:
web.constr_flag = 1;
con->attr |= NONPOSITIVE;
one_sided_present = 1;
tok = yylex();
break;
case GLOBAL_:
web.constr_flag = 1;
con->attr |= GLOBAL;
web.con_global_map[web.con_global_count++] = (conmap_t)cnum;
tok = yylex();
break;
default: more_attr = 0;
}
if ( one_sided_present && (raw_velocity_attr < 0) )
{ int dim = SDIM;
raw_velocity_attr = add_attribute(VERTEX,RAW_VELOCITY_ATTR_NAME,
REAL_TYPE,1,&dim,0,NULL);
}
/* read and parse defining function */
constraint_init(con);
if ( tok != FUNCTION_ )
{ sprintf(errmsg,
"Expected function definition for constraint %s.\n",con->name);
kb_error(1691,errmsg,DATAFILE_ERROR);
return cnum;
}
esize = exparse(SDIM,con->formula,USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,"Bad function definition for constraint %s.\n",con->name);
kb_error(1692,errmsg,DATAFILE_ERROR);
return cnum;
}
sprintf(msg,"constraint %s formula",con->name);
strncpy(con->formula->name,msg,EXPNAMESIZE-1);
/* various integrands */
done_flag = 0;
while ( !done_flag )
switch ( tok )
{
case ENERGY_:
/* read and parse energy function */
tok = yylex();
for ( i = 0 ; i < MAXCONCOMP ; i++ )
{
if ( (tolower(yytext[0]) != 'e') || (yytext[1] != '1' + i) )
break;
esize = exparse(SDIM,con->envect[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad energy component %d definition for constraint %s.\n",
i+1,con->name);
kb_error(1693,errmsg,DATAFILE_ERROR);
return cnum;
}
sprintf(msg,"constraint %s energy component %d",con->name,i+1);
strncpy(con->envect[i]->name,msg,EXPNAMESIZE-1);
}
if ( i == 0 )
{ sprintf(errmsg,"Missing energy components for constraint %s\n",
con->name);
kb_error(3228,errmsg,DATAFILE_ERROR);
}
con->compcount = i;
con->attr |= CON_ENERGY;
break;
case CONTENT_:
/* read and parse content vector potential */
tok = yylex();
con->attr |= CON_CONTENT;
for ( i = 0 ; i < SDIM ; i++ )
{
if ( (tolower(yytext[0]) != 'c') || (yytext[1] != '1' + i) )
break;
esize = exparse(SDIM,con->convect[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg,
"Bad content component %d definition for constraint %s.\n",
i+1,con->name);
kb_error(1694,errmsg,DATAFILE_ERROR);
return cnum;
}
sprintf(msg,"constraint %s content component %d",con->name,i+1);
strncpy(con->convect[i]->name,msg,EXPNAMESIZE-1);
}
/* check consistency of number of components */
if ( con->compcount )
{ if ( con->compcount != i )
kb_error(1695,
"Inconsistent number of components in content integrand.\n",
WARNING);
}
else
{ if ( (i != 1) && (i != SDIM) )
kb_error(1696,"Illegal number of components in content integrand.\n",
DATAFILE_ERROR);
con->compcount = i;
}
con->attr |= CON_CONTENT;
break;
default: done_flag = 1; break;
} /* end switch for integrands */
if ( everything_quantities_flag )
convert_constraint_to_quantities(cnum);
return cnum;
}
/*************************************************************************
*
* Reads and parses information for one surface energy specification.
* Current line starts with SURFACE ENERGY keyword.
* Optional GLOBAL keyword. OBSOLETE and now an error as of version 2.17.
*/
void read_surface_energy()
{
kb_error(1702,
"Numbered surface energies are obsolete. Please use named quantity.\n",
DATAFILE_ERROR);
tok = yylex();
}
/*************************************************************************
*
* function: read_method_instance()
*
* purpose: reads information for definition of one method instance.
* return: instance number
*/
int read_method_instance()
{ char mname[40];
int mi = -1;
tok = yylex(); /* name */
if ( tok != NEWIDENT_ && tok != METHOD_NAME_ )
{ kb_error(1708,"Need instance name.\n",DATAFILE_ERROR); return -1; }
if ( tok == METHOD_NAME_ )
{ mi = yylval.i; /* redefinition or was forward */
}
strncpy(mname,yytext,sizeof(mname));
tok = yylex();
if ( tok == ';' ) /* forward definition */
{ verb_flag = 0;
tok = yylex();
mi = new_method_instance(NULL,mname);
METH_INSTANCE(mi)->flags |= Q_FORWARD_DEF;
return mi;
}
if ( tok != METHOD_ )
{ kb_error(1709,"Missing METHOD keyword.\n",DATAFILE_ERROR); return -1; }
tok = yylex();
if ( tok != NEWIDENT_ && tok != MEAN_CURV_INT_ /* kludge */)
{ kb_error(1710,"Need method name.\n",DATAFILE_ERROR); return -1; }
mi = new_method_instance(yytext,mname);
tok = yylex();
if ( mi >= 0 )
read_instance_attr(mi);
METH_INSTANCE(mi)->flags &= ~Q_FORWARD_DEF;
return mi;
}
/*************************************************************************
*
* function: read_instance_attr()
*
* purpose: Read attributes of method instance, whether in method_instance
* definition or part of quantity definition.
*/
void read_instance_attr(mnum)
int mnum; /* number of method instance */
{
int bflag;
int spec_flag = 0;
int esize,i;
struct gen_quant_method *gm;
int comps,etype;
REAL val;
int expr_count = 0;
gm = basic_gen_methods + METH_INSTANCE(mnum)->gen_method;
/* read further attributes of instance */
for (bflag=0;bflag==0;)
switch ( tok )
{ case GLOBAL_:
if ( !(METH_INSTANCE(mnum)->flags & GLOBAL_INST) )
apply_method_num(NULLID,mnum);
tok = yylex();
break;
case MODULUS_:
if ( read_const(&(METH_INSTANCE(mnum)->modulus)) <= 0 )
kb_error(1711,"Missing modulus.\n",WARNING);
else tok = yylex();
break;
case ELEMENT_MODULUS_:
tok = yylex();
if ( tok != EXTRA_ATTRIBUTE_ )
kb_error(2123,"Need extra attribute name after ELEMENT_MODULUS.\n",
DATAFILE_ERROR);
METH_INSTANCE(mnum)->elmodulus = find_extra(idname,&etype);
if ( etype != METH_INSTANCE(mnum)->type )
kb_error(2124,"Extra attribute is for wrong type of element.\n",RECOVERABLE);
if ( EXTRAS(etype)[METH_INSTANCE(mnum)->elmodulus].type != REAL_TYPE )
kb_error(2125,"Element modulus attribute type must be REAL.\n",
DATAFILE_ERROR);
METH_INSTANCE(mnum)->flags |= ELEMENT_MODULUS_FLAG;
tok = yylex();
break;
case IGNORE_FIXED_:
METH_INSTANCE(mnum)->flags |= IGNORE_FIXED;
tok = yylex();
break;
case IGNORE_CONSTRAINTS_:
METH_INSTANCE(mnum)->flags |= IGNORE_CONSTR;
sqcurve_ignore_constr = 1; /* kludge */
tok = yylex();
break;
case K_VEC_ORDER_:
if ( read_const(&val) <= 0 )
{ kb_error(1712,"Missing k_vector_order value.\n",DATAFILE_ERROR);
val = 1.;
}
else tok = yylex();
METH_INSTANCE(mnum)->vec_order = (int)val;
break;
case PARAMETER_1_:
if ( read_const(&(METH_INSTANCE(mnum)->parameter_1)) <= 0 )
kb_error(1713,"Missing parameter_1 value.\n",WARNING);
else tok = yylex();
METH_INSTANCE(mnum)->flags |= METH_PARAMETER_1;
break;
case SCALAR_INTEGRAND_:
/* read and parse integrand function */
if ( !(gm->spec_flags & SPEC_SCALAR) )
{ kb_error(1714,"No scalar integrand for this method.\n",
DATAFILE_ERROR);
/* read in anyway */
}
spec_flag |= SPEC_SCALAR;
expr_count = 1;
METH_INSTANCE(mnum)->expr[0] =
(struct expnode *)mycalloc(expr_count,sizeof(struct expnode));
if ( gm->spec_flags & SPEC_EXTRADIM )
{ esize = exparse(2*SDIM,METH_INSTANCE(mnum)->expr[0],USERCOPY);
spec_flag |= SPEC_EXTRADIM;
}
else esize = exparse(SDIM,METH_INSTANCE(mnum)->expr[0],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg, "Bad integrand definition.\n");
kb_error(1715,errmsg,DATAFILE_ERROR);
}
sprintf(msg, "%s scalar integrand", METH_INSTANCE(mnum)->name);
strncpy(METH_INSTANCE(mnum)->expr[0]->name,msg,EXPNAMESIZE-1);
break;
case VECTOR_INTEGRAND_:
/* read and parse integrand vector */
if ( !(gm->spec_flags & (SPEC_VECTOR|SPEC_KVECTOR)) )
{ kb_error(1716,"No vector integrand for this method.\n",
DATAFILE_ERROR);
comps = SDIM;
/* read vector integrand anyway to get past it */
}
if ( gm->spec_flags & SPEC_VECTOR )
{ spec_flag |= SPEC_VECTOR;
comps = SDIM;
}
else /* SPEC_KVECTOR */
{ spec_flag |= SPEC_KVECTOR;
comps = (SDIM-METH_INSTANCE(mnum)->vec_order)*SDIM;
if ( comps <= 0 )
kb_error(1717,"Need k_vector_order.\n",DATAFILE_ERROR);
}
if ( comps > MAXMEXPR )
kb_error(1718,"Total components exceeds MAXMEXPR.\n",DATAFILE_ERROR);
expr_count = comps;
METH_INSTANCE(mnum)->expr[0]=(struct expnode *)mycalloc(comps,
sizeof(struct expnode));
tok = yylex();
for ( i = 0 ; i < comps ; i++ )
{ METH_INSTANCE(mnum)->expr[i] = METH_INSTANCE(mnum)->expr[0] + i;
if ( (tolower(yytext[0]) != 'q') || (atoi(yytext+1) != 1 + i ))
{ sprintf(errmsg,"Expected component %d definition.\n",i+1);
kb_error(1719,errmsg,DATAFILE_ERROR);
break;
}
esize = exparse(SDIM,METH_INSTANCE(mnum)->expr[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg, "Bad component %d definition.\n",i+1);
kb_error(1720,errmsg,DATAFILE_ERROR);
}
sprintf(msg,"%s vector integrand component %d",
METH_INSTANCE(mnum)->name,i+1);
strncpy(METH_INSTANCE(mnum)->expr[i]->name,msg,EXPNAMESIZE-1);
}
if ( (tolower(yytext[0]) == 'q') && isdigit(yytext[1]) )
{ sprintf(errmsg,"k_vector method needs only %d (complement of order) vectors.\n",(SDIM-METH_INSTANCE(mnum)->vec_order));
kb_error(2863,errmsg,RECOVERABLE);
}
break;
case FORM_INTEGRAND_: /* 2-form */
/* read and parse integrand 2-form */
if ( !(gm->spec_flags & SPEC_2FORM) )
{ kb_error(1721,"No 2-form integrand for this method.\n",
DATAFILE_ERROR);
/* read in anyway to get past it */
}
spec_flag |= SPEC_2FORM;
comps = (SDIM*(SDIM-1))/2;
if ( comps > MAXMEXPR )
kb_error(1722,"Total components exceeds MAXMEXPR.\n",
DATAFILE_ERROR);
expr_count = comps;
METH_INSTANCE(mnum)->expr[0]=(struct expnode *)mycalloc(comps,
sizeof(struct expnode));
tok = yylex();
for ( i = 0 ; i < comps ; i++ )
{
METH_INSTANCE(mnum)->expr[i] = METH_INSTANCE(mnum)->expr[0] + i;
if ( (tolower(yytext[0]) != 'q') || (atoi(yytext+1) != 1 + i ) )
{ sprintf(errmsg,"Expected component %d definition.\n",i+1);
kb_error(1723,errmsg,DATAFILE_ERROR);
}
esize = exparse(SDIM,METH_INSTANCE(mnum)->expr[i],USERCOPY);
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg, "Bad component %d definition.\n",i+1);
kb_error(1724,errmsg,DATAFILE_ERROR);
}
sprintf(msg,"%s form integrand component %d",
METH_INSTANCE(mnum)->name,i+1);
strncpy(METH_INSTANCE(mnum)->expr[i]->name,msg,EXPNAMESIZE-1);
}
break;
default: bflag = 1; break;
}
if ( (gm->spec_flags & SPEC_SCALAR) & ~spec_flag )
kb_error(1725,"Need scalar integrand for this method.\n",DATAFILE_ERROR);
if ( (gm->spec_flags & SPEC_VECTOR) & ~spec_flag )
kb_error(1726,"Need vector integrand for this method.\n",DATAFILE_ERROR);
if ( (gm->spec_flags & SPEC_KVECTOR) & ~spec_flag )
kb_error(2862,
"Need k_vector_order and vector_integrand for this method.\n",
DATAFILE_ERROR);
/* Check use of boundary parameters */
for ( i = 0 ; i < expr_count ; i++ )
{ struct method_instance *mi = METH_INSTANCE(mnum);
if ( mi->expr[i] && (mi->expr[i]->flag & USING_PARAM_FLAG) )
{ sprintf(errmsg,
"%s: Cannot use boundary parameters in gradient or hessian.\n",
METH_INSTANCE(mnum)->name);
kb_error(3895,errmsg,WARNING);
}
}
METH_INSTANCE(mnum)->flags &= ~Q_FORWARD_DEF;
}
/*************************************************************************
*
* Reads and parses information for one quantity specification,
* in particular, facet integrands and fixed value.
* Current line starts with QUANTITY keyword.
* Optional GLOBAL keyword.
*/
int read_quantity()
{
tok = gettok(INTEGER_);
if ( tok != INTEGER_ )
{ return read_named_quantity();
}
kb_error(1727,
"Numbered quantities are obsolete. Please use named quantity.\n",
DATAFILE_ERROR);
tok = yylex();
return 0;
}
/***********************************************************************
*
* function: read_named_quantity()
*
* purpose: parse named quantity definition.
* return: quantity number.
*/
int read_named_quantity()
{
int n;
int gnum; /* quantity number */
char qname[400];
int meth;
struct method_instance *mi;
char inst_name[400];
int namecount; /* number of uninstantiated methods */
int globality;
int esize;
int lagmulflag = 0;
if ( (tok != NEWIDENT_) && (tok != IDENT_) && (tok != QUANTITY_NAME_) )
{ kb_error(1733,"Need quantity name.\n",DATAFILE_ERROR);
return -1;
}
strncpy(qname,yytext,sizeof(qname));
/* check not already defined and add to list */
tok = yylex();
if ( tok == ';' )
{ gnum = new_quantity(qname,Q_INFO);
GEN_QUANT(gnum)->flags |= Q_FORWARD_DEF;
verb_flag = 0; /* set by ';' */
tok = yylex();
return gnum;
}
if ( tok == FIXED_ )
{ gnum = new_quantity(qname,Q_FIXED);
tok = yylex(); /* eat '=' */
if ( tok != '=' )
kb_error(1734,"Missing '='\n",DATAFILE_ERROR);
if (read_const(&(GEN_QUANT(gnum)->target)) <= 0)
kb_error(1735,"Missing quantity target value. \n",DATAFILE_ERROR);
tok = yylex();
}
else if ( tok == ENERGY_ )
{ gnum = new_quantity(qname,Q_ENERGY);
tok = yylex();
}
else if ( tok == INFO_ONLY_ )
{ gnum = new_quantity(qname,Q_INFO);
tok = yylex();
}
else if ( tok == CONSERVED_ )
{ gnum = new_quantity(qname,Q_CONSERVED);
tok = yylex();
}
else
{ kb_error(1736,
"Need type of quantity: energy, fixed, conserved, or info_only.\n",
DATAFILE_ERROR);
gnum = new_quantity(qname,Q_INFO);
}
namecount = 0;
for (;;) /* further attributes */
switch ( tok )
{ case GLOBAL_METHOD_ :
case METHOD_ :
if ( GEN_QUANT(gnum)->flags & Q_COMPOUND )
kb_error(1737,
"Can't list separate methods with function of methods.\n",
DATAFILE_ERROR);
globality = tok;
tok = yylex();
/* see if instance or method */
for ( n=LOW_INST ; n < meth_inst_count ; n++ )
{ mi = METH_INSTANCE(n);
if ( stricmp(mi->name,yytext) == 0 ) break;
}
if ( n >= meth_inst_count )
{ /* need to instantiate method */
strncpy(inst_name,qname,sizeof(qname));
sprintf(inst_name+strlen(inst_name),"%d_",++namecount);
strncat(inst_name,yytext,sizeof(qname)-strlen(inst_name));
meth = new_method_instance(yytext,inst_name);
if ( meth >= 0 )
{ METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gnum,meth);
if ( globality == GLOBAL_METHOD_)
apply_method(NULLID,inst_name);
tok = yylex();
read_instance_attr(meth);
}
}
else /* predefined instance */
{ int mnum = attach_method(gnum,yytext);
if ( (globality == GLOBAL_METHOD_) && (mnum>=0) &&
!(METH_INSTANCE(mnum)->flags & GLOBAL_INST) )
apply_method(NULLID,yytext);
tok = yylex();
}
break;
case LAGRANGE_MULTIPLIER_:
if ( read_const(&(GEN_QUANT(gnum)->pressure)) <= 0 )
kb_error(2126,"Missing lagrange_multiplier value.\n",DATAFILE_ERROR);
else
{ GEN_QUANT(gnum)->flags |= Q_PRESSURE_SET;
lagmulflag = 1; tok = yylex();
}
break;
case VOLCONST_:
if (read_const(&(GEN_QUANT(gnum)->volconst)) <= 0)
kb_error(1738,"Missing quantity volconst value. \n",DATAFILE_ERROR);
else tok = yylex();
break;
case TOLERANCE_:
if ( read_const(&GEN_QUANT(gnum)->tolerance) <= 0 )
kb_error(2127,"Missing tolerance value.\n",DATAFILE_ERROR);
else tok=yylex();
if ( GEN_QUANT(gnum)->tolerance <= 0.0 )
kb_error(2128,"Tolerance must be positive.\n",DATAFILE_ERROR);
break;
case MODULUS_:
if (read_const(&(GEN_QUANT(gnum)->modulus)) <= 0)
kb_error(1739,"Missing quantity modulus value. \n",DATAFILE_ERROR);
else tok = yylex();
break;
case FUNCTION_: /* compound function of instances */
cur_quant = gnum;
if ( GEN_QUANT(cur_quant)->method_count > 0 && !addload_flag)
kb_error(1740,
"Can't list separate methods with function of methods.\n",
DATAFILE_ERROR);
reading_comp_quant_flag = 1;
esize = exparse(0,&(GEN_QUANT(gnum)->expr),USERCOPY);
reading_comp_quant_flag = 0;
cur_quant = -1 ;
tok = yylex();
if ( esize <= 0 )
{ sprintf(errmsg, "Bad function definition.\n");
kb_error(1741,errmsg,DATAFILE_ERROR);
}
sprintf(msg,"%s formula",GEN_QUANT(gnum)->name);
strncpy(GEN_QUANT(gnum)->expr.name,msg,EXPNAMESIZE-1);
GEN_QUANT(gnum)->flags |= Q_COMPOUND;
if ( gnum > compound_quant_list_head ) // avoid loop with addload
{ GEN_QUANT(gnum)->next_compound = compound_quant_list_head;
compound_quant_list_head = gnum;
}
break;
default:
goto named_exit; /* done with quantity */
}
named_exit:
if ( !lagmulflag ) pressure_set_flag = 0;
GEN_QUANT(gnum)->flags &= ~Q_FORWARD_DEF;
return gnum;
}
/*************************************************************
*
* Function: add_outside()
*
* Purpose: Adds body outside all other bodies. Used in
* dynamic pressure calculations.
*/
void add_outside()
{
return; /* temporary turn off */
#ifdef OUTSIDEBODY
body_id b_id; /* both models */
b_id = new_body();
web.outside_body = b_id;
set_attr(b_id,PRESSURE); /* since has ambient pressure */
if ( web.representation == STRING )
{ edge_id e_id;
facet_id f_id;
f_id = new_facet(); /* outside facet */
set_facet_body(f_id,b_id);
/* add to outside of every edge bordering just ONE cell */
FOR_ALL_EDGES(e_id)
{
facetedge_id new_fe;
facetedge_id fe_id;
fe_id = get_edge_fe(e_id);
if ( !valid_id(fe_id) ) continue;
if ( !equal_id(fe_id,get_next_facet(fe_id)) ) continue;
new_fe = new_facetedge(inverse_id(f_id),e_id);
set_next_facet(fe_id,new_fe);
set_prev_facet(fe_id,new_fe);
set_next_facet(new_fe,fe_id);
set_prev_facet(new_fe,fe_id);
set_facet_fe(f_id,new_fe);
}
}
else /* SOAPFILM */
{
facet_id f_id;
/* add to outside of every facet bordering just ONE cell */
FOR_ALL_FACETS(f_id)
{
body_id b1_id,b2_id;
b1_id = get_facet_body(f_id);
b2_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b1_id) == valid_id(b2_id) ) continue;
if ( valid_id(b1_id) )
set_facet_body(inverse_id(f_id),b_id);
if ( valid_id(b2_id) )
set_facet_body(f_id,b_id);
}
}
#endif
}
/*********************************************************************
*
* Function: fix_volconst()
*
* Purpose: For torus, figure out constant volume adjustments,
* figuring that given volumes are within 1/2 of a
* torus volume of their true value
*/
void fix_volconst()
{
REAL adjust;
body_id b_id;
if ( web.pressure_flag ) return;
/* get volume of piece of unit cell */
if ( SDIM == 2 )
{
adjust = web.torusv /* /2 */;
}
else /* web.representation == SOAPFILM */
{
adjust = web.torusv /* /6 */;
}
/* adjust volconsts */
FOR_ALL_BODIES(b_id)
if ( get_battr(b_id) & FIXEDVOL )
{ REAL vol = get_body_volume(b_id);
REAL fix = get_body_fixvol(b_id);
REAL vc = get_body_volconst(b_id);
REAL calcvol = vol-vc;
REAL newvc = fix - calcvol;
newvc = adjust*floor(0.5+newvc/adjust);
set_body_volconst(b_id,newvc);
set_body_volume(b_id,calcvol+newvc,SETSTAMP);
}
}
/*******************************************************************
*
* Function: fe_reorder()
*
* Purpose: Order facets properly around edge.
* NOTE: Does have body agreement override geometry, so be careful
* about body setup before entry.
*/
struct fsort { facetedge_id fe;
REAL angle;
};
static int fcompare(a,b)
struct fsort *a,*b;
{
if ( a->angle < b->angle ) return -1;
if ( a->angle > b->angle ) return 1;
return 0;
}
void fe_reorder(e_id)
edge_id e_id;
{ int fcount = 0;
facetedge_id fe;
#define FSORTMAX 100
struct fsort fe_list[FSORTMAX];
REAL side[MAXCOORD],norm_a[MAXCOORD],side_a[MAXCOORD];
REAL side_b[MAXCOORD],norm_aa[MAXCOORD],a_norm,aa_norm;
REAL c,s,angle;
int i,j,k;
facetedge_id first_fe;
int bodies_ok;
int body_order = 0; /* set if order triple line by bodies */
/* see if we have 3 or more facets */
fe = first_fe = get_edge_fe(e_id);
if ( valid_id(fe) )
do { fcount++;
fe = get_next_facet(fe);
} while ( valid_id(fe) && !equal_id(fe,first_fe) );
if ( fcount <= 2 ) return;
if ( fcount > FSORTMAX )
{ kb_error(1742,"More than 100 facets on an edge; not sorted.\n",WARNING);
return;
}
/* common case of three facets, check for body determination */
if ( fcount == 3 )
{ /* see if there is a unique order of facets */
facetedge_id fa = get_next_facet(fe);
facetedge_id fb = get_prev_facet(fe);
body_id ef = get_facet_body(get_fe_facet(fe));
body_id eb = get_facet_body(inverse_id(get_fe_facet(fe)));
body_id af = get_facet_body(get_fe_facet(fa));
body_id ab = get_facet_body(inverse_id(get_fe_facet(fa)));
body_id bf = get_facet_body(get_fe_facet(fb));
body_id bb = get_facet_body(inverse_id(get_fe_facet(fb)));
int asis = (eb==af) && (ab==bf) && (bb==ef);
int other = (eb==bf) && (bb==af) && (ab==ef);
if ( asis && !other ) body_order = 1;
else if ( other && !asis )
{ /* swap */
set_next_facet(fe,fb);
set_next_facet(fb,fa);
set_next_facet(fa,fe);
set_prev_facet(fe,fa);
set_prev_facet(fa,fb);
set_prev_facet(fb,fe);
body_order = 1;
}
/* else fall through to geometric test */
}
/* use first facet as reference facet */
/* to get basis for calculating angles */
get_edge_side(e_id,side);
fe = get_edge_fe(e_id);
fe_list[0].fe = fe;
get_fe_side(get_next_edge(fe),side_a);
cross_prod(side,side_a,norm_a);
cross_prod(norm_a,side,norm_aa);
a_norm = sqrt(SDIM_dot(norm_a,norm_a));
aa_norm = sqrt(SDIM_dot(norm_aa,norm_aa));
/* now get angles to rest of facets */
fe_list[0].angle = 0.0;
for ( i = 1 ; i < fcount ; i++ )
{ fe = get_next_facet(fe);
fe_list[i].fe = fe;
get_fe_side(get_next_edge(fe),side_b);
s = SDIM_dot(side_b,norm_a)*aa_norm;
c = SDIM_dot(side_b,norm_aa)*a_norm;
angle = atan2(s,c);
fe_list[i].angle = angle;
}
if ( body_order )
{ /* warn if not agreeing with geometric order */
if ( ((fe_list[1].angle > 0) && (fe_list[2].angle > fe_list[0].angle) &&
(fe_list[2].angle < fe_list[1].angle)) ||
(( (fe_list[1].angle < 0) && ((fe_list[2].angle > fe_list[0].angle) ||
(fe_list[2].angle < fe_list[1].angle))) )
)
{ sprintf(errmsg,
"Edge %s facets body order disagrees with geometric order.\n",
ELNAME(e_id));
kb_error(3857,errmsg,WARNING);
}
return;
}
/* sort by angle */
/* Bombed in IRIX 6 long double mode
qsort((char *)&fe_list[1],fcount-1,sizeof(struct fsort),FCAST fcompare);
*/
for ( j = 0 ; j < fcount-1 ; j++ )
for ( k = j+1 ; k < fcount ; k++ )
if ( fe_list[k].angle < fe_list[j].angle )
{ struct fsort ftemp;
ftemp = fe_list[k];
fe_list[k] = fe_list[j];
fe_list[j] = ftemp;
}
/* check consistency for facets on bodies */
bodies_ok = 1;
for ( i = 0 ; i < fcount ; i++ )
{ facet_id f1,f2;
int ii = (i == fcount-1) ? 0 : i+1;
f1 = facet_inverse(get_fe_facet(fe_list[i].fe));
f2 = get_fe_facet(fe_list[ii].fe);
if ( !equal_id(get_facet_body(f1),get_facet_body(f2)) )
{ bodies_ok = 0;
break;
}
}
if ( !bodies_ok )
{ REAL best_violation;
int k,kk,bestk;
/* try swaps of adjacent facets, and pick workable one with
least violation of angle ordering */
best_violation = 1e30;
bestk = -1;
for ( k = 0 ; k < fcount ; k++ )
{ struct fsort ftemp;
kk = (k==fcount-1) ? 0 : k+1;
ftemp = fe_list[k];
fe_list[k] = fe_list[kk];
fe_list[kk] = ftemp;
bodies_ok = 1;
for ( i = 0 ; i < fcount-1 ; i++ )
{ facet_id f1,f2;
f1 = facet_inverse(get_fe_facet(fe_list[i].fe));
f2 = get_fe_facet(fe_list[i+1].fe);
if ( !equal_id(get_facet_body(f1),get_facet_body(f2)) )
{ bodies_ok = 0;
break;
}
}
if ( bodies_ok )
{ REAL violation = fabs(fe_list[k].angle-fe_list[kk].angle);
if ( violation > M_PI )
violation = 2*M_PI - violation; /* shortest way */
if ( violation < best_violation )
{ bestk = k;
best_violation = violation;
}
}
ftemp = fe_list[kk];
fe_list[kk] = fe_list[k];
fe_list[k] = ftemp;
}
if ( bestk >= 0 )
{ struct fsort ftemp;
kk = (bestk==fcount-1) ? 0 : bestk+1;
ftemp = fe_list[bestk];
fe_list[bestk] = fe_list[kk];
fe_list[kk] = ftemp;
}
}
/* relink in proper order */
for ( i = 0 ; i < fcount ; i++ )
{ set_next_facet(fe_list[i].fe,fe_list[(i+1)%fcount].fe);
set_prev_facet(fe_list[i].fe,fe_list[(i+fcount-1)%fcount].fe);
}
}
/**************************************************************
*
* Function: gettok()
*
* Purpose: get next integer or real value, possibly
* with '-' preceding.
*/
int gettok(kind)
int kind;
{
int sign = 1;
tok = yylex();
if ( tok == ',' ) tok = yylex(); /* skip separating comma */
if ( tok == '-' ) { sign = -1; tok = yylex(); }
if ( tok == UMINUS_ ) { sign = -1; tok = yylex(); }
if ( tok != kind )
{ if ( !((tok == INTEGER_) && (kind == REAL_) ) &&
!((tok == INTEGER_AT_) && (kind == INTEGER_)) )
{ if ( sign == -1 )
kb_error(2129,"Unexpected minus sign.\n",DATAFILE_ERROR);
return tok;
}
/* caller should check for error, and if error leave tok as lookahead */
}
yylval.i *= sign;
yylval.r *= sign;
tok = kind;
return tok;
}
/*******************************************************************
*
* function: read_const()
*
* purpose: read constant expression from datafile
* and return value.
*
* input: REAL *value - address for value
*
* return: < 0 error
* 0 no expression
* > 0 valid expression
*/
int read_const(value)
REAL *value;
{
int retval;
struct expnode node; /* for getting constant expression */
memset(&node,0,sizeof(struct expnode));
const_expr_flag = 1;
if ( (retval = exparse(0,&node,NOUSERCOPY)) <= 0 )
{ const_expr_flag = 0;
return retval;
}
/* sprintf(node.name,"constant expression at line %d",line_no); */
*value = eval(&node,NULL,NULLID,NULL);
if ( node.locals )
{ if ( node.locals->list ) myfree((char*)node.locals->list );
myfree((char*)(node.locals));
}
const_expr_flag = 0;
return 1;
}
/*********************************************************************
*
* function: const_expr()
*
* purpose: get numerical value of string expresssion
*
* input: char *str - string with expression
* REAL *value - address for value
*
* return: < 0 error
* 0 no expression
* > 0 valid expression
*/
int const_expr(str,value)
char *str;
REAL *value;
{ char *old_cmdptr; /* in case in middle of another parse */
int ret; /* return value */
if ( str == NULL ) return 0;
old_cmdptr = cmdptr;
cmdptr = str;
yylex_init();
ret = read_const(value);
cmdptr = old_cmdptr;
return ret;
}
/*********************************************************************
*
* function: string_fixup()
*
* purpose: put minimal facet-edges on string net, so can
* do edge changes. all facet-edges given the null facet.
*
*/
void string_fixup()
{
edge_id e_id;
facetedge_id fe;
/* do all bare edges */
FOR_ALL_EDGES(e_id)
{
fe = get_edge_fe(e_id);
if ( valid_id(fe) ) continue;
fe = new_facetedge(NULLFACET,e_id);
set_next_facet(fe,fe);
set_prev_facet(fe,fe);
set_next_edge(fe,inverse_id(fe));
set_prev_edge(fe,inverse_id(fe));
set_edge_fe(e_id,fe);
}
}
/*******************************************************
*
* phase_initialize()
*
* Purpose: Read in phase boundary energies from file
*
* Input: Name of file with phase boundary energies
* First line has number of phases
* Succeeding lines have pair of phase numbers
* and boundary energy.
*
*/
void phase_initialize(phasename)
char *phasename;
{
FILE *pfd;
int i,j; /* which phases */
REAL value;
char line[200];
int one = 1;
phase_flag = 1;
if ( web.representation == STRING )
F_PHASE_ATTR = add_attribute(FACET,"phase",INTEGER_TYPE,0,&one,0,NULL);
else
B_PHASE_ATTR = add_attribute(BODY,"phase",INTEGER_TYPE,0,&one,0,NULL);
/* save name */
strncpy(phase_file_name,phasename,sizeof(phase_file_name));
pfd = path_open(phasename,NOTDATAFILENAME);
if ( pfd == NULL )
{ sprintf(errmsg, "Cannot open phase boundary energy file %s.\n",phasename);
kb_error(1746,errmsg, DATAFILE_ERROR);
return;
}
fscanf(pfd,"%d",&phasemax);
phase_data = dmatrix(0,phasemax,0,phasemax);
for ( i = 0 ; i <= phasemax ; i++ )
for ( j = 0 ; j <= phasemax ; j++ )
phase_data[i][j] = 1.0;
while ( fgets(line,sizeof(line),pfd) )
{
#ifdef LONGDOUBLE
if ( sscanf(line,"%d %d %Lf",&i,&j,&value) == 3 )
#else
if ( sscanf(line,"%d %d %lf",&i,&j,&value) == 3 )
#endif
{ if ( (i < 0) || (i > phasemax) || (j < 0) || (j > phasemax) )
{ sprintf(errmsg,"Bad phase numbers: %d %d\n",i,j);
kb_error(1747,errmsg,DATAFILE_ERROR);
}
phase_data[i][j] = phase_data[j][i] = value;
}
}
fclose(pfd);
}
/****************************************************************
*
* Function: read_transforms()
*
* Purpose: Reads additional view transforms.
* Works both from datafile and commandline
*/
void read_transforms(count)
int count; /* number, if known from command */
{
int i,j,n;
REAL value;
MAT2D(temp_mat,MAXCOORD+1,MAXCOORD+1);
lists_flag = 1;
if ( count > 0 ) transform_count = count+1;
else
{
/* find how many transforms */
if ( (tok = gettok(INTEGER_)) != INTEGER_ )
{ kb_error(1748,"Missing number of transforms.\n",DATAFILE_ERROR);
transform_count = 1;
}
else transform_count = yylval.i+1; /* including identity */
}
if ( view_transforms )
{ free_matrix3(view_transforms); view_transforms = NULL;}
if ( transform_count <= 0 ) return;
view_transforms = dmatrix3(transform_count,SDIM+1,SDIM+1);
set_view_transforms_global();
allocate_transform_colors(transform_count);
view_transform_det = (int*)mycalloc(transform_count,sizeof(int));
matcopy(view_transforms[0],identmat,SDIM+1,SDIM+1);
transform_colors[0] = SAME_COLOR;
view_transform_det[0] = 1;
/* read in transform matrices, in homogeneous coords */
for ( n = 1 ; n < transform_count ; n++ )
{ tok = yylex();
if ( tok == COLOR_ )
{ if ( (tok = gettok(INTEGER_)) != INTEGER_ )
kb_error(1749,"Missing transform color.\n",DATAFILE_ERROR);
transform_colors[n] = yylval.i;
transform_colors_flag = 1;
}
else if ( tok == SWAP_COLORS_ )
{ transform_colors[n] = SWAP_COLORS;
transform_colors_flag = 1;
}
else
{ transform_colors[n] = SAME_COLOR;
unput_tok();
}
for ( i = 0 ; i <= SDIM ; i++ )
{ for ( j = 0 ; j <= SDIM ; j++ )
{ if ( read_const(&value) <= 0 )
{ kb_error(1750,"Not enough values for transform matrix.\n",
DATAFILE_ERROR);
return;
}
view_transforms[n][i][j] = value;
}
matcopy(temp_mat,view_transforms[n],SDIM+1,SDIM+1);
if ( determinant(temp_mat,SDIM+1) > 0.0 )
view_transform_det[n] = 1;
else view_transform_det[n] = -1;
}
}
transforms_flag = 1; /* default is to show */
lists_flag = 0;
if ( n == transform_count ) tok = yylex(); /* lookahead */
}
/****************************************************************
*
* Function: convert_constraint_to_quantities()
*
* Purpose: Create method for constraint energy.
*/
void convert_constraint_to_quantities(i)
int i; /* number of constraint */
{ int j;
char qname[100];
char inst_name[100];
int gq;
int meth;
edge_id e_id;
struct constraint *con = get_constraint(i);
if ( !(con->attr & CON_ENERGY) ) return;
if ( con->attr & NAMED_THING )
{ sprintf(qname,"constraint_%s_energy",con->name);
sprintf(inst_name,"constraint_%s_energy_inst",con->name);
}
else
{ sprintf(qname,"constraint_%d_energy",i);
sprintf(inst_name,"constraint_%d_energy_inst",i);
}
gq = new_quantity(qname,Q_ENERGY);
GEN_QUANT(gq)->flags |= DEFAULT_QUANTITY;
if ( web.representation == STRING )
meth = new_method_instance("vertex_scalar_integral",inst_name);
else
meth = new_method_instance("edge_vector_integral",inst_name);
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gq,meth);
if ( con->attr & GLOBAL )
apply_method_num(NULLID,meth);
else
{ vertex_id v_id;
if ( web.representation == STRING )
{ FOR_ALL_VERTICES(v_id)
if ( v_on_constraint(v_id,i) )
apply_quantity(v_id,gq);
}
else
{ FOR_ALL_EDGES(e_id)
if ( e_on_constraint(e_id,i) )
apply_quantity(e_id,gq);
}
}
for ( j = 0 ; j < SDIM ; j++ )
METH_INSTANCE(meth)->expr[j] = con->envect[j];
con->attr |= USURPED_BY_QUANTITY; /* prevent dual expr deallocation */
con->energy_method = meth;
}
/****************************************************************
*
* Function: read_transform_generators()
*
* Purpose: Reads view transform generators.
* Works both from datafile and commandline
*/
void read_transform_generators(count)
int count; /* number, if known from command */
{
int i,j,n;
lists_flag = 1;
if ( count > 0 ) transform_count = count;
else
{ /* find how many transforms */
if ( (tok = gettok(INTEGER_)) != INTEGER_ )
{ kb_error(1751,"Missing number of view_transform_generators.\n",DATAFILE_ERROR);
transform_gen_count = 1;
}
else transform_gen_count = yylval.i;
}
if ( transform_gen_count < 0 )
{ kb_error(3900,"Missing number of view_transform_generators.\n",DATAFILE_ERROR);
transform_gen_count = 0;
}
if ( transform_gen_swap ) myfree((char*)transform_gen_swap);
transform_gen_swap = (int*)mycalloc(transform_gen_count+SDIM,sizeof(int));
view_transform_gens = dmatrix3(web.torus_flag?(transform_gen_count+SDIM):
transform_gen_count,SDIM+1,SDIM+1);
view_transform_gens_expr =
(expnodearray *)mycalloc((MAXCOORD+1)*(MAXCOORD+1)*transform_gen_count,
sizeof(struct expnode));
/* read in transform matrices, in homogeneous coords */
for ( n = 0 ; n < transform_gen_count ; n++ )
{ tok = yylex();
if ( tok == SWAP_COLORS_ )
{ transform_gen_swap[n] = 1;
}
else unput_tok();
for ( i = 0 ; i <= SDIM ; i++ )
{ for ( j = 0 ; j <= SDIM ; j++ )
{ int esize = exparse(0,&view_transform_gens_expr[n][i][j],USERCOPY);
if ( esize < 0 )
{ kb_error(1752,"Not enough entries for transform generator matrix.\n",
DATAFILE_ERROR);
return;
}
}
}
}
if ( n == transform_gen_count ) tok = yylex(); /* lookahead */
if ( web.torus_flag ) transform_gen_count += SDIM;
transforms_flag = 1; /* default is to show */
lists_flag = 0;
}
/***************************************************************************
*
* function: convert_to_quantities()
*
* purpose: convert numbered quantities, surface energies, and
* constraint integrals to named quantities.
* Used in everything_quantities mode.
*/
void convert_to_quantities()
{
int gq;
int meth;
char inst_name[40];
char qname[100];
int i,j;
body_id b_id;
edge_id e_id;
int q;
char formula[1000];
char *gformula;
if ( everything_quantities_flag ) return;
if ( web.wulff_flag && (web.dimension != 2) )
kb_error(1754,"Can't do wulff energy method for strings yet.\n",RECOVERABLE);
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ mpi_convert_to_quantities();
outstring("Converting to all named quantities...");
}
#else
outstring("Converting to all named quantities...");
#endif
/* set up default length or area quantities */
if ( web.representation == STRING )
{ q = new_quantity("default_length",Q_ENERGY);
default_area_quant_num = q;
}
else q = new_quantity("default_length",Q_INFO);
GEN_QUANT(q)->flags |= DEFAULT_QUANTITY;
if ( length_method_name[0] )
{ meth = find_method_instance(length_method_name); /* user instance? */
if ( meth < 0 ) /* try pre-defined method */
meth = new_method_instance(length_method_name,"default_length_inst");
}
else if ( web.dimension >= 3 )
{ /* can't do edges in simplex model */
meth = -1;
}
else if ( klein_metric_flag )
{ meth = new_method_instance("klein_length","default_length_inst");
}
else if ( web.conformal_flag )
{ int oldflag = datafile_flag;
meth = new_method_instance("edge_scalar_integral","default_length_inst");
strcpy(formula,"density*sqrt(");
gformula = print_express(&web.metric[0][0],'X');
if ( strlen(gformula) > sizeof(formula)-20 )
kb_error(1755,"Conformal metric formula too long.\n",RECOVERABLE);
strcat(formula,gformula);
strcat(formula,")");
METH_INSTANCE(meth)->expr[0] =
(struct expnode *)mycalloc(1,sizeof(struct expnode));
cmdptr = formula;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth)->expr[0],USERCOPY);
sprintf(METH_INSTANCE(meth)->expr[0]->name,"conformal metric");
cmdptr = NULL; datafile_flag = oldflag;
}
else if ( web.metric_flag )
{ int oldflag = datafile_flag;
meth = new_method_instance("edge_general_integral","default_length_inst");
strcpy(formula,"density*sqrt(");
for ( i = 1 ; i <= SDIM ; i++ )
for ( j = 1 ; j <= i ; j++ )
{ if ( i > 1 ) strcat(formula,"+");
if ( i==j ) sprintf(formula+strlen(formula),"X%d^2*(",i+SDIM);
else sprintf(formula+strlen(formula),"2*X%d*X%d*(",i+SDIM,j+SDIM);
gformula = print_express(&web.metric[i-1][j-1],'X');
if ( strlen(gformula) > sizeof(formula)-20 )
kb_error(1756,"Metric formula too long.\n",RECOVERABLE);
strcat(formula,gformula);
strcat(formula,")");
}
strcat(formula,")");
METH_INSTANCE(meth)->expr[0] =
(struct expnode *)mycalloc(1,sizeof(struct expnode));
cmdptr = formula;
datafile_flag = 1;
exparse(2*SDIM,METH_INSTANCE(meth)->expr[0],USERCOPY);
sprintf(METH_INSTANCE(meth)->expr[0]->name,"conformal metric");
cmdptr = NULL; datafile_flag = oldflag;
}
else if ( web.representation == STRING )
meth = new_method_instance("density_edge_length","default_length_inst");
else
meth = new_method_instance("edge_length","default_length_inst");
length_method_number = meth;
if ( meth >= 0 )
{
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
METH_INSTANCE(meth)->flags |= DEFAULT_INSTANCE;
if ( web.representation == STRING )
METH_INSTANCE(meth)->flags |= USE_DENSITY;
attach_method_num(q,meth);
apply_method_num(NULLID,meth); /* global method */
}
if ( web.representation != STRING )
/* soapfilm or simplex */
{ q = new_quantity("default_area",Q_ENERGY);
default_area_quant_num = q;
GEN_QUANT(q)->flags |= DEFAULT_QUANTITY;
if ( area_method_name[0] )
{ meth = find_method_instance(area_method_name); /* user instance? */
if ( meth < 0 ) /* try pre-defined method */
meth = new_method_instance(area_method_name,"default_area_inst");
}
else if ( web.wulff_flag )
{ meth = new_method_instance("wulff_energy","default_area_inst");
}
else if ( klein_metric_flag )
{ meth = new_method_instance("klein_area","default_area_inst");
}
else if ( web.conformal_flag )
{ int oldflag = datafile_flag;
meth = new_method_instance("facet_scalar_integral","default_area_inst");
strcpy(formula,"density*(");
gformula = print_express(&web.metric[0][0],'X');
if ( strlen(gformula) > sizeof(formula)-20 )
kb_error(1757,"Conformal metric formula too long.\n",RECOVERABLE);
strcat(formula,gformula);
strcat(formula,")");
METH_INSTANCE(meth)->expr[0] =
(struct expnode *)mycalloc(1,sizeof(struct expnode));
cmdptr = formula;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth)->expr[0],USERCOPY);
sprintf(METH_INSTANCE(meth)->expr[0]->name,"conformal metric");
cmdptr = NULL; datafile_flag = oldflag;
}
else if ( web.metric_flag )
{
meth = new_method_instance("metric_facet_area","default_area_inst");
}
else
meth = new_method_instance("density_facet_area","default_area_inst");
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE | DEFAULT_INSTANCE;
METH_INSTANCE(meth)->flags |= USE_DENSITY;
attach_method_num(q,meth);
apply_method_num(NULLID,meth); /* global method */
}
/* constraint energy integrals */
for ( i = 0 ; i < web.maxcon ; i++ )
convert_constraint_to_quantities(i);
/* boundary energy integrals */
for ( i = 0 ; i < web.bdrymax ; i++ )
{ struct boundary *bdry = web.boundaries + i;
if ( !(bdry->attr & CON_ENERGY) ) continue;
if ( bdry->attr & NAMED_THING )
{ sprintf(qname,"boundary_%s_energy",bdry->name);
sprintf(inst_name,"boundary_%s_energy_inst",bdry->name);
} else
{ sprintf(qname,"boundary_%d_energy",i);
sprintf(inst_name,"boundary_%d_energy_inst",i);
}
gq = new_quantity(qname,Q_ENERGY);
GEN_QUANT(gq)->flags |= DEFAULT_QUANTITY;
if ( web.representation == STRING )
meth = new_method_instance("vertex_scalar_integral",inst_name);
else
meth = new_method_instance("edge_vector_integral",inst_name);
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gq,meth);
{ vertex_id v_id;
if ( web.representation == STRING )
{ FOR_ALL_VERTICES(v_id)
if ( bdry == get_boundary(v_id) )
apply_quantity(v_id,gq);
}
else
{ FOR_ALL_EDGES(e_id)
if ( bdry == get_edge_boundary(e_id) )
apply_quantity(e_id,gq);
}
}
for ( j = 0 ; j < SDIM ; j++ )
METH_INSTANCE(meth)->expr[j] = bdry->envect[j];
bdry->attr |= USURPED_BY_QUANTITY; /* prevent dual expr deallocation */
bdry->energy_method = meth;
}
/* bodies */
FOR_ALL_BODIES(b_id)
convert_new_body_to_quantity(b_id); /* set up individual stuff */
convert_bodies_to_quantities(); /* add quantities to edges and facets */
/* gravity */
/* if ( web.gravflag ) do it always anyway! */
{
sprintf(qname,"gravity_quant");
sprintf(inst_name,"gravity_inst");
gq = new_quantity(qname,Q_ENERGY);
GEN_QUANT(gq)->flags |= DEFAULT_QUANTITY;
GEN_QUANT(gq)->modulus = web.grav_const;
gravity_quantity_num = gq;
if ( web.representation == STRING )
meth = new_method_instance("string_gravity",inst_name);
else
meth = new_method_instance("gravity_method",inst_name);
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gq,meth);
apply_method_num(NULLID,meth);
}
if ( mean_curv_int_flag )
mean_curv_int_quantity_num =
add_standard_quantity("mean_curvature_integral",1.0);
if ( sqgauss_flag )
add_standard_quantity("sq_gauss_curvature",1.0);
/* square mean curvature */
if ( square_curvature_flag )
{
sprintf(qname,"sq_mean_curvature_quant");
sprintf(inst_name,"sq_mean_curvature_inst");
gq = new_quantity(qname,Q_ENERGY);
GEN_QUANT(gq)->flags |= DEFAULT_QUANTITY;
sq_mean_curv_quantity_num = gq;
if ( web.representation == STRING )
meth = new_method_instance("sqcurve_string",inst_name);
else
meth = new_method_instance("sq_mean_curvature",inst_name);
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gq,meth);
apply_method_num(NULLID,meth);
GEN_QUANT(gq)->modulus = globals(square_curvature_param)->value.real;
}
if ( web.convex_flag )
{
sprintf(qname,"gap_quant");
sprintf(inst_name,"gap_energy");
gq = new_quantity(qname,Q_ENERGY);
GEN_QUANT(gq)->flags |= DEFAULT_QUANTITY;
gap_quantity_num = gq;
meth = new_method_instance("gap_energy",inst_name);
METH_INSTANCE(meth)->flags |= IMPLICIT_INSTANCE;
attach_method_num(gq,meth);
apply_method_num(NULLID,meth);
}
quantities_only_flag = everything_quantities_flag = 1;
outstring("Done.\n");
}
/****************************************************************************
*
* function: convert_body_to_quantity()
*
* purpose: Convert a body volume to a named quantity. Done for
* individual bodies so can be called when new body created,
* i.e. rebody().
*/
void convert_body_to_quantity(b_id)
body_id b_id;
{
int gq;
int meth1;
char inst_name1[40];
char qname[40];
int i,j,k;
edge_id e_id;
facet_id f_id;
facetedge_id fe;
char formula[100];
struct gen_quant *g = NULL;
i = ordinal(b_id) + 1;
sprintf(qname,"body_%d_vol",i);
sprintf(inst_name1,"body_%d_vol_meth",i);
if ( get_battr(b_id) & FIXEDVOL )
{
gq = find_quantity(qname);
if ( gq < 0 ) gq = new_quantity(qname,Q_FIXED);
g = GEN_QUANT(gq);
g->target = get_body_fixvol(b_id);
}
else if ( get_battr(b_id) & PRESSURE )
{ REAL p;
gq = find_quantity(qname);
if ( gq < 0 ) gq = new_quantity(qname,Q_ENERGY);
g = GEN_QUANT(gq);
p = get_body_pressure(b_id);
g->modulus = -p;
if ( p == 0.0 )
{ g->flags &= ~Q_ENERGY;
g->flags |= Q_INFO; /* to force volume calc even for zero pressure */
g->modulus = 1.0;
}
}
else { gq = find_quantity(qname);
if ( gq < 0 ) gq = new_quantity(qname,Q_INFO);
g = GEN_QUANT(gq);
}
g->flags |= DEFAULT_QUANTITY;
g->b_id = b_id;
set_body_volquant(b_id,gq);
g->volconst = get_body_volconst(b_id);
g->pressure = get_body_pressure(b_id);
g->value = get_body_volume(b_id);
g->oldvalue = get_body_volume(b_id);
if ( web.representation == STRING )
{
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( area_method_name[0] )
{ meth1 = find_method_instance(area_method_name); /* user instance? */
if ( meth1 < 0 ) /* try pre-defined method */
meth1 = new_method_instance(area_method_name,inst_name1);
}
else if ( web.symmetric_content )
{
meth1 = new_method_instance("edge_vector_integral",inst_name1);
METH_INSTANCE(meth1)->expr[0] =
(struct expnode *)mycalloc(SDIM,sizeof(struct expnode));
for ( j = 0 ; j < 2 ; j++ )
{ if ( j==0 )sprintf(formula,"-y/2");
if ( j==1 )sprintf(formula,"x/2");
cmdptr = formula;
METH_INSTANCE(meth1)->expr[j] = METH_INSTANCE(meth1)->expr[0] + j;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth1)->expr[j],USERCOPY);
sprintf(METH_INSTANCE(meth1)->expr[j]->name,
"symmetric content component %d",j+1);
datafile_flag = 0;
cmdptr = NULL;
}
}
else
{
meth1 = new_method_instance("edge_area",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->modulus = 1.0;
attach_method_num(gq,meth1);
set_body_volmeth(b_id,meth1);
}
FOR_ALL_EDGES(e_id)
{ fe = get_edge_fe(e_id);
if ( !valid_id(fe) ) continue;
if ( get_eattr(e_id) & NONCONTENT ) continue;
f_id = get_fe_facet(fe);
if ( valid_id(f_id))
{ if ( equal_id(b_id,get_facet_body(f_id)) )
apply_method_num(e_id,meth1);
else if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
apply_method_num(inverse_id(e_id),meth1);
}
fe = get_next_facet(fe);
f_id = get_fe_facet(fe);
if ( valid_id(f_id))
{ /* check both in case of torus wrapping */
if ( equal_id(b_id,get_facet_body(f_id)) )
apply_method_num(e_id,meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
apply_method_num(inverse_id(e_id),meth1);
}
}
}
else /* SOAPFILM */
{
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( volume_method_name[0] )
{ meth1 = find_method_instance(volume_method_name); /* user instance? */
if ( meth1 < 0 ) /* try pre-defined method */
meth1 = new_method_instance(volume_method_name,inst_name1);
}
else if ( web.symmetric_content )
{
meth1 = new_method_instance("facet_vector_integral",inst_name1);
METH_INSTANCE(meth1)->expr[0] =
(struct expnode *)mycalloc(SDIM,sizeof(struct expnode));
for ( j = 0 ; j < SDIM ; j++ )
{ sprintf(formula,"x%d/%d",j+1,SDIM);
cmdptr = formula;
METH_INSTANCE(meth1)->expr[j] = METH_INSTANCE(meth1)->expr[0] + j;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth1)->expr[j],USERCOPY);
sprintf(METH_INSTANCE(meth1)->expr[j]->name,
"symmetric content component %d",j+1);
datafile_flag = 0;
cmdptr = NULL;
}
}
else
{
meth1 = new_method_instance("facet_volume",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->modulus = 1.0;
attach_method_num(gq,meth1);
set_body_volmeth(b_id,meth1);
}
FOR_ALL_FACETS(f_id)
{ /* check both in case of torus wrapping */
if ( get_fattr(f_id) & NONCONTENT ) continue;
if ( equal_id(b_id,get_facet_body(f_id)) )
apply_method_num(f_id,meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
apply_method_num(inverse_id(f_id),meth1);
}
}
/* constraint content integrals */
for ( j = 0 ; j < web.maxcon ; j++ )
{ struct constraint *con = get_constraint(j);
vertex_id v_id;
if ( !(con->attr & CON_CONTENT) ) continue;
if ( con->attr & NAMED_THING )
sprintf(inst_name1,"body_%d_%s_meth",i,con->name);
else
sprintf(inst_name1,"body_%d_con_%d_meth",i,j);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->connum = j;
attach_method_num(gq,meth1);
con = get_constraint(j); /* may have moved */
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = con->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = con->convect[k];
}
if ( web.representation == STRING )
{ FOR_ALL_VERTICES(v_id)
if ( v_on_constraint(v_id,j) )
{ edge_id first_e = e_id = get_vertex_edge(v_id);
int max_rank,min_rank,jj;
conmap_t *map = get_v_constraint_map(v_id);
min_rank = MAXINT; max_rank = 0;
for ( jj = 1 ; jj <= (int)map[0] ; jj++ )
{ struct constraint *c;
if ( !(map[j] & CON_HIT_BIT) ) continue;
c = get_constraint(map[jj]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
if ( valid_id(e_id) )
do
{
facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) && !(get_eattr(e_id) & NONCONTENT) )
do
{ f_id = get_fe_facet(fe);
if ( equal_id(b_id,get_facet_body(f_id)) &&
( (!inverted(f_id) && con->content_rank >= max_rank)
|| (inverted(f_id) && con->content_rank <= min_rank)) )
apply_method_num(inverse_id(v_id),meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) &&
( (!inverted(f_id) && con->content_rank >= max_rank)
|| (inverted(f_id) && con->content_rank <= min_rank)) )
apply_method(v_id,inst_name1);
fe = get_next_facet(fe);
} while ( !equal_id(fe,first_fe) );
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(first_e,e_id));
}
}
else /* SOAPFILM */
{ FOR_ALL_EDGES(e_id)
if ( e_on_constraint(e_id,j) )
{ facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id ( fe ) )
{ conmap_t *conmap = get_e_constraint_map(e_id);
int min_rank = MAXINT;
int max_rank = 0;
int jj;
for ( jj = 1 ; jj <= (int)conmap[0] ; jj++ )
{
struct constraint *c = get_constraint(conmap[jj]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
do
{ f_id = get_fe_facet(fe);
if ( !(get_fattr(f_id) & NONCONTENT) )
{ if ( equal_id(b_id,get_facet_body(f_id))
&& (con->content_rank >= max_rank) )
apply_method_num(e_id,meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id)))
&& (con->content_rank <= min_rank) )
apply_method_num(inverse_id(e_id),meth1);
}
fe = get_next_facet(fe);
} while ( !equal_id(fe,first_fe) );
}
}
}
}
/* boundary content integrals */
for ( j = 0 ; j < web.bdrymax ; j++ )
{ struct boundary *bdry = web.boundaries + j;
vertex_id v_id;
if ( !(bdry->attr & CON_CONTENT) ) continue;
sprintf(inst_name1,"body_%d_bdry_%s_meth",i+1,bdry->name);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->connum = j;
attach_method_num(gq,meth1);
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = bdry->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = bdry->convect[k];
}
if ( web.representation == STRING )
{ FOR_ALL_VERTICES(v_id)
if ( bdry == get_boundary(v_id) )
{ edge_id first_e = e_id = get_vertex_edge(v_id);
if ( valid_id(e_id) )
do
{ facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) && !(get_eattr(e_id) & NONCONTENT) )
do
{ f_id = get_fe_facet(fe);
if ( equal_id(b_id,get_facet_body(f_id)) )
apply_method_num(v_id,meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
apply_method_num(inverse_id(v_id),meth1);
fe = get_next_facet(fe);
} while ( !equal_id(fe,first_fe) );
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(first_e,e_id));
}
}
else /* SOAPFILM */
{ FOR_ALL_EDGES(e_id)
if ( bdry == get_edge_boundary(e_id) )
{ facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) )
do
{ f_id = get_fe_facet(fe);
if ( !(get_fattr(f_id) & NONCONTENT) )
{ if ( equal_id(b_id,get_facet_body(f_id)) )
apply_method_num(e_id,meth1);
if ( equal_id(b_id,get_facet_body(inverse_id(f_id))) )
apply_method_num(inverse_id(e_id),meth1);
}
fe = get_next_facet(fe);
} while ( !equal_id(fe,first_fe) );
}
}
}
create_pressure_quant(b_id);
} /* end convert_body_to_quantity() */
/****************************************************************************
*
* function: convert_new_body_to_quantity()
*
* purpose: Convert a new body volume to a named quantity. Does not
* do anything about putting quantities on edges or faces.
* To can be called when new body created.
* Call convert_bodies_to_quantity() to apply quantities.
*/
void convert_new_body_to_quantity(b_id)
body_id b_id;
{
int gq;
int meth1;
char inst_name1[40];
char qname[40];
int i,j;
char formula[100];
struct gen_quant *g=NULL;
i = ordinal(b_id) + 1;
sprintf(qname,"body_%d_vol",i);
sprintf(inst_name1,"body_%d_vol_meth",i);
if ( get_battr(b_id) & FIXEDVOL )
{
gq = find_quantity(qname);
if ( gq < 0 ) gq = new_quantity(qname,Q_FIXED);
g = GEN_QUANT(gq);
g->target = get_body_fixvol(b_id);
}
else if ( get_battr(b_id) & PRESSURE )
{ REAL p;
gq = find_quantity(qname);
if ( gq < 0 ) gq = new_quantity(qname,Q_ENERGY);
g = GEN_QUANT(gq);
p = get_body_pressure(b_id);
g->modulus = -p;
if ( p == 0.0 )
{ g->flags &= ~Q_ENERGY;
g->flags |= Q_INFO;
/* to force volume calc even for zero pressure */
g->modulus = 1.0;
}
}
else { gq = find_quantity(qname);
if ( gq < 0 )
gq = new_quantity(qname,Q_INFO);
g = GEN_QUANT(gq);
}
g->flags |= DEFAULT_QUANTITY;
g->b_id = b_id;
set_body_volquant(b_id,gq);
g->volconst = get_body_volconst(b_id);
g->pressure = get_body_pressure(b_id);
g->value = get_body_volume(b_id);
g->oldvalue = get_body_volume(b_id);
if ( web.representation == STRING )
{
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( area_method_name[0] )
{ meth1 = find_method_instance(area_method_name); /* user instance? */
if ( meth1 < 0 ) /* try pre-defined method */
meth1 = new_method_instance(area_method_name,inst_name1);
}
else if ( web.symmetric_content )
{
meth1 = new_method_instance("edge_vector_integral",inst_name1);
METH_INSTANCE(meth1)->expr[0] =
(struct expnode *)mycalloc(SDIM,sizeof(struct expnode));
for ( j = 0 ; j < SDIM ; j++ )
{ int old_datafile_flag;
char *old_cmdptr = cmdptr;
int old_tok = tok;
if ( j==0 )sprintf(formula,"-y/2");
else if ( j==1 )sprintf(formula,"x/2");
else sprintf(formula,"0");
cmdptr = formula;
METH_INSTANCE(meth1)->expr[j] = METH_INSTANCE(meth1)->expr[0] + j;
old_datafile_flag = datafile_flag;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth1)->expr[j],USERCOPY);
sprintf(METH_INSTANCE(meth1)->expr[j]->name,
"symmetric content component %d",j+1);
datafile_flag = old_datafile_flag;
cmdptr = old_cmdptr;
tok = old_tok;
}
}
else
{
meth1 = new_method_instance("edge_area",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->modulus = 1.0;
attach_method_num(gq,meth1);
set_body_volmeth(b_id,meth1);
}
}
else /* SOAPFILM */
{
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( volume_method_name[0] )
{ meth1 = find_method_instance(volume_method_name); /* user instance? */
if ( meth1 < 0 ) /* try pre-defined method */
meth1 = new_method_instance(volume_method_name,inst_name1);
}
else if ( web.symmetric_content )
{
meth1 = new_method_instance("facet_vector_integral",inst_name1);
METH_INSTANCE(meth1)->expr[0] =
(struct expnode *)mycalloc(SDIM,sizeof(struct expnode));
for ( j = 0 ; j < SDIM ; j++ )
{ int old_datafile_flag;
char *old_cmdptr = cmdptr;
int old_tok = tok;
sprintf(formula,"x%d/%d",j+1,SDIM);
cmdptr = formula;
METH_INSTANCE(meth1)->expr[j] = METH_INSTANCE(meth1)->expr[0] + j;
old_datafile_flag = datafile_flag;
datafile_flag = 1;
exparse(SDIM,METH_INSTANCE(meth1)->expr[j],USERCOPY);
sprintf(METH_INSTANCE(meth1)->expr[j]->name,"symmetric content component %d",j+1);
datafile_flag = old_datafile_flag;
cmdptr = old_cmdptr;
tok = old_tok;
}
}
else
{
meth1 = new_method_instance("facet_volume",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
METH_INSTANCE(meth1)->modulus = 1.0;
attach_method_num(gq,meth1);
set_body_volmeth(b_id,meth1);
}
}
create_pressure_quant(b_id);
} /* end convert_new_body_to_quantity() */
/****************************************************************************
*
* function: create_body_constraint_content_method()
*
* purpose: Create a new method instance for constraint content.
*
* return: method number
*/
int create_body_constraint_content_method(b_id,connum)
body_id b_id;
int connum;
{ struct constraint *con = get_constraint(connum);
int k;
int meth1;
char inst_name1[100];
if ( con->attr & NAMED_THING )
sprintf(inst_name1,"body_%d_%s_meth",ordinal(b_id)+1,con->name);
else
sprintf(inst_name1,"body_%d_con_%d_meth",ordinal(b_id)+1,connum);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
con = get_constraint(connum); /* may have moved */
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = con->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = con->convect[k];
attach_method_num(get_body_volquant(b_id),meth1);
}
return meth1;
}
/****************************************************************************
*
* function: create_body_boundary_content_method()
*
* purpose: Create a new method instance for boundary content.
*
* return: method number
*/
int create_body_boundary_content_method(b_id,bdrynum)
body_id b_id;
int bdrynum;
{ struct boundary *bdry = web.boundaries + bdrynum;
int k;
int meth1;
char inst_name1[100];
sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = bdry->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = bdry->convect[k];
attach_method_num(get_body_volquant(b_id),meth1);
}
return meth1;
}
/****************************************************************************
*
* function: convert_bodies_to_quantities()
*
* purpose: Apply all body quantity method instances to elements.
*/
void convert_bodies_to_quantities()
{
body_id b_id;
int meth1;
char inst_name1[100];
int i,j,k;
edge_id e_id;
facet_id f_id;
facetedge_id fe;
/* The main surface integral */
if ( web.representation == STRING )
{
FOR_ALL_EDGES(e_id)
{ if ( get_eattr(e_id) & NONCONTENT ) continue;
fe = get_edge_fe(e_id);
if ( !valid_id(fe) ) continue;
f_id = get_fe_facet(fe);
for ( i = 0 ; i < 2 ; i++ ) /* at most two facets per edge */
{ if ( valid_id(f_id))
{ b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
apply_method_num(e_id,get_body_volmeth(b_id));
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
apply_method_num(inverse_id(e_id),get_body_volmeth(b_id));
}
fe = get_next_facet(fe);
f_id = get_fe_facet(fe);
}
}
}
else /* SOAPFILM */
{
FOR_ALL_FACETS(f_id)
{ /* check both in case of torus wrapping */
if ( get_fattr(f_id) & NONCONTENT ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
apply_method_num(f_id,get_body_volmeth(b_id));
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
apply_method_num(inverse_id(f_id),get_body_volmeth(b_id));
}
}
/* constraint content integrals */
/* create instance for each possible body/constraint content pair */
for ( j = 0 ; j < web.maxcon ; j++ )
{ struct constraint *con = get_constraint(j);
if ( !(con->attr & CON_CONTENT) ) continue;
FOR_ALL_BODIES(b_id)
{ if ( con->attr & NAMED_THING )
sprintf(inst_name1,"body_%d_%s_meth",ordinal(b_id)+1,con->name);
else
sprintf(inst_name1,"body_%d_con_%d_meth",ordinal(b_id)+1,j);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
con = get_constraint(j); /* may have moved */
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = con->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = con->convect[k];
}
}
}
if ( web.representation == STRING )
{ vertex_id v_id;
FOR_ALL_VERTICES(v_id)
{ conmap_t *con = get_v_constraint_map(v_id);
int concount = (int)con[0];
edge_id first_e;
int max_rank,min_rank;
min_rank = MAXINT; max_rank = 0;
for ( j = 1 ; j <= (int)con[0] ; j++ )
{ struct constraint *c;
if ( !(con[j] & CON_HIT_BIT) ) continue;
c = get_constraint(con[j]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
for ( i = 1 ; i <= concount ; i++ )
{ conmap_t *con = get_v_constraint_map(v_id); /* might have moved */
int connum = con[i] & CONMASK;
struct constraint *c = get_constraint(connum);
if ( !(c->attr & CON_CONTENT)) continue;
first_e = e_id = get_vertex_edge(v_id);
if ( valid_id(e_id) )
do
{ char name[100];
facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) && !(get_eattr(e_id) & NONCONTENT) )
do
{ f_id = get_fe_facet(fe);
fe = get_next_facet(fe);
if ( !valid_id(f_id) ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) &&
( (!inverted(f_id) && c->content_rank >= max_rank)
|| (inverted(f_id) && c->content_rank <= min_rank)))
{ if ( c->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,c->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,connum);
attach_method(get_body_volquant(b_id),name);
apply_method(inverse_id(v_id),name);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) &&
( (!inverted(f_id) && c->content_rank >= max_rank)
|| (inverted(f_id) && c->content_rank <= min_rank)))
{ if ( c->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,c->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,connum);
attach_method(get_body_volquant(b_id),name);
apply_method(v_id,name);
}
} while ( !equal_id(fe,first_fe) );
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(first_e,e_id));
}
}
}
else /* SOAPFILM */
{ FOR_ALL_EDGES(e_id)
{ conmap_t *con = get_e_constraint_map(e_id);
int concount = (int)con[0];
facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id ( fe ) )
{ int min_rank, max_rank;
min_rank = MAXINT; max_rank = 0;
for ( j = 1 ; j <= concount ; j++ )
{
struct constraint *c = get_constraint(con[j]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
for ( i = 1 ; i <= concount ; i++ )
{ conmap_t *con = get_e_constraint_map(e_id); /* might have moved */
int connum = con[i]&CONMASK;
struct constraint *c = get_constraint(connum);
if ( !(c->attr & CON_CONTENT) ) continue;
fe = first_fe;
do
{ char name[100];
f_id = get_fe_facet(fe);
fe = get_next_facet(fe);
if ( !valid_id(f_id) ) continue;
if ( get_fattr(f_id) & NONCONTENT ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) && (c->content_rank >= max_rank))
{ if ( c->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,c->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,connum);
attach_method(get_body_volquant(b_id),name);
apply_method(e_id,name);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) && (c->content_rank <= min_rank) )
{ if ( c->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,c->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,connum&CONMASK);
attach_method(get_body_volquant(b_id),name);
apply_method(inverse_id(e_id),name);
}
} while ( !equal_id(fe,first_fe) );
}
}
}
}
/* boundary content integrals */
for ( j = 0 ; j < web.bdrymax ; j++ )
{ struct boundary *bdry = web.boundaries + j;
if ( !(bdry->attr & CON_CONTENT) ) continue;
FOR_ALL_BODIES(b_id)
{ sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
if ( meth1 < 0 )
{ /* have to create */
if ( web.representation == STRING )
{ meth1 = new_method_instance("vertex_scalar_integral",inst_name1);
}
else
{ meth1 = new_method_instance("edge_vector_integral",inst_name1);
}
METH_INSTANCE(meth1)->flags |= DEFAULT_INSTANCE | BODY_INSTANCE;
if ( web.representation == STRING )
METH_INSTANCE(meth1)->expr[0] = bdry->convect[0];
else
for ( k = 0 ; k < SDIM ; k++ )
METH_INSTANCE(meth1)->expr[k] = bdry->convect[k];
attach_method_num(get_body_volquant(b_id),meth1);
}
}
}
if ( web.representation == STRING )
{ vertex_id v_id;
FOR_ALL_VERTICES(v_id)
{ struct boundary *bdry = get_boundary(v_id);
edge_id first_e;
if ( !bdry || !(bdry->attr & CON_CONTENT) ) continue;
first_e = e_id = get_vertex_edge(v_id);
if ( valid_id(e_id) )
do
{ facetedge_id first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) && !(get_eattr(e_id) & NONCONTENT) )
do
{ f_id = get_fe_facet(fe);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{
sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
apply_method_num(v_id,meth1);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
{
sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
apply_method_num(inverse_id(v_id),meth1);
}
fe = get_next_facet(fe);
} while ( !equal_id(fe,first_fe) );
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(first_e,e_id));
}
}
else /* SOAPFILM */
{ FOR_ALL_EDGES(e_id)
{ struct boundary *bdry = get_edge_boundary(e_id);
facetedge_id first_fe;
if ( !bdry || !(bdry->attr & CON_CONTENT) ) continue;
first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) )
do
{ f_id = get_fe_facet(fe);
fe = get_next_facet(fe);
if ( !valid_id(f_id) ) continue;
if ( get_fattr(f_id) & NONCONTENT ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
apply_method_num(inverse_id(e_id),meth1);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
{ sprintf(inst_name1,"body_%d_bdry_%s_meth",ordinal(b_id)+1,bdry->name);
meth1 = find_method_instance(inst_name1);
apply_method_num(e_id,meth1);
}
} while ( !equal_id(fe,first_fe) );
}
}
/* done in convert_new_body...
if ( web.pressure_flag )
FOR_ALL_BODIES(b_id)
create_pressure_quant(b_id);
*/
}
/***************************************************************************
*
* function: create_pressure_quant()
*
* purpose: create a named quantity for the ambient pressure energy.
*/
void create_pressure_quant(b_id)
body_id b_id;
{
if ( web.pressure_flag )
{ /* create formula and do compound quantity */
int gq = get_body_volquant(b_id);
int mc = GEN_QUANT(gq)->method_count;
char *volsum = temp_calloc(40,mc);
char *formula = temp_calloc(2,40*mc + 100);
char qname[1000];
int q,i,j;
sprintf(qname,"body_%d_ambient_energy",ordinal(b_id)+1);
q = find_quantity(qname);
if ( q < 0 ) q = new_quantity(qname,Q_INFO);
set_body_ambquant(b_id,q);
GEN_QUANT(q)->flags |= DEFAULT_QUANTITY;
sprintf(volsum,"body[%d].volconst",ordinal(b_id)+1);
for ( j = 0 ; j < mc ; j++ )
{ int m = GEN_QUANT(gq)->meth_inst[j];
struct method_instance *mi = METH_INSTANCE(m);
strcat(volsum,((mi->modulus > 0.0) ? "+" : "+"));
strcat(volsum,mi->name);
strcat(volsum,".value");
mi->flags |= Q_COMPOUND;
}
GEN_QUANT(q)->method_count = 0;
i = ordinal(b_id)+1;
sprintf(formula,"-ambient_pressure_value*(body[%d].target*(log(%s)-log(body[%d].target))-(%s-body[%d].target))",
i,volsum,i,volsum,i);
cmdptr = formula;
exparse(0,&(GEN_QUANT(q)->expr),USERCOPY);
sprintf(msg,"%s formula",qname);
strncpy(GEN_QUANT(q)->expr.name,msg,EXPNAMESIZE-1);
cmdptr = NULL;
GEN_QUANT(q)->flags |= Q_COMPOUND;
GEN_QUANT(q)->next_compound = compound_quant_list_head;
compound_quant_list_head = q;
if ( get_battr(b_id) & FIXEDVOL )
GEN_QUANT(q)->flags |= Q_ENERGY;
else GEN_QUANT(q)->flags |= Q_INFO;
GEN_QUANT(gq)->flags &= ~Q_FIXED;
GEN_QUANT(gq)->flags |= Q_INFO;
temp_free(volsum);
temp_free(formula);
}
}
/*****************************************************************************
*
* Function: read_array_initializer()
*
* Purpose: Read bracketed array initial data. Next unread token should
* be the first '{'.
*/
void read_array_initializer(struct array *a)
{ char *spot;
char *spots[MAXARRAYDIMS];
int depth;
int blocksize;
int items[MAXARRAYDIMS];
tok = yylex(); /* should be '{' */
if ( tok != '{' )
kb_error(3041,"Missing '{'; expected array initializer.\n",RECOVERABLE);
depth = 0;
spot = (char *)a + a->datastart;
spots[depth] = spot;
blocksize = a->datacount;
for (;;)
{
if ( depth == a->dim )
{ int k;
for ( k = 0 ; ; k++ )
{ if ( read_single_value(a->datatype,spot) )
{ if ( k < a->sizes[depth-1] )
spot += a->itemsize;
else kb_error(2132,"Too many initializers.\n",DATAFILE_ERROR);
}
else
{ tok = yylex(); /* get back token exparse pushed back */
if ( tok != ',' )
break;
}
}
}
if ( tok == '{' )
{
if ( blocksize ) blocksize /= a->sizes[depth];
spots[depth] = spot;
items[depth]++;
if ( depth > 0 && items[depth] > a->sizes[depth-1] )
kb_error(2539,"Too many initializers.\n",DATAFILE_ERROR);
depth++;
items[depth] = 0;
if ( depth != a->dim ) tok = yylex();
}
else if ( tok == '}' )
{ tok = yylex();
depth--;
if ( depth == 0 ) return;
blocksize *= a->sizes[depth];
spots[depth] += blocksize*a->itemsize;
spot = spots[depth];
}
else if ( tok == ',' )
{ tok = yylex();
spots[depth] += blocksize*a->itemsize;
}
else
{ sprintf(errmsg,"Illegal token \"%s\" in array initialization.\n",yytext);
kb_error(2540,errmsg,DATAFILE_ERROR);
}
}
} /* end read_array_initializer() */
/****************************************************************************
*
* function: define_array()
*
* purpose: read an array parameter in the top of the datafile,
* with possible initialization.
*
* incoming assumption: array name in yytext.
*/
void define_array(void)
{ int n;
struct global *g;
struct array *a;
int dim;
int size;
int sizes[MAXARRAYDIMS];
int itemsize=0;
int datatype=0;
size_t rem;
if ( strlen(yytext) < 2 )
kb_error(1867,"Identifiers must be at least two characters long.\n",
DATAFILE_ERROR);
n = lookup_global(yytext);
if ( n >= 0 )
{
g = globals(n);
if ( !(g->flags & ARRAY_PARAM) )
kb_error(3213,"Array name already in use for something else.\n",
DATAFILE_ERROR);
}
else
{ n = add_global(yytext);
if ( n < 0 )
kb_error(1673,"Duplicate parameter name.\n",DATAFILE_ERROR);
g = globals(n);
g->flags |= ARRAY_PARAM;
}
tok = yylex(); /* dispose of IDENT_ */
if ( tok == DATATYPE_ )
{ datatype = yylval.datatype;
itemsize = datatype_size[datatype];
}
else
{ kb_error(2130,"Need an array data type.\n",DATAFILE_ERROR);
datatype = REAL_TYPE;
itemsize = datatype_size[datatype];
}
g->type = datatype;
tok = yylex(); /* dispose of type */
g->attr.arrayptr = (struct array*)mycalloc(1,sizeof(struct array));
g->attr.arrayptr->dim = 0;
while ( tok == '[' )
{ REAL val;
if ( read_const(&val) < 0 )
kb_error(1057,"Need dimension number.\n",DATAFILE_ERROR);
sizes[g->attr.arrayptr->dim] = (int)val;
if ( sizes[g->attr.arrayptr->dim] < 0 )
kb_error(1059,"Array dimension cannot be negative.\n",DATAFILE_ERROR);
tok = yylex(); /* get ] */
if ( tok != ']' )
kb_error(2131,"Expecting ].\n",DATAFILE_ERROR);
tok = yylex(); /* eat ] */
g->attr.arrayptr->dim++;
}
if ( g->attr.arrayptr->dim == 0 ) sizes[g->attr.arrayptr->dim++] = 1;
for ( size = 1, dim=0 ; dim < g->attr.arrayptr->dim ; dim++ )
{ size *= sizes[dim]; }
a = g->attr.arrayptr = (struct array*)kb_realloc((char*)(g->attr.arrayptr),
sizeof(struct array)+dim*sizeof(int)
+ (size+1)*itemsize); /* extra for alignment */
a->dim = g->attr.arrayptr->dim;
a->itemsize = itemsize;
a->datatype = datatype;
a->datacount = size;
for ( dim=0 ; dim < g->attr.arrayptr->dim ; dim++ )
a->sizes[dim] = sizes[dim];
a->datastart = sizeof(struct array) + a->dim*sizeof(int);
/* align datastart to size of item */
rem = a->datastart % a->itemsize;
if ( rem )
a->datastart += a->itemsize - rem;
/* Initialization */
if ( (tok == '=') || (tok == ASSIGN_) ) /* have initial values */
read_array_initializer(a);
}
/****************************************************************************
*
* Function: check_forwards()
*
* Purpose: Make sure all forward declarations have been implemented.
*/
void check_forwards()
{ int i;
/* constraints */
for ( i = 0 ; i < web.maxcon ; i++ )
{ struct constraint *con = get_constraint(i);
if ( con->attr & CON_FORWARD_DEF )
{ sprintf(errmsg,"Forward declared constraint %s not instantiated.\n",
con->name);
kb_error(5911,errmsg,RECOVERABLE);
}
}
/* boundaries */
for ( i = 0 ; i < web.bdrymax ; i++ )
{ struct boundary *bdry = web.boundaries + i;
if ( bdry->attr & BDRY_FORWARD_DEF )
{ sprintf(errmsg,"Forward declared boundary %s not instantiated.\n",
bdry->name);
kb_error(3227,errmsg,RECOVERABLE);
}
}
/* quantities */
for ( i = 0 ; i < gen_quant_count ; i++ )
{ if ( GEN_QUANT(i)->flags & Q_FORWARD_DEF )
{ sprintf(errmsg,"Forward declared quantity %s not instantiated.\n",
GEN_QUANT(i)->name);
kb_error(3225,errmsg,RECOVERABLE);
}
}
/* method instances */
for ( i = 1 ; i < meth_inst_count ; i++ )
{ if ( METH_INSTANCE(i)->flags & Q_FORWARD_DEF )
{ sprintf(errmsg,"Forward declared method_instance %s not instantiated.\n",
METH_INSTANCE(i)->name);
kb_error(3226,errmsg,RECOVERABLE);
}
}
}
evolver-2.30c.dfsg/src/diffuse.c 0000644 0001753 0001753 00000005473 11410765113 017017 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
#include "include.h"
/********************************************************************
*
* Function: diffuse()
*
* Purpose: Diffuse mass through permeable surfaces.
* Assumes string lengths or film areas
* already calculated; also assumes pressures
* known.
*/
/* for per-element diffusion constant */
#define DIFFUSE_EATTR_NAME "edge_diffusion"
#define DIFFUSE_FATTR_NAME "facet_diffusion"
int edge_diffusion_attr;
int facet_diffusion_attr;
void diffuse()
{
edge_id e_id;
facet_id f_id;
facetedge_id fe_id;
body_id b_id,bb_id;
REAL pressure;
REAL mass;
REAL coeff;
if ( web.representation == STRING )
{ edge_diffusion_attr = find_attribute(EDGE,DIFFUSE_EATTR_NAME);
FOR_ALL_EDGES(e_id)
{ fe_id = get_edge_fe(e_id);
if ( !valid_id(fe_id) ) return;
b_id = get_facet_body(get_fe_facet(fe_id));
if ( !valid_id(b_id) ) invert(fe_id);
b_id = get_facet_body(get_fe_facet(fe_id));
if ( !valid_id(b_id) ) continue;
pressure = get_body_pressure(b_id);
if ( !equal_id(fe_id,get_next_facet(fe_id)) )
{ fe_id = get_next_facet(fe_id);
bb_id = get_facet_body(get_fe_facet(fe_id));
if ( !valid_id(bb_id) ) invert(fe_id);
bb_id = get_facet_body(get_fe_facet(fe_id));
pressure -= get_body_pressure(bb_id);
}
else bb_id = NULLBODY;
if ( edge_diffusion_attr >= 0 )
coeff = *(REAL*)get_extra(e_id,edge_diffusion_attr);
else coeff = web.diffusion_const;
mass = web.scale*coeff*pressure*get_edge_length(e_id);
set_body_fixvol(b_id,get_body_fixvol(b_id)-mass);
if ( valid_id(bb_id) )
set_body_fixvol(bb_id,get_body_fixvol(bb_id)+mass);
}
} /* end STRING */
else
{ facet_diffusion_attr = find_attribute(FACET,DIFFUSE_FATTR_NAME);
FOR_ALL_FACETS(f_id)
{ pressure = 0.0;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
pressure = get_body_pressure(b_id);
else pressure = web.pressure;
bb_id = get_facet_body(inverse_id(f_id));
if ( valid_id(bb_id) )
pressure -= get_body_pressure(bb_id);
else pressure -= web.pressure;
if ( facet_diffusion_attr >= 0 )
coeff = *(REAL*)get_extra(f_id,facet_diffusion_attr);
else coeff = web.diffusion_const;
mass = web.scale*coeff*pressure*get_facet_area(f_id);
if ( valid_id(b_id) )
set_body_fixvol(b_id,get_body_fixvol(b_id)-mass);
if ( valid_id(bb_id) )
set_body_fixvol(bb_id,get_body_fixvol(bb_id)+mass);
}
}
} /* end diffuse() */
evolver-2.30c.dfsg/src/model.h 0000644 0001753 0001753 00000004017 11410765113 016470 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: model.h
*
* Header file for evolver. Defines model parameters, i.e.
* for torus model, lagrange model, space dimension.
*
*/
#ifdef SDIM
#define DEFAULT_SDIM SDIM
#ifndef MAXCOORD
#define MAXCOORD SDIM
#endif
#if SDIM==2
#define SDIM_dot(x,y) ((x)[0]*(y)[0] + (x)[1]*(y)[1])
#else
#if SDIM==3
#define SDIM_dot(x,y) ((x)[0]*(y)[0] + (x)[1]*(y)[1] + (x)[2]*(y)[2])
#else
#define SDIM_dot(x,y) dot(x,y,SDIM)
#endif
#endif
#else
#define SDIM web.sdim
#define SDIM_dot(x,y) dot(x,y,SDIM)
#define DEFAULT_SDIM 3
#endif
/* maximum number of shared memory processors */
#ifdef SHARED_MEMORY
#ifndef MAXPROCS
#define MAXPROCS 4
#endif
#else
#define MAXPROCS 1
#endif
/* maximum dimensionality */
#ifndef MAXCOORD
#define MAXCOORD 4
#endif
/* MAXPARAM is maximum number of boundary parameters. Must be
at most MAXCOORD since is saved in same space by save_coord(). */
#define MAXPARAM MAXCOORD
#define EDGE_VERTS 2
#define FACET_VERTS 3
#define FACET_EDGES 3
/* model types for web.modeltype */
#define LINEAR 1
#define QUADRATIC 2
#define LAGRANGE 3
/* Quadratic model point counts */
/* Control points per edge */
#define EDGE_CTRL 3
/* Control points per facet */
#define FACET_CTRL 6
/* Integration points per edge */
#define EDGE_INTERP 3
/* Integration points per facet */
#define FACET_INTERP 7
/* quadratic interpolation coefficients */
/* partials of interpolation polynomials at midpoints of patch edges */
/* control points are numbered 0 to 5 counterclockwise */
/* midpoints are numbered 0 to 2 counterclockwise after control pt 0 */
/* dip[midpoint][control point][partial] */
extern REAL dip[3][FACET_CTRL][2];
/* Histogram size */
#define HISTO_BINS 40
#define HISTO_BINSIZE (1/M_LN2)
evolver-2.30c.dfsg/src/stringl.c 0000644 0001753 0001753 00000053337 11410765113 017056 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************************
*
* File: stringl.c
*
* Contents: Functions to calculate area, energy and their gradients
* according to the LINEAR STRING model.
*/
#include "include.h"
/************************************************************************
*
* Returns energy due to one edge.
* Find edge's contribution to total length and facet areas.
* Areas with respect to origin are calculated
* and then oriented contributions added for each facet.
*
*/
void edge_energy_l(e_id)
edge_id e_id;
{
REAL energy;
vertex_id v[2];
int i;
REAL *x[2];
REAL xx[MAXCOORD];
REAL side[MAXCOORD];
v[0] = get_edge_tailv(e_id);
v[1] = get_edge_headv(e_id);
x[0] = get_coord(v[0]);
x[1] = get_coord(v[1]);
if ( web.symmetry_flag )
{ (*sym_wrap)(x[1],xx,get_edge_wrap(e_id));
x[1] = xx;
}
for ( i = 0 ; i < SDIM ; i++ ) side[i] = x[1][i] - x[0][i];
/* energy due to linear tension */
if ( web.metric_flag )
{ if ( klein_metric_flag )
energy = klein_length(x[0],x[1]);
else
energy = simplex_energy_metric(v,x);
}
else
{ /* calculate length energy */
energy = sqrt(SDIM_dot(side,side));
set_edge_length(e_id,energy);
if ( web.wulff_flag )
{ REAL wulff[MAXCOORD]; /* energy covector to side vector */
(*get_wulff)(side,wulff);
energy = SDIM_dot(side,wulff);
}
}
if ( web.representation == STRING )
web.total_area += energy; /* don't count triple junction as area */
energy *= get_edge_density(e_id);
/* calculate gravitational energy */
if ( web.gravflag && !(get_eattr(e_id) & NONCONTENT) )
{ REAL *t,*h;
REAL grav_e;
REAL density = edge_grav_density(e_id);
if ( density != 0.0 )
{ t = get_coord(v[0]);
h = get_coord(v[1]);
grav_e = (t[0]-h[0])*(t[1]*t[1] + t[1]*h[1] + h[1]*h[1])/6;
energy += density*grav_e;
}
}
web.total_energy = web.total_energy + energy;
}
/************************************************************************
*
* Calculates all forces on control points due to edge and
* accumulates them at each control point.
*/
void edge_force_l(e_id)
edge_id e_id;
{
REAL len;
REAL side[MAXCOORD];
int i,j;
vertex_id hv,tv;
REAL density = get_edge_density(e_id);
REAL forces[2][MAXCOORD]; /* total forces from this facet */
REAL *forceptr[2]; /* pointers to forces */
REAL *force[2]; /* vertex forces */
WRAPTYPE wraps[2];
REAL xx[MAXCOORD];
REAL *x[2];
vertex_id v[2];
v[0] = tv = get_edge_tailv(e_id);
v[1] = hv = get_edge_headv(e_id);
x[0] = get_coord(v[0]);
x[1] = get_coord(v[1]);
for ( i = 0 ; i < 2 ; i++ ) forceptr[i] = forces[i];
if ( web.symmetry_flag )
{ (*sym_wrap)(x[1],xx,get_edge_wrap(e_id));
x[1] = xx;
}
for ( i = 0 ; i < SDIM ; i++ ) side[i] = x[1][i] - x[0][i];
memset((char*)forces,0,sizeof(forces)); /* set to 0 */
add_vertex_valence(tv,1);
add_vertex_valence(hv,1);
/* force due to linear tension */
if ( web.metric_flag )
{ if ( klein_metric_flag )
{ len = klein_length(x[0],x[1]);
klein_length_grad(x[0],x[1],forces[0],forces[1]);
}
else
{ len = simplex_energy_metric(v,x);
simplex_force_metric(v,x,density,forceptr);
}
}
else len = sqrt(SDIM_dot(side,side));
set_edge_length(e_id,len);
/* add to endpoint stars */
add_vertex_star(tv,len);
add_vertex_star(hv,len);
if ( !web.metric_flag )
if ( len != 0.0 )
for ( i = 0 ; i < SDIM ; i++ )
{ forces[0][i] += density*side[i]/len;
forces[1][i] -= density*side[i]/len;
}
/* calculate gravitational forces */
if ( web.gravflag && !(get_eattr(e_id) & NONCONTENT) )
{ REAL *t,*h;
REAL gdensity = edge_grav_density(e_id);
if ( gdensity != 0.0 )
{ t = get_coord(tv);
h = get_coord(hv);
forces[0][0] += -gdensity*(t[1]*t[1] + t[1]*h[1] + h[1]*h[1])/6;
forces[1][0] += gdensity*(t[1]*t[1] + t[1]*h[1] + h[1]*h[1])/6;
forces[0][1] += -gdensity*(t[0]-h[0])*(2*t[1] + h[1])/6;
forces[1][1] += -gdensity*(t[0]-h[0])*(t[1] + 2*h[1])/6;
}
}
force[0] = get_force(tv);
force[1] = get_force(hv);
if ( web.symmetry_flag )
{ REAL wforce[MAXCOORD]; /* unwrapped forces */
REAL *t = get_coord(tv);
for ( j = 0 ; j < SDIM ; j++ )
force[0][j] += forces[0][j];
wraps[1] = get_edge_wrap(e_id);
(*sym_form_pullback)(t,wforce,forces[1],wraps[1]);
for ( j = 0 ; j < SDIM ; j++ )
force[1][j] += wforce[j];
}
else
for ( i = 0 ; i < 2 ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
force[i][j] += forces[i][j];
}
/******************************************************************
*
* Function: edge_grav_density()
*
* Purpose: Finds gravitational energy density multiplier across
* an edge in the string model. Includes grav const.
*/
REAL edge_grav_density(e_id)
edge_id e_id;
{
facetedge_id fe,first_fe;
body_id b_id;
REAL density = 0.0;
facet_id f_id;
/* if body is on facet agreeing with edge orientation,
then pressure is positive. */
fe = first_fe = get_edge_fe(e_id);
while ( valid_id(fe) )
{ f_id = get_fe_facet(fe);
b_id = get_facet_body(f_id);
if ( (valid_id(b_id)) && (get_battr(b_id) & DENSITY) )
density += get_body_density(b_id);
b_id = get_facet_body(inverse_id(f_id));
if ( (valid_id(b_id)) && (get_battr(b_id) & DENSITY) )
density -= get_body_density(b_id);
fe = get_next_facet(fe);
if ( equal_id(fe,first_fe) ) break;
}
return web.grav_const*density;
}
/**********************************************************************
*
* Adds contribution of edge to areas of neighboring facets, via
* Green's theorem. x-y plane only.
*
*/
void edge_area_l(fe_id)
facetedge_id fe_id;
{
REAL *xt,*xh;
REAL area;
body_id b_id1,b_id2; /* bodies to add area to */
facet_id f_id1,f_id2; /* facets to add area to */
edge_id e_id = get_fe_edge(fe_id);
if ( get_eattr(e_id) & NONCONTENT ) return;
if ( inverted(e_id) ) { fe_id = inverse_id(fe_id); e_id = inverse_id(e_id); }
f_id1 = get_fe_facet(fe_id);
f_id2 = facet_inverse(get_fe_facet(fe_id));
if ( !valid_id(f_id1) && !valid_id(f_id2) ) return; /* no facets */
b_id1 = get_facet_body(f_id1);
b_id2 = get_facet_body(f_id2);
if ( web.torus_flag )
{ REAL v1,v2,v3,v4;
int wx,wy; /* wraps */
WRAPTYPE wrap = get_edge_wrap(e_id);
/* new way, accurate modulo unit cell area */
area = 0.0;
xt = get_coord(get_edge_tailv(e_id));
xh = get_coord(get_edge_headv(e_id));
v1 = dot(web.inverse_periods[0],xt,2);
v2 = dot(web.inverse_periods[0],xh,2);
v3 = dot(web.inverse_periods[1],xt,2);
v4 = dot(web.inverse_periods[1],xh,2);
wx = WRAPNUM(wrap & WRAPMASK);
wy = WRAPNUM((wrap>>TWRAPBITS) & WRAPMASK);
area += wy*(v2+wx);
area -= ((v2+wx - v1)*(v4+wy + v3)/2 );
area *= web.torusv;
} /* end torus */
else
{
xt = get_coord(get_edge_tailv(e_id));
xh = get_coord(get_edge_headv(e_id));
/* calculate area above x1 axis */
area = (xt[0] - xh[0])*(xt[1] + xh[1])/2;
}
/* add to cell areas */
if ( valid_id(f_id1) )
add_facet_area(f_id1,area);
if ( valid_id(b_id1) )
add_body_volume(b_id1,area);
if ( valid_id(b_id2) )
add_body_volume(b_id2,-area);
}
/***********************************************************************
*
* Function: string_grad_l()
*
* Purpose: construct vertex area gradients
* Note: force is local, so toroidal wrappings don't matter,
* as long as we get the edges right, which get_edge_side() does.
*
*/
void string_grad_l()
{
body_id bi_id; /* identifier for body i */
facetedge_id fe_id;
REAL side[MAXCOORD];
volgrad *hvgptr,*tvgptr;
vertex_id headv,tailv;
facet_id f_id;
edge_id e_id;
REAL *xt,*xh;
int i;
FOR_ALL_FACETEDGES(fe_id)
{
/* see which side has body, if any */
f_id = get_fe_facet(fe_id);
bi_id = get_facet_body(f_id);
if ( !valid_id(bi_id) )
{ invert(fe_id);
bi_id = get_facet_body(get_fe_facet(fe_id));
}
if ( !valid_id(bi_id) ) continue; /* nothing here */
if ( !(get_battr(bi_id) & (FIXEDVOL|PRESSURE) ) ) continue;
e_id = get_fe_edge(fe_id);
if ( get_eattr(e_id) & NONCONTENT ) continue;
get_edge_side(e_id,side);
headv = get_fe_headv(fe_id);
tailv = get_fe_tailv(fe_id);
xt = get_coord(tailv);
xh = get_coord(headv);
/* gradient due to edge */
hvgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),headv);
hvgptr->bb_id = bi_id;
tvgptr = get_bv_new_vgrad(get_body_fixnum(bi_id),tailv);
tvgptr->bb_id = bi_id;
if ( web.torus_flag )
{ REAL v1,v2,v3,v4;
int wx=0,wy=0; /* wraps */
WRAPTYPE wrap = get_edge_wrap(e_id);
REAL hgrad[MAXCOORD];
REAL tgrad[MAXCOORD];
/* new way, accurate modulo unit cell area */
for ( i = 0 ; i < SDIM ; i++ ) hgrad[i] = tgrad[i] = 0.0;
xt = get_coord(get_edge_tailv(e_id));
xh = get_coord(get_edge_headv(e_id));
v1 = dot(web.inverse_periods[0],xt,2);
v2 = dot(web.inverse_periods[0],xh,2);
v3 = dot(web.inverse_periods[1],xt,2);
v4 = dot(web.inverse_periods[1],xh,2);
wx = WRAPNUM(wrap & WRAPMASK);
wy = WRAPNUM((wrap>>TWRAPBITS) & WRAPMASK);
if ( wy )
for ( i = 0 ; i < SDIM ; i++ )
hgrad[i] += wy*web.inverse_periods[0][i];
for ( i = 0 ; i < SDIM ; i++ )
{ hgrad[i] -= (v4+wy + v3)/2*web.inverse_periods[0][i];
tgrad[i] += (v4+wy + v3)/2*web.inverse_periods[0][i];
hgrad[i] -= (v2+wx - v1)/2*web.inverse_periods[1][i];
tgrad[i] -= (v2+wx - v1)/2*web.inverse_periods[1][i];
}
for ( i = 0 ; i < SDIM ; i++ )
{ hvgptr->grad[i] += web.torusv*hgrad[i];
tvgptr->grad[i] += web.torusv*tgrad[i];
}
} /* end torus */
else
{ /* grads of area = (xt[0] - xh[0])*(xt[1] + xh[1])/2 */
hvgptr->grad[0] += -(xt[1] + xh[1])/2;
hvgptr->grad[1] += (xt[0] - xh[0])/2;
tvgptr->grad[0] += (xt[1] + xh[1])/2;
tvgptr->grad[1] += (xt[0] - xh[0])/2;
}
}
}
/*******************************************************************
*
* Function: string_bdry_grad()
*
* Purpose: Add cell area gradients due to boundary integrals.
*/
void string_bdry_grad()
{
vertex_id v_id;
REAL dummy,partial[MAXCOORD]; /* for eval_all */
int i;
FOR_ALL_VERTICES(v_id)
{
volgrad *vgptri;
struct boundary *bdry;
ATTR attr = get_vattr(v_id);
edge_id e_id, start_e, next_e;
if ( attr & FIXED ) continue;
if ( !(attr & BOUNDARY) ) continue;
if ( !(attr & BDRY_CONTENT) ) continue;
bdry = get_boundary(v_id);
if ( bdry->pcount != 1 ) return ;
start_e = get_vertex_edge(v_id);
if ( !valid_id(start_e) ) continue;
next_e = start_e;
do
{ facetedge_id fe_id0,fe_id;
facet_id f_id;
body_id bf;
int sign;
e_id = next_e;
fe_id0 = get_edge_fe(e_id);
next_e = get_next_tail_edge(e_id);
if ( !valid_id(fe_id0) ) continue;
if ( get_eattr(e_id) & NONCONTENT ) continue;
eval_all(bdry->convect[0],get_param(v_id),bdry->pcount,&dummy,
partial,v_id);
vgptri = get_vertex_vgrad(v_id);
do
{
sign = 0;
fe_id = fe_id0;
do
{ f_id = get_fe_facet(fe_id);
bf = get_facet_body(f_id);
if ( equal_id(bf,vgptri->bb_id) )
{ sign = 1; break; }
else
{ facetedge_id fe_ida = inverse_id(fe_id);
f_id = get_fe_facet(fe_ida);
bf = get_facet_body(f_id);
if ( equal_id(bf,vgptri->bb_id) )
{ sign = -1; break; }
}
fe_id = get_next_facet(fe_id);
}
while ( fe_id != fe_id0 );
if ( sign )
for ( i = 0 ; i < bdry->pcount ; i++ )
vgptri->grad[i] += partial[i];
vgptri = vgptri->chain;
} while ( vgptri );
} while ( !equal_id(next_e,start_e) );
}
}
/*******************************************************************
*
* Function: string_constr_grad()
*
* Purpose: Add cell area gradients due to constraint integrals.
*/
void string_constr_grad()
{
vertex_id v_id;
edge_id e_id, next_e, start_e;
FOR_ALL_VERTICES(v_id)
{
struct volgrad *vgptri;
struct constraint *constr;
facetedge_id fe_id,fe_id0;
ATTR attr = get_vattr(v_id);
if ( attr & FIXED ) continue;
if ( !(attr & CONSTRAINT) ) continue;
if ( !(attr & BDRY_CONTENT) ) continue;
start_e = get_vertex_edge(v_id);
if ( !valid_id(start_e) ) continue;
e_id = next_e = start_e;
do
{ e_id = next_e;
fe_id0 = get_edge_fe(e_id);
next_e = get_next_tail_edge(e_id);
if ( !valid_id(fe_id0) ) continue;
if ( get_eattr(e_id) & NONCONTENT ) continue;
vgptri = get_vertex_vgrad(v_id);
while ( vgptri )
{
int sign=0,i,j;
conmap_t * conmap = get_v_constraint_map(v_id);
facet_id f_id;
body_id bf;
fe_id = fe_id0;
do
{ f_id = get_fe_facet(fe_id);
bf = get_facet_body(f_id);
if ( equal_id(bf,vgptri->bb_id) )
{ sign = 1; break; }
else
{ facetedge_id fe_ida = inverse_id(fe_id);
f_id = get_fe_facet(fe_ida);
bf = get_facet_body(f_id);
if ( equal_id(bf,vgptri->bb_id) )
{ sign = -1; break; }
}
fe_id = get_next_facet(fe_id);
}
while ( fe_id != fe_id0 );
if ( sign )
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
{ REAL val,derivs[MAXCOORD];
constr = get_constraint(conmap[j]);
if ( !(constr->attr & CON_CONTENT) ) continue;
eval_all(constr->convect[0],get_coord(v_id),SDIM,&val,derivs,v_id);
for ( i = 0 ; i < SDIM ; i++ )
vgptri->grad[i] -= sign*derivs[i];
}
vgptri = vgptri->chain;
}
}
while ( !equal_id(next_e,start_e) );
}
}
/*********************************************************************
edge_general method, linear and quadratic
*********************************************************************/
/*********************************************************************
*
* function: edge_general_init()
*
* purpose: check dimension of edge
*
*/
void edge_general_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.dimension > 2 )
kb_error(2189,
"Can only do edge_general_integral if edges are 1 dimensional.\n",
RECOVERABLE);
}
/*********************************************************************
*
* function: edge_general_value()
*
* purpose: method value
*
*/
REAL edge_general_value(e_info)
struct qinfo *e_info;
{ int m,k;
REAL value = 0.0;
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
if ( web.modeltype == LAGRANGE ) return edge_general_value_lagrange(e_info);
for ( m = 0 ; m < gauss1D_num ; m++ )
{ REAL weight = gauss1Dwt[m];
for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
value += weight*eval(METH_INSTANCE(e_info->method)->expr[0],z,e_info->id,NULL);
}
return value;
}
/*********************************************************************
*
* function: edge_general_grad()
*
* purpose: method gradient
*
*/
REAL edge_general_grad(e_info)
struct qinfo *e_info;
{ int m,j,k;
REAL value = 0.0;
REAL val;
REAL derivs[2*MAXCOORD];
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
if ( web.modeltype == LAGRANGE ) return edge_general_grad_lagrange(e_info);
for ( m = 0 ; m < gauss1D_num ; m++ )
{ REAL weight = gauss1Dwt[m];
for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
eval_all(METH_INSTANCE(e_info->method)->expr[0],z,2*SDIM,&val,derivs,e_info->id);
value += weight*val;
for ( k = 0 ; k < edge_ctrl ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
e_info->grad[k][j] += weight*(gauss1poly[k][m]*derivs[j]
+ gauss1polyd[k][m]*derivs[j+SDIM]);
}
return value;
}
/*********************************************************************
*
* function: edge_general_hess()
*
* purpose: method hessian
*
*/
REAL edge_general_hess(e_info)
struct qinfo *e_info;
{ int m,j,jj,k,kk;
REAL value = 0.0;
REAL val;
REAL derivs[2*MAXCOORD];
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
MAT2D(second,2*MAXCOORD,2*MAXCOORD); /* second derivatives */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
if ( web.modeltype == LAGRANGE ) return edge_general_hess_lagrange(e_info);
for ( m = 0 ; m < gauss1D_num ; m++ )
{ REAL weight = gauss1Dwt[m];
for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
eval_second(METH_INSTANCE(e_info->method)->expr[0],z,2*SDIM,&val,derivs,second,e_info->id);
value += weight*val;
for ( k = 0 ; k < edge_ctrl ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
e_info->grad[k][j] += weight*(gauss1poly[k][m]*derivs[j]
+ gauss1polyd[k][m]*derivs[j+SDIM]);
for ( k = 0 ; k < edge_ctrl ; k++ )
for ( kk = 0 ; kk < edge_ctrl ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
e_info->hess[k][kk][j][jj] += weight*
(gauss1poly[k][m]*gauss1poly[kk][m]*second[j][jj] +
gauss1polyd[k][m]*gauss1poly[kk][m]*second[j+SDIM][jj] +
gauss1poly[k][m]*gauss1polyd[kk][m]*second[j][jj+SDIM] +
gauss1polyd[k][m]*gauss1polyd[kk][m]*second[j+SDIM][jj+SDIM]);
}
return value;
}
/*********************************************************************
*
* function: edge_general_value_lagrange()
*
* purpose: method value
*
*/
REAL edge_general_value_lagrange(e_info)
struct qinfo *e_info;
{ int m,k;
REAL value = 0.0;
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ ) /* integration point number */
{ for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
value += gl->gausswt[m]*eval(METH_INSTANCE(e_info->method)->expr[0],z,e_info->id,NULL);
}
return value;
}
/*********************************************************************
*
* function: edge_general_grad_lagrange()
*
* purpose: method gradient
*
*/
REAL edge_general_grad_lagrange(e_info)
struct qinfo *e_info;
{ int m,j,k;
REAL value = 0.0;
REAL val;
REAL derivs[2*MAXCOORD];
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ ) /* integration point number */
{ REAL weight = gl->gausswt[m];
for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
eval_all(METH_INSTANCE(e_info->method)->expr[0],z,2*SDIM,&val,derivs,e_info->id);
value += weight*val;
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
e_info->grad[k][j] += weight*(gl->gpoly[m][k]*derivs[j]
+ gl->gpolypart[m][0][k]*derivs[j+SDIM]);
}
return value;
}
/*********************************************************************
*
* function: edge_general_hess_lagrange()
*
* purpose: method hessian
*
*/
REAL edge_general_hess_lagrange(e_info)
struct qinfo *e_info;
{ int m,j,jj,k,kk;
REAL value = 0.0;
REAL val;
REAL derivs[2*MAXCOORD];
REAL z[2*MAXCOORD+1]; /* pointers to coord and tangent */
MAT2D(second,2*MAXCOORD,2*MAXCOORD); /* second derivatives */
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL weight = gl->gausswt[m];
for ( k = 0 ; k < SDIM ; k++ )
{ z[k] = e_info->gauss_pt[m][k];
z[SDIM+k] = sign*e_info->sides[m][0][k];
}
z[2*SDIM] = m; /* kludge for attr interp */
eval_second(METH_INSTANCE(e_info->method)->expr[0],z,2*SDIM,&val,derivs,second,e_info->id);
value += weight*val;
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
e_info->grad[k][j] += weight*(gl->gpoly[m][k]*derivs[j]
+ gl->gpolypart[m][0][k]*derivs[j+SDIM]);
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( kk = 0 ; kk < gl->lagpts ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
e_info->hess[k][kk][j][jj] += weight*
(gl->gpoly[m][k]*gl->gpoly[m][kk]*second[j][jj] +
gl->gpolypart[m][0][k]*gl->gpoly[m][kk]*second[j+SDIM][jj] +
gl->gpoly[m][k]*gl->gpolypart[m][0][kk]*second[j][jj+SDIM] +
gl->gpolypart[m][0][k]*gl->gpolypart[m][0][kk]*second[j+SDIM][jj+SDIM]);
}
return value;
}
evolver-2.30c.dfsg/src/matrix.c 0000644 0001753 0001753 00000271572 11410765113 016703 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/* matrix.c */
/* matrix routines, mostly from Numerical Recipes */
/* Note: matrix allocation routine assumes whole matrix can be
allocated in one call to calloc. If not true (say for large
matrices on an IBM PC), dmatrix() and free_matrix() will
have to be modified */
/* Note: Matrices allocated as row-pointer structures.
The -1 index is used to store a private copy of
pointer to memory, so users may swap row pointers freely.
*/
#include "include.h"
#ifdef BLAS
/* prototypes */
void DPOTRF ARGS((char*,int*,double*,int*,int*));
void DPOTRS ARGS((char*,int*,int*,double*,int*,double*,int*,int*));
void DGEMM ARGS((char*,char*,int*,int*,int*,double*,
double*,int*,double*,int*,double*,double*,int*));
void DSYMM ARGS((char*,char*,int*,int*,double*,double*,int*,
double*,int*,double*,double*,int*));
void DGEMV ARGS((char*,int*,int*,double*,double*,int*,double*,int*,double*,
double*,int*));
void DSYMV ARGS((char*,int*,double*,double*,int*,double*,int*,double*,
double*,int*));
#endif
/******************************************************************
*
* Function: matcopy()
*
* Purpose: copies matrix b to matrix a
* for zero-base indexing only
*/
void matcopy ARGS4((a,b,rows,cols),
REAL **a, REAL **b,
int rows, int cols)
{
int i;
for ( i = 0 ; i < rows ; i++ )
memcpy((char *)a[i],(char *)b[i],cols*sizeof(REAL));
}
/******************************************************************
*
* Function: kb_dmatrix()
*
* Purpose: Allocates zeroed 2D matrix in pointer-pointer form,
* a REAL matrix with range [rlo..rhi][clo..chi]
*/
#ifdef MEMSTRINGS
REAL **kb_dmatrix ARGS6((rlo,rhi,clo,chi,file,line),
int rlo, int rhi, int clo, int chi,
char *file, int line)
#else
REAL **kb_dmatrix ARGS4((rlo,rhi,clo,chi),
int rlo, int rhi, int clo, int chi)
#endif
{
int i;
REAL **m;
#ifdef MEMSTRINGS
if ( memdebug)
{ sprintf(msg,"dmatrix from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( rhi-rlo+1 == 0 ) return NULL;
m = (REAL **)mycalloc((unsigned)(rhi-rlo+1+1),sizeof(REAL *));
m -= rlo;
m++; /* room for private pointer */
m[rlo-1] = (REAL *) mycalloc((unsigned)(chi-clo+1),(rhi-rlo+1)*sizeof(REAL));
for ( i = rlo ; i <= rhi ; i++ )
m[i] = m[rlo-1] + (i - rlo)*(chi - clo + 1) - clo;
return m;
}
/******************************************************************
*
* Function: kb_dmatrix3()
*
* Purpose: Allocates a zeroed 3D matrix in pointer-pointer-pointer form,
* a REAL matrix with range [0..n1-1][0..n2-1][0..n3-1]
*
*/
#ifdef MEMSTRINGS
REAL ***kb_dmatrix3 ARGS5((n1,n2,n3,file,line),
int n1, int n2,int n3,
char * file, int line)
#else
REAL ***kb_dmatrix3 ARGS3((n1,n2,n3),
int n1,int n2,int n3)
#endif
{
int i,j;
REAL ***m;
#ifdef MEMSTRINGS
if ( memdebug )
{ sprintf(msg,"dmatrix3 from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( n1 <= 0 ) n1 = 1;
if ( n2 <= 0 ) n2 = 1;
/* assumes all pointers same machine size and alignment */
m = (REAL ***)mycalloc((n2+1)*n1+1,sizeof(REAL **));
m++; /* room for private pointer to doubles */
for ( i = 0 ; i < n1 ; i++ )
m[i] = (REAL **)(m + n1 + i*n2);
m[0][0] = (REAL *) mycalloc(n1*n2*n3,sizeof(REAL));
m[-1] = (REAL **)(m[0][0]);
for ( i = 0 ; i < n1 ; i++ )
for ( j = 0 ; j < n2 ; j++ )
m[i][j] = m[0][0] + i*n2*n3 + j*n3;
return m;
}
/*********************************************************************
*
* function: matrix3_reorder()
*
* purpose: Reorder data of a 3D matrix into canonical order.
* Creates new matrix, and frees old one.
*
* return:
*/
REAL *** matrix3_reorder ARGS4((a,maxi,maxj,maxk),
REAL ***a,
int maxi, int maxj, int maxk) /* dimensions */
{ int i,j,k;
REAL ***newa;
newa = dmatrix3(maxi,maxj,maxk);
for ( i = 0 ; i < maxi; i++ )
for ( j = 0 ; j < maxj ; j++ )
for ( k = 0 ; k < maxk ; k++ )
newa[i][j][k] = a[i][j][k];
free_matrix3(a);
return newa;
}
/******************************************************************
*
* Function: kb_dmatrix4()
*
* Purpose: Allocates a zeroed 4D matrix in pointer form,
* a REAL matrix with range [0..n1-1][0..n2-1][0..n3-1][0..n4-1]
*/
#ifdef MEMSTRINGS
REAL ****kb_dmatrix4 ARGS6((n1,n2,n3,n4,file,line),
int n1, int n2, int n3, int n4,
char * file, int line)
#else
REAL ****kb_dmatrix4 ARGS4((n1,n2,n3,n4),
int n1, int n2, int n3, int n4)
#endif
{
int i,j,k;
REAL ****m;
#ifdef MEMSTRINGS
if ( memdebug )
{ sprintf(msg,"dmatrix4 from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( n1 <= 0 ) n1 = 1;
if ( n2 <= 0 ) n2 = 1;
if ( n3 <= 0 ) n3 = 1;
/* assumes all pointers same machine size and alignment */
m = (REAL ****)mycalloc(1+n1+n1*n2+n1*n2*n3,sizeof(REAL ***));
m++; /* room for private pointer */
for ( i = 0 ; i < n1 ; i++ )
{ m[i] = (REAL ***)(m + n1 + i*n2);
for ( j = 0 ; j < n2 ; j++ )
m[i][j] = (REAL **)(m + n1 + n1*n2 + i*n2*n3 + j*n3);
}
m[0][0][0] = (REAL *) mycalloc(n1*n2*n3*n4,sizeof(REAL));
m[-1] = (REAL***)(m[0][0][0]);
for ( i = 0 ; i < n1 ; i++ )
for ( j = 0 ; j < n2 ; j++ )
for ( k = 0 ; k < n3 ; k++ )
m[i][j][k] = m[0][0][0] + i*n2*n3*n4 + j*n3*n4 + k*n4;
return m;
}
/******************************************************************
*
* Function: kb_temp_dmatrix()
*
* Purpose: Allocates zeroed 2D matrix in pointer-pointer form,
* a REAL matrix with range [rlo..rhi][clo..chi]
* Temporary memory.
*/
#ifdef MEMSTRINGS
REAL **kb_temp_dmatrix ARGS6((rlo,rhi,clo,chi,file,line),
int rlo, int rhi, int clo, int chi,
char *file, int line)
#else
REAL **kb_temp_dmatrix ARGS4((rlo,rhi,clo,chi),
int rlo, int rhi, int clo, int chi)
#endif
{
int i;
REAL **m;
#ifdef MEMSTRINGS
if ( memdebug)
{ sprintf(msg,"temp_dmatrix from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( rhi-rlo+1 == 0 ) return NULL;
m = (REAL **)temp_calloc((unsigned)(rhi-rlo+1+1),sizeof(REAL *));
m -= rlo;
m++; /* room for private pointer */
m[rlo-1] = (REAL *) temp_calloc((unsigned)(chi-clo+1),(rhi-rlo+1)*sizeof(REAL));
for ( i = rlo ; i <= rhi ; i++ )
m[i] = m[rlo-1] + (i - rlo)*(chi - clo + 1) - clo;
return m;
}
/******************************************************************
*
* Function: kb_temp_dmatrix3()
*
* Purpose: Allocates a zeroed 3D matrix in pointer-pointer-pointer form,
* a REAL matrix with range [0..n1-1][0..n2-1][0..n3-1]
* Temporary memory.
*
*/
#ifdef MEMSTRINGS
REAL ***kb_temp_dmatrix3 ARGS5((n1,n2,n3,file,line),
int n1, int n2,int n3,
char * file, int line)
#else
REAL ***kb_temp_dmatrix3 ARGS3((n1,n2,n3),
int n1,int n2,int n3)
#endif
{
int i,j;
REAL ***m;
#ifdef MEMSTRINGS
if ( memdebug )
{ sprintf(msg,"temp_dmatrix3 from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( n1 <= 0 ) n1 = 1;
if ( n2 <= 0 ) n2 = 1;
/* assumes all pointers same machine size and alignment */
m = (REAL ***)temp_calloc((n2+1)*n1+1,sizeof(REAL **));
m++; /* room for private pointer to doubles */
for ( i = 0 ; i < n1 ; i++ )
m[i] = (REAL **)(m + n1 + i*n2);
m[0][0] = (REAL *) temp_calloc(n1*n2*n3,sizeof(REAL));
m[-1] = (REAL **)(m[0][0]);
for ( i = 0 ; i < n1 ; i++ )
for ( j = 0 ; j < n2 ; j++ )
m[i][j] = m[0][0] + i*n2*n3 + j*n3;
return m;
}
/******************************************************************
*
* Function: kb_temp_dmatrix4()
*
* Purpose: Allocates a zeroed 4D matrix in pointer form,
* a REAL matrix with range [0..n1-1][0..n2-1][0..n3-1][0..n4-1]
* Temporary memory.
*/
#ifdef MEMSTRINGS
REAL ****kb_temp_dmatrix4 ARGS6((n1,n2,n3,n4,file,line),
int n1, int n2, int n3, int n4,
char * file, int line)
#else
REAL ****kb_temp_dmatrix4 ARGS4((n1,n2,n3,n4),
int n1, int n2, int n3, int n4)
#endif
{
int i,j,k;
REAL ****m;
#ifdef MEMSTRINGS
if ( memdebug )
{ sprintf(msg,"temp_dmatrix4 from %s %d.\n",file,line);
outstring(msg);
}
#endif
if ( n1 <= 0 ) n1 = 1;
if ( n2 <= 0 ) n2 = 1;
if ( n3 <= 0 ) n3 = 1;
/* assumes all pointers same machine size and alignment */
m = (REAL ****)temp_calloc(1+n1+n1*n2+n1*n2*n3,sizeof(REAL ***));
m++; /* room for private pointer */
for ( i = 0 ; i < n1 ; i++ )
{ m[i] = (REAL ***)(m + n1 + i*n2);
for ( j = 0 ; j < n2 ; j++ )
m[i][j] = (REAL **)(m + n1 + n1*n2 + i*n2*n3 + j*n3);
}
m[0][0][0] = (REAL *) temp_calloc(n1*n2*n3*n4,sizeof(REAL));
m[-1] = (REAL***)(m[0][0][0]);
for ( i = 0 ; i < n1 ; i++ )
for ( j = 0 ; j < n2 ; j++ )
for ( k = 0 ; k < n3 ; k++ )
m[i][j][k] = m[0][0][0] + i*n2*n3*n4 + j*n3*n4 + k*n4;
return m;
}
/**********************************************************************
*
* Function: perm_matrix2()
*
* purpose: Allocate pointer-style 2D matrix in permanent memory.
*/
REAL **perm_matrix2(rows,cols)
int rows,cols;
{ REAL **m;
int i;
m = (double**)calloc(rows,sizeof(double*));
m[0] = (double*)calloc(rows*cols,sizeof(double));
for ( i = 1 ; i < rows ; i++ )
m[i] = m[i-1] + cols;
return m;
}
/******************************************************************
*
* Function: matNd_setup()
*
* Purpose: routines for initializing matrices declared as local variables
* with MAT2D etc macros. Note it does not zero the entries!
*/
REAL ** mat2d_setup ARGS4((name,spacename,rows,cols),
REAL **name,
REAL *spacename,
int rows, int cols)
{ REAL **spot = name;
for ( ; rows > 0 ; rows--,spacename += cols,spot++ )
*spot = spacename;
return name;
}
REAL *** mat3d_setup ARGS5((name,spacename,rows,cols,levels),
REAL ***name,
REAL *spacename,
int rows, int cols, int levels)
{ int i;
REAL ***spot;
REAL **row = (REAL **)(name + rows);
for ( spot = name ; rows > 0 ; rows--,spot++ )
{ *spot = row;
for ( i = 0 ; i < cols ; i++,spacename += levels, row++ )
*row = spacename;
}
return name;
}
REAL **** mat4d_setup ARGS6((name,spacename,rows,cols,levels,tiers),
REAL ****name,
REAL *spacename,
int rows, int cols, int levels, int tiers)
{ int i,j;
REAL ***row = (REAL ***)(name + rows);
REAL **col = (REAL **)(name + rows + rows*cols);
REAL ****spot;
for (spot=name ; rows > 0 ; rows--,spot++ )
{ *spot = row;
for ( i = 0 ; i < cols ; i++, row++ )
{ *row = col;
for ( j = 0 ; j < levels ; j++,spacename += tiers, col++ )
*col = spacename;
}
}
return name;
}
/* end local declaration routines */
/******************************************************************
*
* Function: ivector()
*
* Purpose: allocate integer or real vector with given index range.
*/
int *ivector ARGS2((lo,hi),
int lo, int hi)
/* allocates a int vector with range [lo..hi] */
{
int *v;
v = (int *)mycalloc((unsigned)(hi-lo+1),sizeof(int));
return v-lo;
}
void free_ivector ARGS3((v,lo,hi),
int *v, int lo,int hi)
{
myfree((char *)(v+lo));
}
/******************************************************************
*
* Function: free_matrixN()
*
* Purpose: Deallocate storage allocated by kb_dmatrixN().
*/
void free_matrix ARGS1((m),
REAL **m)
{
if ( !m ) return;
myfree((char *)m[-1]); /* using private pointer */
myfree((char *)(m-1));
}
void free_matrix3 ARGS1((m),
REAL ***m)
{
if ( !m ) return;
myfree((char *)m[-1]);
myfree((char *)(m-1));
}
void free_matrix4 ARGS1((m),
REAL ****m)
{
if ( !m ) return;
myfree((char *)m[-1]);
myfree((char *)(m-1));
}
void free_temp_matrix ARGS1((m),
REAL **m)
{
if ( !m ) return;
temp_free((char *)m[-1]); /* using private pointer */
temp_free((char *)(m-1));
}
void free_temp_matrix3 ARGS1((m),
REAL ***m)
{
if ( !m ) return;
temp_free((char *)m[-1]);
temp_free((char *)(m-1));
}
void free_temp_matrix4 ARGS1((m),
REAL ****m)
{
if ( !m ) return;
temp_free((char *)m[-1]);
temp_free((char *)(m-1));
}
/******************************************************************
*
* Function: vector_add()
*
* Purpose: add vector b to vector a
*/
void vector_add ARGS3((a,b,n),
REAL *a, REAL *b,
int n)
{ for(;n!=0;n--) *(a++) += *(b++);
}
/******************************************************************
*
* Function: vector_add_smul()
*
* Purpose: add scalar multiple of vector b to vector a
*/
void vector_add_smul ARGS4((a,b,c,n),
REAL *a, REAL *b,
REAL c,
int n)
{ for(;n!=0;n--) *(a++) += c*(*(b++));
}
/******************************************************************
*
* Function: vector_sub()
*
* Purpose: subtract vector b from vector a
*/
void vector_sub ARGS3((a,b,n),
REAL *a, REAL *b,
int n)
{ for(;n!=0;n--) *(a++) -= *(b++);
}
/******************************************************************
*
* Function: vnormal()
*
* Purpose: given 3 points, find cross product of sides
*/
void vnormal ARGS4((a,b,c,n),
REAL *a, REAL *b, REAL *c, REAL *n)
{
REAL aa[MAXCOORD],bb[MAXCOORD];
int i;
for ( i = 0 ; i < SDIM ; i++ )
{ aa[i] = a[i] - c[i];
bb[i] = b[i] - c[i];
}
cross_prod(aa,bb,n);
}
/******************************************************************
*
* Function: cross_product()
*
* Purpose; Find 3D cross product of a and b, return in c
*/
void cross_prod ARGS3((a,b,c),
REAL *a, REAL *b, REAL *c)
{
c[0] = a[1]*b[2] - a[2]*b[1];
c[1] = a[2]*b[0] - a[0]*b[2];
c[2] = a[0]*b[1] - a[1]*b[0];
}
/******************************************************************
*
* Function: triple_prod()
*
* Purpose: Find scalar triple product in 3D.
*/
REAL triple_prod ARGS3((a,b,c),
REAL *a, REAL *b, REAL *c)
{
return a[0]*(b[1]*c[2] - b[2]*c[1]) - a[1]*(b[0]*c[2] - b[2]*c[0])
+ a[2]*(b[0]*c[1] - b[1]*c[0]);
}
/******************************************************************
*
* Function: dot(), dotdf(), dotf()
*
* Purpose: dot products of various REALs and floats.
*
*/
/* dot product of REALS */
REAL dot ARGS3((a,b,n),
REAL *a, REAL *b,
int n) /* number of items */
{
REAL x = 0.0;
for ( ; --n >= 0 ; ) x += (*(a++))*(*(b++));
return x;
}
/* dot product for doubles and floats */
REAL dotdf ARGS3((a,b,n),
REAL *a,
float *b,
int n) /* number of items */
{
REAL x = 0.0;
for ( ; --n >= 0 ; ) x += (*(a++))*(*(b++));
return x;
}
/* dot product for floats */
REAL dotf ARGS3((a,b,n),
float *a, float *b,
int n) /* number of items */
{
REAL x = 0.0;
for ( ; --n >= 0 ; ) x += (*(a++))*(*(b++));
return x;
}
/******************************************************************
*
* Function: matvec_mul()
*
* Purpose: matrix times vector multiplication, c = a * b
*/
void matvec_mul ARGS5((a,b,c,rows,cols),
REAL **a, REAL *b, REAL *c,
int rows, int cols)
{
int i,j;
for ( i = 0 ; i < rows ; i++ )
{ c[i] = 0.0;
for ( j = 0 ; j < cols ; j++ )
c[i] += a[i][j]*b[j];
}
}
/******************************************************************
*
* Function: vec_mat_mul()
*
* Purpose: vector times matrix multiplication, c = a * b
*/
void vec_mat_mul ARGS5((a,b,c,rows,cols),
REAL *a, REAL **b, REAL *c,
int rows, int cols)
{
int i,j;
for ( i = 0 ; i < cols ; i++ )
{ c[i] = 0.0;
for ( j = 0 ; j < rows ; j++ )
c[i] += a[j]*b[j][i];
}
}
/******************************************************************
*
* Function: mat_mult()
*
* Purpose: matrix by matrix multiplication, c = a * b
* a is imax x jmax, b is jmax x kmax, c is imax x kmax
* a, b, and c need not be distinct.
* Tests for zero entries in first matrix for larger matrices,
* so if one matrix is sparse, put it first.
*/
void mat_mult ARGS6((a,b,c,imax,jmax,kmax),
REAL **a, REAL **b, REAL **c, /* not assumed distinct */
int imax, int jmax,int kmax)
{ int i,j,k;
if ( (a == c) || (b == c) )
{ if ( (imax<=MAXCOORD)&&(kmax<=MAXCOORD))
{ MAT2D(temp,MAXCOORD,MAXCOORD); /* local temp space */
for ( i = 0 ; i < imax ; i++ )
for ( k = 0 ; k < kmax ; k++ )
for ( j = 0, temp[i][k] = 0.0 ; j < jmax ; j++ )
temp[i][k] += a[i][j]*b[j][k];
matcopy(c,temp,imax,kmax);
}
else /* have to go to the effort to get temp work space */
{ REAL **temp = dmatrix(0,imax-1,0,kmax-1); /* temporary storage */
for ( i = 0 ; i < imax ; i++ )
for ( j = 0 ; j < jmax ; j++ )
{ REAL aa = a[i][j];
if ( aa==0.0 ) continue;
for ( k = 0 ; k < kmax ; k++ )
temp[i][k] += aa*b[j][k];
}
matcopy(c,temp,imax,kmax);
free_matrix(temp);
}
}
else
{ for ( i = 0 ; i < imax ; i++ )
{ for ( k = 0 ; k < kmax ; k++ ) c[i][k] = 0.0;
for ( j = 0 ; j < jmax ; j++ )
{ REAL aa = a[i][j];
if ( aa == 0.0 ) continue;
for ( k = 0 ; k < kmax ; k++ )
c[i][k] += aa*b[j][k];
}
}
}
}
/******************************************************************
*
* Function: tr_mat_mul()
*
* Purpose: matrix transpose by matrix multiplication
* output: c = aT*b
* a is imax x jmax, b is imax x kmax, c is jmax x kmax
* a, b, and c need not be distinct.
*/
void tr_mat_mul ARGS6((a,b,c,imax,jmax,kmax),
REAL **a, REAL **b, REAL **c, /* not assumed distinct */
int imax,int jmax,int kmax)
{
REAL **temp; /* temporary storage, if needed */
int i,j,k;
if ( (a == c) || (b == c) )
{ temp = dmatrix(0,jmax-1,0,kmax-1); /* temporary storage */
for ( j = 0 ; j < jmax ; j++ )
for ( k = 0 ; k < kmax ; k++ )
for ( i = 0 ; i < imax ; i++ )
temp[j][k] += a[i][j]*b[i][k];
matcopy(c,temp,jmax,kmax);
free_matrix(temp);
}
else
{ REAL *s;
for ( j = 0 ; j < jmax ; j++ )
for ( k = 0, s = c[j] ; k < kmax ; k++,s++ )
{ *s = 0.0;
for ( i = 0 ; i < imax ; i++ )
*s += a[i][j]*b[i][k];
}
}
}
/******************************************************************
*
* Function: mat_mul_tr()
*
* Purpose: matrix by matrix transpose multiplication, c = a * bT
* a is imax x jmax, b is kmax x jmax, c is imax x kmax
* a, b, and c need not be distinct.
*/
void mat_mul_tr ARGS6((a,b,c,imax,jmax,kmax),
REAL **a, REAL **b, REAL **c, /* not assumed distinct */
int imax, int jmax, int kmax)
{
REAL **temp; /* temporary storage, if needed */
int i,j,k;
if ( (a == c) || (b == c) )
{ temp = dmatrix(0,imax-1,0,kmax-1); /* temporary storage */
for ( i = 0 ; i < imax ; i++ )
for ( j = 0 ; j < jmax ; j++ )
for ( k = 0 ; k < kmax ; k++ )
temp[i][k] += a[i][j]*b[k][j];
matcopy(c,temp,imax,kmax);
free_matrix(temp);
}
else
{
for ( k = 0 ; k < kmax ; k++ )
{ for ( i = 0 ; i < imax ; i++ ) c[i][k] = 0.0;
for ( j = 0 ; j < jmax ; j++ )
{ REAL bb = b[k][j];
if ( bb == 0.0 ) continue;
for ( i = 0 ; i < imax ; i++ )
c[i][k] += a[i][j]*bb;
}
}
}
}
/******************************************************************
*
* Function: mat_tsquare()
*
* Purpose: matrix times own transpose, b = a*aT
* a and b must be different.
*/
void mat_tsquare ARGS4((a,b,n,m),
REAL **a, /* original */
REAL **b, /* square b = a*aT */
int n, int m) /* a is nxm, b is nxn */
{
int i,j;
if ( a == b )
kb_error(2141,"mat_tsquare: a and b same (internal error).\n",RECOVERABLE);
for ( i = 0 ; i < n ; i++ )
for ( j = 0 ; j <= i ; j++ )
b[i][j] = b[j][i] = dot(a[i],a[j],m);
}
/******************************************************************
*
* Function: quadratic_form()
*
* Purpose: quadratic form evaluation, a*b*c; only uses lower triangle
*/
REAL quadratic_form ARGS4((a,b,c,n),
REAL *a, REAL **b, REAL *c,
int n) /* size */
{ int i,j;
REAL sum = 0.0;
REAL temp;
for ( i = 0 ; i < n ; i++ )
{ temp = b[i][0]*c[0];
for ( j = 1 ; j <= i ; j++ )
temp += b[i][j]*c[j];
for ( ; j < n ; j++ )
temp += b[j][i]*c[j];
sum += a[i]*temp;
}
return sum;
}
/******************************************************************
*
* Function: mat_inv()
*
* Purpose: in-place matrix inverse by gauss-jordan
* returns -1 for singular matrix,
* >= 0 for nonsingular, but value is not index, since
* pivoting is not symmetric.
*
*/
#define SWAP(a,b) {REAL temp = (a); (a) = (b); (b) = temp; }
#define SMALL 10
int mat_inv ARGS2((a,n),
REAL **a, /* matrix to invert in place */
int n) /* size of matrix */
{
int *indxc,*indxr,*ipiv;
int i,icol=0,irow=0,j,k,l,ll;
REAL big,dum,pivinv;
int retval = 1; /* default return value is success */
int temp1[SMALL],temp2[SMALL],temp3[SMALL]; /* avoid alloc for small sizes */
if ( n <= SMALL )
{ indxc = temp1; indxr = temp2; ipiv = temp3; }
else
{ /* large size */
indxc = ivector(0,n-1);
indxr = ivector(0,n-1);
ipiv = ivector(0,n-1);
}
for ( j = 0 ; j < n ; j++ )
ipiv[j] = -1;
for ( i = 0 ; i < n ; i++ )
{ /* find pivot */
big = 0.0;
for ( j = 0 ; j < n ; j++ )
{ if ( ipiv[j] != 0 )
for ( k = 0 ; k < n ; k++ )
{ if ( ipiv[k] == -1 )
{ if ( fabs(a[j][k]) >= big )
{ big = fabs(a[j][k]);
irow = j;
icol = k;
}
}
else
if ( ipiv[k] > 0 )
{ retval = -1; goto mat_inv_exit; }
}
}
++(ipiv[icol]);
if ( irow != icol )
for ( l = 0 ; l < n ; l++ )
SWAP(a[irow][l],a[icol][l])
indxr[i] = irow;
indxc[i] = icol;
if ( a[icol][icol] == 0.0 )
{ retval = -1; goto mat_inv_exit; }
pivinv = 1/a[icol][icol];
a[icol][icol] = 1.0;
for ( l = 0 ; l < n ; l++ )
a[icol][l] *= pivinv;
for ( ll = 0 ; ll < n ; ll++ )
if ( ll != icol )
{ dum = a[ll][icol];
a[ll][icol] = 0.0;
for ( l = 0 ; l < n ; l++ )
a[ll][l] -= a[icol][l]*dum;
}
}
for ( l = n-1 ; l >= 0 ; l-- )
{ if ( indxr[l] != indxc[l] )
for ( k = 0 ; k < n ; k++ )
SWAP(a[k][indxr[l]],a[k][indxc[l]])
}
mat_inv_exit:
if ( n > SMALL )
{ free_ivector(ipiv,0,n-1);
free_ivector(indxr,0,n-1);
free_ivector(indxc,0,n-1);
}
return retval;
} /* end mat_inv() */
/***********************************************************************
*
* Function: mat_approx_solve()
*
* Purpose: Solve dense linear system, possibly singular, with
* criterion for omitting singular rows. Meant for
* solving for redundant constraints.
*
* Return value: effective rank of matrix; solution in b
*/
REAL mat_approx_solve_epsilon = 1e-6;
int mat_approx_solve ARGS3((a,n,b),
REAL **a, /* matrix to invert in place */
int n, /* size of matrix */
REAL *b) /* right hand side */
{
int i,j,l,ll,irow=0;
REAL big,dum,pivinv;
int rank = n; /* return value is effective rank of matrix */
/* normalize row magnitudes */
for ( i = 0 ; i < n ; i++ )
{ REAL mag = 0.0;
for ( j = 0 ; j < n ; j++ )
mag += a[i][j]*a[i][j];
if ( mag > 0.0 )
mag = 1/sqrt(mag);
for ( j = 0 ; j < n ; j++ )
a[i][j] *= mag;
b[i] *= mag;
}
/* now gaussian elimination */
for ( i = 0 ; i < n ; i++ )
{ /* find pivot */
big = 0.0;
for ( j = i ; j < n ; j++ )
{
if ( fabs(a[j][i]) >= big )
{ big = fabs(a[j][i]);
irow = j;
}
}
if ( irow != i )
{ for ( l = 0 ; l < n ; l++ )
SWAP(a[irow][l],a[i][l])
SWAP(b[irow],b[i]);
}
if ( a[i][i] < mat_approx_solve_epsilon )
{ rank--; continue; }
pivinv = 1/a[i][i];
a[i][i] = 1.0;
for ( l = i+1 ; l < n ; l++ )
a[i][l] *= pivinv;
b[i] *= pivinv;
for ( ll = 0 ; ll < n ; ll++ )
{ if ( ll == i ) continue;
{ dum = a[ll][i];
a[ll][i] = 0.0;
for ( l = 0 ; l < n ; l++ )
a[ll][l] -= a[i][l]*dum;
b[ll] -= b[i]*dum;
}
}
}
return rank;
} /* end mat_approx_solve() */
/******************************************************************
*
* Function: mat_inv_sym()
*
* Purpose: in-place symmetric matrix inverse with Bunch-Kauffman pivoting
* returns -1 for singular matrix,
* >= 0 for nonsingular, value is index
*
*/
#define PIV1 1
#define PIV2 2
#define PIV3 3 /* second of double pivot */
int mat_inv_sym ARGS2((a,n),
REAL **a, /* matrix to invert in place */
int n) /* size of matrix */
{
int *spiv; /* 1 or 2, size of pivot */
int *ipiv; /* permutation */
int i,irow=0,j,k;
REAL piv;
int temp1[SMALL],temp3[SMALL]; /* avoid alloc for small sizes */
int negs = 0;
if ( n <= SMALL )
{ spiv = temp1; ipiv = temp3; }
else
{ /* large size */
spiv = ivector(0,n-1);
ipiv = ivector(0,n-1);
}
for ( j = 0 ; j < n ; j++ )
ipiv[j] = j;
/* First, do LDL with Bunch-Kaufman pivoting */
for ( i = 0 ; i < n ; i++ )
{ /* find pivot */
/* max in pivot column */
int s = 1; /* pivot size */
double lambda = 0.0;
for ( j = i+1 ; j < n ; j++ )
{ if ( fabs(a[i][j]) > lambda )
{ lambda = fabs(a[i][j]);
irow = j;
}
}
if ( lambda > 0.0 )
{ if ( fabs(a[i][i]) > BKalpha*lambda )
s = 1;
else
{ double sigma = 0.0;
for ( j = i ; j < n ; j++ )
if ( fabs(a[j][irow]) > sigma )
sigma = fabs(a[j][irow]);
if ( sigma*fabs(a[i][i]) >= BKalpha*lambda*lambda )
s = PIV1;
else if ( fabs(a[irow][irow]) >= BKalpha*sigma )
{
/* swap irow and i */
int itmp = ipiv[i];
ipiv[i] = ipiv[irow];
ipiv[irow] = itmp;
s = PIV1;
for ( j = 0 ; j < i ; j++ )
SWAP(a[i][j],a[irow][j]);
SWAP(a[i][i],a[irow][irow]);
for ( j = i+1 ; j < irow ; j++ )
SWAP(a[j][i],a[irow][j]);
for ( j = irow+1 ; j < n ; j++ )
SWAP(a[j][i],a[j][irow]);
}
else
{ /* swap irow and i+1 */
int itmp = ipiv[i+1];
ipiv[i+1] = ipiv[irow];
ipiv[irow] = itmp;
s = PIV2;
if ( irow != i+1 )
{ for ( j = 0 ; j <= i ; j++ )
SWAP(a[i+1][j],a[irow][j]);
SWAP(a[i+1][i+1],a[irow][irow]);
for ( j = i+2 ; j < irow ; j++ )
SWAP(a[j][i+1],a[irow][j]);
for ( j = irow+1 ; j < n ; j++ )
SWAP(a[j][i+1],a[j][irow]);
}
}
}
}
/* now pivot step */
if ( s == PIV1 )
{ if ( a[i][i] == 0.0 )
{ negs = -1;
goto mat_inv_sym_exit;
}
piv = 1/a[i][i];
a[i][i] = piv;
for ( j = i+1 ; j < n ; j++ )
{ for ( k = i+1 ; k < j ; k++ )
a[j][k] -= a[j][i]*a[k][i];
a[j][j] -= a[j][i]*a[j][i]*piv;
a[j][i] *= piv;
}
spiv[i] = PIV1;
if ( piv < 0.0 ) negs++;
}
else /* s == 2, so 2 x 2 pivot */
{ double t;
double det = a[i][i]*a[i+1][i+1] - a[i+1][i]*a[i+1][i];
if ( det == 0.0 )
{ negs = -1;
goto mat_inv_sym_exit;
}
t = a[i][i];
a[i][i] = a[i+1][i+1]/det;
a[i+1][i+1] = t/det;
a[i][i+1] = a[i+1][i] /= -det;
for ( j = i+1 ; j < n ; j++ )
{ for ( k = i+1 ; k < j ; k++ )
a[j][k] -= a[j][i]*a[k][i] - a[j][i+1]*a[k][i+1];
t = a[i][i]*a[j][i] + a[i+1][i]*a[j][i+1];
a[j][i+1] = a[i+1][i]*a[j][i] + a[i+1][i+1]*a[j][i+1];
a[j][i] = t;
}
spiv[i] = PIV2;
spiv[i+1] = PIV3;
if ( det < 0.0 ) negs++;
else if ( a[i][i] < 0.0 ) negs += 2;
i++; /* extra increment */
}
}
/* convert from LDL to inverse */
/* invert L to upper triangle U */
for ( i = 1 ; i < n ; i++ )
{ for ( j = 0 ; j < i-1 ; j++ )
{ a[j][i] = -a[i][j];
for ( k = i+1 ; k < n ; k++ )
a[j][k] += a[k][i]*a[j][i];
}
if ( spiv[i] == PIV3 )
for ( k = i+1 ; k < n ; k++ )
a[i-1][k] = 0.0;
else
{ a[i-1][i] = -a[i][i-1];
for ( k = i+1 ; k < n ; k++ )
a[i-1][k] = a[k][i]*a[i-1][i];
}
}
/* multiply by already inverted diagonal into lower */
for ( j = 0 ; j < n ; j++ )
{ if ( spiv[j] == PIV1 )
{ for ( i = 0 ; i < j ; i++ )
a[j][i] = a[i][j]*a[j][j];
}
else /* PIV2 */
{ for ( i = 0 ; i < j-1 ; i++ )
{ a[j][i] = a[i][j]*a[j][j] + a[i][j+1]*a[j+1][j];
a[j+1][i] = a[i][j+1]*a[j][j+1] + a[i][j+1]*a[j+1][j+1];
}
j++; /* extra increment */
}
}
/* multiply lower triangle and upper to get full inverse in lower */
for ( i = 0 ; i < n ; i++ )
{
for ( j = i ; j < n ; j++ )
{ double sum;
int first;
if ( j == i )
{ sum = a[i][i];
if ( spiv[j] == PIV2 )
first = i+2;
else
first = i+1;
}
else if ( (j == i-1) && (spiv[j]==PIV2) )
{ sum = 0;
first = i+1;
}
else
{ sum = a[i][j]*a[i][i];
first = i+1;
}
for ( k = first ; k < n ; k++ )
sum += a[i][k]*a[k][j];
a[i][j] = sum;
}
}
/* unpermute lower to upper */
/* first, off diagonal */
for ( i = 0 ; i < n ; i++ )
{ for ( j = 0 ; j < i ; j++ )
a[ipiv[j]][ipiv[i]] = a[i][j];
}
/* and then the diagonal */
for ( i = 0 ; i < n ; i++ )
{ j = i;
while ( ipiv[j] != j )
{ int ti = ipiv[j];
double t = a[ti][ti];
a[ti][ti] = a[j][j];
a[j][j] = t;
ipiv[j] = ipiv[ti];
ipiv[ti] = ti;
}
}
/* symmetrize from upper to lower */
for ( i = 0 ; i < n ; i++ )
for ( j = 0 ; j < i ; j++ )
a[i][j] = a[j][i];
mat_inv_sym_exit:
if ( n > SMALL )
{ free_ivector(ipiv,0,n-1);
free_ivector(spiv,0,n-1);
}
return negs;
}
/*************************************************************************
*
* function: LD_factor()
*
* purpose: factor dense symmetric matrix into LDL^T form. Touches only
* lower triangle. Does not pivot, so should be used only
* on positive definite matrices.
*/
int LD_factor ARGS2(( H, N ),
REAL **H, /* lower triangular, row by row */
int N) /* size */
{ int i,j,k;
int negs = 0;
#ifdef BLAS
if ( blas_flag )
{ char uplo = 'U';
int stride = H[1] - H[0];
int info=0;
DPOTRF(&uplo,&N,&H[0][0],&stride,&info);
}
else
#endif
for ( i = 0 ; i < N ; i++ ) /* pivot (i,i) */
{ REAL pivot = H[i][i];
if ( pivot == 0.0 )
{ kb_error(2553,"Trying to factor singular matrix; using 1 as pivot.\n",
WARNING);
pivot = 1.0;
}
if ( pivot < 0 ) negs++;
pivot = 1/pivot;
for ( j = i+1 ; j < N ; j++ ) /* row j */
{ REAL x = H[j][i];
for ( k = i+1 ; k < j ; k++ ) /* col k */
H[j][k] -= x*H[k][i];
H[j][i] = x*pivot;
H[j][j] -= x*x*pivot;
}
}
return negs;
}
/***********************************************************************
*
* function: LD_solve
*
* purpose: solve for a single rhs using matrix factored by LD_factor.
*/
void LD_solve ARGS4((LD,B,X,N),
REAL **LD, /* from LD_factor() */
REAL *B, /* rhs */
REAL *X, /* solution */
int N)
{ int i,j;
#ifdef BLAS
if ( blas_flag )
{ char uplo = 'U';
int stride = LD[1] - LD[0];
int info=0;
int nrhs = 1; /* number of rhs */
for ( i = 0 ; i < N ; i++ ) X[i] = B[i]; /* since DPOTRS overwrites */
DPOTRS(&uplo,&N,&nrhs,&LD[0][0],&stride,&X[0],&N,&info);
}
else
#endif
{ for ( i = 0 ; i < N ; i++ )
{ X[i] = B[i];
for ( j = 0 ; j < i ; j++ )
X[i] -= LD[i][j]*X[j];
}
for ( i = 0 ; i < N ; i++ )
X[i] /= LD[i][i];
for ( i = N-1 ; i >= 0 ; i-- )
{ for ( j = i+1 ; j < N ; j++ )
X[i] -= LD[j][i]*X[j];
}
}
}
/******************************************************************
*
* Function: det_adjoint()
*
* Purpose: calculates determinant in place and leaves adjoint transpose
*/
REAL det_adjoint ARGS2((a,n),
REAL **a, /* matrix to change in place */
int n) /* size of matrix */
{
int *indxc,*indxr,*ipiv;
int i,icol=0,irow=0,j,k,l,ll;
REAL big,dum,pivinv,piv;
int temp1[SMALL],temp2[SMALL],temp3[SMALL]; /* avoid alloc for small sizes */
REAL det = 1.0; /* will multiply by pivots */
if ( n <= 0 )
kb_error(1205,"Internal error: Matrix size not positive.",RECOVERABLE);
if ( n == 1 ) { det = a[0][0]; a[0][0] = 1.0; return det; }
if ( n == 2 )
{ REAL temp;
det = a[0][0]*a[1][1] - a[0][1]*a[1][0];
temp = a[0][0]; a[0][0] = a[1][1]; a[1][1] = temp;
a[0][1] = -a[0][1]; a[1][0] = -a[1][0];
return det;
}
if ( n <= SMALL )
{ indxc = temp1; indxr = temp2; ipiv = temp3; }
else
{ /* large size */
indxc = ivector(0,n-1);
indxr = ivector(0,n-1);
ipiv = ivector(0,n-1);
}
for ( j = 0 ; j < n ; j++ ) ipiv[j] = -1;
for ( i = 0 ; i < n-1 ; i++ )
{ big = 0.0;
for ( j = 0 ; j < n ; j++ )
if ( ipiv[j] != 0 )
for ( k = 0 ; k < n ; k++ )
{ if ( ipiv[k] == -1 )
{ if ( fabs(a[j][k]) >= big )
{ big = fabs(a[j][k]);
irow = j;
icol = k;
}
}
else if ( ipiv[k] > 0 )
{ kb_error(1206,"Internal: ipiv > 0.\n",WARNING); det = 0.0; goto det_exit; }
}
++(ipiv[icol]);
if ( irow != icol )
{ for ( l = 0 ; l < n ; l++ ) SWAP(a[irow][l],a[icol][l])
det = -det;
}
indxr[i] = irow;
indxc[i] = icol;
det *= a[icol][icol]; /* build determinant */
if ( a[icol][icol] == 0.0 ) { goto det_lowrank; }
pivinv = 1/a[icol][icol];
a[icol][icol] = 1.0;
for ( l = 0 ; l < n ; l++ ) a[icol][l] *= pivinv;
for ( ll = 0 ; ll < n ; ll++ )
if ( ll != icol )
{ dum = a[ll][icol];
a[ll][icol] = 0.0;
for ( l = 0 ; l < n ; l++ ) a[ll][l] -= a[icol][l]*dum;
}
}
/* special treatment for last pivot; works even if zero */
for ( j = 0 ; j < n ; j++ )
if ( ipiv[j] != 0 ) { irow = icol = j; break; }
indxr[n-1] = irow;
indxc[n-1] = icol;
piv = a[icol][icol];
a[icol][icol] = 1.0;
for ( l = 0 ; l < n ; l++ ) a[icol][l] *= det;
for ( ll = 0 ; ll < n ; ll++ )
if ( ll != icol )
{ dum = a[ll][icol];
a[ll][icol] = 0.0;
for ( l = 0 ; l < n ; l++ )
a[ll][l] = a[ll][l]*piv*det - a[icol][l]*dum;
}
det *= piv;
for ( l = n-1 ; l >= 0 ; l-- )
{ if ( indxr[l] != indxc[l] )
for ( k = 0 ; k < n ; k++ )
SWAP(a[k][indxr[l]],a[k][indxc[l]])
}
det_exit:
if ( n > SMALL )
{ free_ivector(ipiv,0,n-1);
free_ivector(indxr,0,n-1);
free_ivector(indxc,0,n-1);
}
return det;
det_lowrank: /* rank less than n-1, so adjoint = 0 */
for ( i = 0 ; i < n ; i++ )
for ( j = 0 ; j < n ; j++ )
a[i][j] = 0.0;
det = 0.0;
goto det_exit;
}
/******************************************************************
*
* Function: determinant()
*
* Purpose: calculates determinant; no change in matrix for 3x3 or smaller
* otherwise calls det_adjoint()
*/
REAL determinant ARGS2((a,n),
REAL **a, /* matrix to change in place */
int n) /* size of matrix */
{
if ( n == 1 ) { return a[0][0]; }
if ( n == 2 ) { return a[0][0]*a[1][1] - a[0][1]*a[1][0]; }
if ( n == 3 )
{ return a[0][0]*(a[1][1]*a[2][2] - a[1][2]*a[2][1])
- a[0][1]*(a[1][0]*a[2][2] - a[1][2]*a[2][0])
+ a[0][2]*(a[1][0]*a[2][1] - a[1][1]*a[2][0]);
}
return det_adjoint(a,n); /* other cases */
}
/******************************************************************
*
* Function: print_matrix()
*
*/
void print_matrix ARGS3((a,rows,cols),
REAL **a,
int rows, int cols)
{
int i,j;
for ( i = 0 ; i < rows ; i++ )
{ msg[0] = 0;
for ( j = 0 ; j < cols ; j++ )
sprintf(msg+strlen(msg),"%10.6f ",(DOUBLE)a[i][j]);
strcat(msg,"\n");
outstring(msg);
}
}
/******************************************************************
*
* Function: exterior_product()
*
* Purpose: conversion of k vectors to a k-vector
* components in index lexicographic order
*/
void exterior_product ARGS4((v,w,k,n),
REAL **v, /* list of k vectors */
REAL *w, /* returned k-vector */
int k, /* number of vectors */
int n) /* space dimension */
{
/* anticipate only small k, so just brute force */
int i1,i2,i3;
switch ( k )
{
case 1: for ( i1 = 0 ; i1 < n ; i1++ ) *(w++) = v[0][i1];
break;
case 2: for ( i1 = 0 ; i1 < n ; i1++ )
for ( i2 = i1+1 ; i2 < n ; i2++ )
*(w++) = v[0][i1]*v[1][i2] - v[0][i2]*v[1][i1];
break;
case 3: for ( i1 = 0 ; i1 < n ; i1++ )
for ( i2 = i1+1 ; i2 < n ; i2++ )
for ( i3 = i2+1 ; i3 < n ; i3++ )
*(w++) = v[0][i1]*v[1][i2]*v[2][i3]
+ v[0][i2]*v[1][i3]*v[2][i1]
+ v[0][i3]*v[1][i1]*v[2][i2]
- v[0][i1]*v[1][i3]*v[2][i2]
- v[0][i3]*v[1][i2]*v[2][i1]
- v[0][i2]*v[1][i1]*v[2][i3] ;
break;
default: sprintf(errmsg,"Exterior product of %d vectors.\n",k);
kb_error(1207,errmsg,RECOVERABLE);
break;
}
}
/**********************************************************************
*
* function: kernel_basis()
*
* purpose: Find basis for kernel of matrix (nullspace of rows)
*/
int kernel_basis ARGS4((a,ker,imax,jmax),
REAL **a, /* the matrix, will be altered */
REAL **ker, /* for basis vectors in columns */
int imax, int jmax) /* rows and columns of a */
{
int i,j,k;
int pivrow[20]; /* pivot row in column */
int n; /* nullity */
for ( j = 0 ; j < jmax ; j++ ) pivrow[j] = -1; /* mark as no pivot in col */
/* get row echelon form, pivot largest in each row */
for ( i = 0 ; i < imax ; i++ )
{ int piv = -1;
REAL b,big,p;
/* find largest element in row */
big = 0.0;
for ( j = 0 ; j < jmax ; j++ )
if ( fabs(a[i][j]) > big )
{ big = fabs(a[i][j]);
piv = j;
}
if ( piv == -1 ) continue; /* row of zeros */
pivrow[piv] = i;
/* pivot step */
p = a[i][piv];
for ( j = 0 ; j < jmax ; j++ )
a[i][j] /= p;
for ( k = 0 ; k < imax ; k++ )
{ if ( k == i ) continue;
b = a[k][piv];
for ( j = 0 ; j < jmax ; j++ )
a[k][j] -= b*a[i][j];
}
}
/* now find kernel basis */
for ( j = 0, n = 0 ; j < jmax ; j++ )
{ if ( pivrow[j] >= 0 ) continue; /* column has leading 1 */
/* column j is parameter column */
for ( k = 0 ; k < jmax ; k++ )
{ if ( pivrow[k] >= 0 )
ker[k][n] = -a[pivrow[k]][j];
else if ( k == j )
ker[k][n] = 1.0;
else ker[k][n] = 0.0;
}
n++;
}
return n; /* nullity */
}
/**********************************************************************
*
* function: kernel_basis_rows()
*
* purpose: Find basis for kernel of matrix (nullspace of rows)
* Returns basis rowwise.
* basis vectors normalized, but not orthohormal.
*/
int kernel_basis_rows ARGS4((a,ker,imax,jmax),
REAL **a, /* the matrix, will be altered */
REAL **ker, /* for basis vectors in rows */
int imax, int jmax) /* rows and columns of a */
{
int i,j,k;
int pivrow[20]; /* pivot row in column */
int pivcol[20]; /* pivot column in row */
int n; /* nullity */
int detsign=1; /* to try to keep orientation of normal positive */
for ( j = 0 ; j < jmax ; j++ ) pivrow[j] = -1; /* mark as no pivot in col */
/* get row echelon form, pivot largest in each row */
for ( i = 0 ; i < imax ; i++ )
{ int piv = -1;
REAL b,big,p;
/* find largest element in row */
big = 0.0;
for ( j = 0 ; j < jmax ; j++ )
if ( fabs(a[i][j]) > big )
{ big = fabs(a[i][j]);
piv = j;
}
if ( piv == -1 ) continue; /* row of zeros */
pivrow[piv] = i; pivcol[i] = piv;
/* pivot step */
p = a[i][piv]; if ( p < 0 ) detsign = -detsign;
for ( j = 0 ; j < jmax ; j++ )
a[i][j] /= p;
for ( k = 0 ; k < imax ; k++ )
{ if ( k == i ) continue;
b = a[k][piv];
for ( j = 0 ; j < jmax ; j++ )
a[k][j] -= b*a[i][j];
}
}
/* now find kernel basis */
for ( j = 0, n = 0 ; j < jmax ; j++ )
{ int sign;
if ( pivrow[j] >= 0 ) continue; /* column has leading 1 */
/* column j is parameter column */
pivcol[imax+n] = j;
/* get sign for pos det */
for (sign = detsign, k=0 ; k <= imax+n ; k++ )
for ( i = k+1 ; i <= imax+n ; i++ )
if ( pivcol[k] > pivcol[i] ) sign = -sign;
for ( k = 0 ; k < jmax ; k++ )
{ if ( pivrow[k] >= 0 )
ker[n][k] = -sign*a[pivrow[k]][j];
else if ( k == j )
ker[n][k] = sign;
else ker[n][k] = 0.0;
}
n++;
}
/* normalize */
for ( i = 0 ; i < n ; i ++ )
{ REAL mag;
mag = sqrt(SDIM_dot(ker[i],ker[i]));
for ( j = 0 ; j < SDIM ; j++ )
ker[i][j] /= mag;
}
return n; /* nullity */
}
/*********************************************************************
*
* function: matrix_index()
*
* purpose: return number of negative eigenvalues of matrix
* Does not destroy original. For symmetric matrices.
*
*/
int matrix_index ARGS2((M,n),
REAL **M, /* square matrix */
int n) /* size */
{ REAL **a = dmatrix(0,n-1,0,n-1);
REAL *tempptr;
int row,col,prow=0;
REAL maxp;
int i,j;
int indx = 0;
REAL temp;
REAL *firstrow; /* for proper freeing after swapping rows */
firstrow = a[0];
matcopy(a,M,n,n);
/* basically, gauss elimination to lower triangular form
with partial pivoting.
*/
for ( col = 0 ; col < n ; col++ )
{ /* find max pivot in diagonal */
maxp = 0.0;
for ( row = col ; row < n ; row++ )
if ( fabs(a[row][row]) > maxp ) { maxp = fabs(a[row][row]); prow = row; }
if ( maxp == 0.0 ) continue;
if ( prow != col )
{ /* swap rows and columns to keep symmetric */
tempptr = a[prow]; a[prow] = a[col]; a[col] = tempptr;
for ( j = col; j < n ; j++ )
{ temp = a[j][col]; a[j][col] = a[j][prow]; a[j][prow] = temp; }
}
if ( a[col][col] < 0.0 ) indx++;
for ( row = col+1 ; row < n ; row++ )
for ( i = col+1 ; i < n ; i++ )
{ a[row][i] -= a[row][col]/a[col][col]*a[col][i];
}
}
a[0] = firstrow; free_matrix(a);
return indx;
}
/****************************************************************************
*
* function: jacobi_eigenpairs()
*
* purpose: find eigenpairs of small dense symmetric matrix by jacobi rotations
* From Numerical Recipes 11.1.
*
* output: eigenvalues in d[], sorted in descending order, and
* corresponding eigenvectors in columns of v[][].
*/
void jacobi_eigenpairs ARGS5((a,n,d,v,work),
REAL **a, /* input matrix, destroyed */
int n, /* size */
REAL *d, /* for return of eigenvalues */
REAL **v, /* for return of eigenvectors */
REAL *work) /* space for 2*n values */
{ REAL sm,h,tresh,dum,g,t,theta,tau,s,c;
int i,iq,ip,nrot,j;
REAL *z,*b;
z = work;
b = work+n;
/* initialize v to identity */
for ( ip = 0 ; ip < n ; ip++ )
{ for ( iq = 0 ; iq < n ; iq++ ) v[ip][iq] = 0.0;
v[ip][ip] = 1.0;
}
for ( ip = 0 ; ip < n ; ip++ )
{ b[ip] = a[ip][ip];
d[ip] = b[ip];
z[ip] = 0.0;
}
nrot = 0;
for ( i = 1 ; i < 50 ; i++ )
{ sm = 0.0;
for ( ip = 0 ; ip < n-1; ip++ )
for ( iq = ip + 1 ; iq < n ; iq++ )
sm += fabs(a[ip][iq]);
if ( sm == 0.0 ) goto jacobi_exit; /* normal exit */
if ( i < 4 ) tresh = .2*sm/n/n;
else tresh = 0.0;
for ( ip = 0 ; ip < n-1 ; ip++ )
for ( iq = ip+1 ; iq < n ; iq++ )
{ g = 100*fabs(a[ip][iq]);
dum = fabs(d[ip]);
if ( (i > 4) && (dum+g == dum) && (fabs(d[iq])+g == fabs(d[iq])) )
a[ip][iq] = 0.0;
else if ( fabs(a[ip][iq]) > tresh )
{ h = d[iq] - d[ip];
if ( fabs(h) + g == fabs(h) ) t = a[ip][iq]/h;
else
{ theta = .5*h/a[ip][iq];
t = 1.0/(fabs(theta) + sqrt(1 + theta*theta));
if ( theta < 0.0 ) t = -t;
}
c = 1.0/sqrt(1 + t*t);
s = t*c;
tau = s/(1+c);
h = t*a[ip][iq];
z[ip] -= h;
z[iq] += h;
d[ip] -= h;
d[iq] += h;
a[ip][iq] = 0.0;
for ( j = 0 ; j <= ip-1 ; j++ )
{ g = a[j][ip];
h = a[j][iq];
a[j][ip] = g - s*(h+g*tau);
a[j][iq] = h + s*(g-h*tau);
}
for ( j = ip+1 ; j <= iq-1 ; j++ )
{ g = a[ip][j];
h = a[j][iq];
a[ip][j] = g - s*(h+g*tau);
a[j][iq] = h + s*(g-h*tau);
}
for ( j = iq+1 ; j < n ; j++ )
{ g = a[ip][j];
h = a[iq][j];
a[ip][j] = g - s*(h+g*tau);
a[iq][j] = h + s*(g-h*tau);
}
for ( j = 0 ; j < n ; j++ )
{ g = v[j][ip];
h = v[j][iq];
v[j][ip] = g - s*(h+g*tau);
v[j][iq] = h + s*(g-h*tau);
}
nrot++;
} /* end if */
} /* end iq */
/* end ip */
for ( ip = 0 ; ip < n ; ip++ )
{ b[ip] += z[ip];
d[ip] = b[ip];
z[ip] = 0.0;
}
} /* end i */
kb_error(2548,"50 Jacobi iterations should never happen.\n",WARNING);
return;
jacobi_exit:
/* sort eigenpairs in descending order, insertion sort */
for ( i = 0 ; i < n-1 ; i++ )
{ REAL p;
int k;
k = i;
p = d[i];
for ( j = i + 1 ; j < n ; j++ )
{ if ( d[j] >= p )
{ k = j; p = d[j]; }
}
if ( k != i )
{ d[k] = d[i];
d[i] = p;
for ( j = 0 ; j < n ; j++ )
{ p = v[j][i]; v[j][i] = v[j][k]; v[j][k] = p; }
}
}
return;
}
/**********************************************************************
*
* function: det_hess(a,h,n)
*
* Purpose: find hessian of determinant as function of entries
*
* Returns h[i1][j1][i2][j2] as d^2 det(a)/da[i1][j1]/da[i2][j2]
*/
void det_hess ARGS3((a,h,n),
REAL **a,
REAL ****h,
int n) /* size */
{ int i1,i2,jj1,j2,k;
/* copy original matrix into h lots of times */
for ( i1 = 0 ; i1 < n ; i1++ )
for ( jj1 = 0 ; jj1 < n ; jj1++ )
for ( i2 = 0 ; i2 < n ; i2++ )
for ( j2 = 0 ; j2 < n ; j2++ )
h[i1][jj1][i2][j2] = a[i2][j2];
/* replace element row and column with identity stuff */
for ( i1 = 0 ; i1 < n ; i1++ )
for ( jj1 = 0 ; jj1 < n ; jj1++ )
{ for ( k = 0 ; k < n ; k++ )
{ h[i1][jj1][i1][k] = 0.0;
h[i1][jj1][k][jj1] = 0.0;
}
h[i1][jj1][i1][jj1] = 1.0;
}
/* find adjoints */
for ( i1 = 0 ; i1 < n ; i1++ )
for ( jj1 = 0 ; jj1 < n ; jj1++ )
{ det_adjoint(h[i1][jj1],n);
h[i1][jj1][jj1][i1] = 0.0; /* need fixup */
}
/* transpose to get back to hessian */
for ( i1 = 0 ; i1 < n ; i1++ )
for ( jj1 = 0 ; jj1 < n ; jj1++ )
for ( i2 = 1 ; i2 < n ; i2++ )
for ( j2 = 0 ; j2 < i2 ; j2++ )
{ REAL tmp = h[i1][jj1][i2][j2];
h[i1][jj1][i2][j2] = h[i1][jj1][j2][i2];
h[i1][jj1][j2][i2] = tmp;
}
}
/**********************************************************************
*
* function: gram_schmidt()
*
* purpose: orthonormalize rows of a matrix
*
* return: number of independent rows
*/
int gram_schmidt ARGS3((mat,rows,cols),
REAL **mat,
int rows, int cols)
{ int i,j,k;
REAL d;
for ( i = 0 ; i < rows ; i++ )
{ for ( j = 0 ; j < i ; j++ )
{ REAL c = dot(mat[i],mat[j],cols);
for ( k = 0 ; k < cols ; k++ ) mat[i][k] -= c*mat[j][k];
}
d = dot(mat[i],mat[i],cols);
if ( d == 0.0 )
{ rows--;
for ( k = 0 ; k < cols ; k++ ) mat[i][k] = mat[rows][k];
i--;
}
else
{ d = 1/sqrt(d);
for ( k = 0 ; k < cols ; k++ ) mat[i][k] *= d;
}
}
return rows;
}
/**************************************************************************
*
* function: mat_inv_sparse()
*
* purpose: invert large sparse symmetric matrix in place, with input in
* dense format.
* Should be just temporary until callers get fully integrated
* with sparse matrix stuff.
*/
int mat_inv_sparse ARGS2((a,n),
REAL **a, /* matrix to invert in place */
int n) /* size of matrix */
{ struct linsys S;
int i,j,k;
REAL *BB,*Y;
memset(&S,0,sizeof(S));
S.N = n;
/* count entries */
S.IA = (int *)temp_calloc(n+1,sizeof(int));
for ( i = 0, k = 0 ; i < n ; i++ )
{ S.IA[i] = k + A_OFF;
for ( j = i ; j < n ; j++ )
if ( a[i][j] != 0.0 ) k++;
}
S.IA[i] = k + A_OFF;
/* allocate main space and fill */
S.JA = (int *)temp_calloc(k,sizeof(int));
S.A = (REAL *)temp_calloc(k,sizeof(REAL));
S.P = (int *)temp_calloc(n,sizeof(int));
S.IP = (int *)temp_calloc(n,sizeof(int));
for ( i = 0, k = 0 ; i < n ; i++ )
{
for ( j = i ; j < n ; j++ )
if ( a[i][j] != 0.0 )
{ S.A[k] = a[i][j];
S.JA[k] = j + A_OFF;
k++;
}
}
#ifdef USEMINDEG
xmd_factor(&S); /* use mindeg, since internals known */
#else
ysmp_factor(&S);
#endif
/* solve back for inverse matrix */
BB = (REAL*)temp_calloc(S.N+10,sizeof(REAL)); /* intermediate solutions */
Y = (REAL*)temp_calloc(S.N+10,sizeof(REAL)); /* intermediate solutions */
for ( i = 0 ; i < n ; i++ )
{
memset(BB,0,n*sizeof(REAL));
BB[i] = 1.0;
#ifdef USEMINDEG
/* mindeg is too specific, using vertex structure to optimize for hessian */
/* solve U^T Y = B */
int *jp;REAL *e;
for ( j = 0 ; j < S.N ; j++ )
{ int start,end;
Y[j] = BB[S.LJA[S.LIJA[j]]]; /* for BK inner permutation */
if ( S.psize[j] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S.LIA[j+1];
for ( i=S.LIA[j]+start, e=S.LA+i , jp=S.LJA+S.LIJA[j]+start ;
i < end ; i++,e++,jp++ )
BB[*jp] -= (*e)*Y[j];
}
/* solve D V = Y (will use Y to store V) */
for ( j = 0 ; j < S.N ; j++ )
{ if ( S.psize[j] == ONEBYONE )
Y[j] /= S.LA[S.LIA[j]];
else if ( S.psize[j] == ZEROPIVOT ) Y[j] = 0.0;
else
{ REAL piv[2][2];
REAL pinv[2][2];
REAL det,yy;
piv[0][0] = S.LA[S.LIA[j]];
piv[0][1] = piv[1][0] = S.LA[S.LIA[j]+1];
piv[1][1] = S.LA[S.LIA[j+1]];
det = piv[0][0]*piv[1][1] - piv[0][1]*piv[1][0];
pinv[0][0] = piv[1][1]/det;
pinv[1][0] = pinv[0][1] = -piv[0][1]/det;
pinv[1][1] = piv[0][0]/det;
yy = Y[j]*pinv[0][0] + Y[j+1]*pinv[1][0];
Y[j+1] = Y[j]*pinv[0][1] + Y[j+1]*pinv[1][1];
Y[j] = yy;
j++;
}
}
/* solve U X = V */
for ( j = S.N-1 ; j >= 0 ; j-- )
{ int start,end;
if ( S.psize[j] == FIRSTOFPAIR ) start = 2;
else start = 1;
end = S.LIA[j+1];
for ( k=S.LIA[j]+start, e=S.LA+k, jp=S.LJA+S.LIJA[j]+start ;
k < end ; k++,e++,jp++ )
Y[j] -= (*e)*BB[*jp];
BB[S.LJA[S.LIJA[j]]] = Y[j];
}
/* unpermute */
for ( j = 0 ; j < S.N ; j++ )
a[i][S.P[j]] = BB[j];
/* end of mindeg version */
#else
ysmp_solve(&S,BB,BB);
for ( j = 0 ; j < S.N ; j++ )
a[i][j] = BB[j];
#endif
}
temp_free((char*)Y);
temp_free((char*)BB);
free_system(&S);
return 1;
}
/*************************************************************************
General sparse matrix construction scheme. Does not assume symmetry.
Usage: call sp_hash_init() to initialize,
sp_hash() to add value,
sp_hash_end() at end to sort and gather into linear system.
Some benchmarks for using sparse_constraints vs dense constraints on
tgrid4: Seconds for 'g'
Bodies Sparse Dense
16
64 0.0141
256 0.9281
1024 0.0953 58.36 memory 13MB (dense)
4096 0.687
16384 3.737
65536 27.3
262144 182.5 10^9 memory 555MB (sparse) 64GB(dense)
So there is a five million fold speed-up for the largest sparse
system my machine can handle.
No jiggling, so only one pass through volume projection. With jiggling
and zero scale, single iteration shows volumes projected back to
targets with maximum error 5e-7!
Benchmarking on twointor, likewise no jiggle, m 0, g:
Bodies Sparse Dense
2 0.0048 0.0025
4 0.0066 0.0040
16 0.0181 0.0147
64 0.0722 0.0713
256 0.285 1.118
1024 1.73 59.1 memory 45MB(dense)
4096 16.3 memory 116MB(sparse)
8192 145.5 memory 250MB(sparse)
Note twointor.fe has more elements per body (13 v, 36 f) than
tgrid4.fe (1 v, 1 f) and has a denser constraint matrix, being
three dimensional instead of two dimensional.
**************************************************************************/
#define SP_PRIME 99991
#define sp_hash(row,col) (abs((row)*97+(col)*SP_PRIME))
/********************************************************************
*
* function: sp_hash_init()
*
* purpose: Initialize hash table.
*/
void sp_hash_init ARGS2((S,size_estimate),
struct linsys *S,
int size_estimate) /* from sp_hash_end of previous invocation */
{ int i;
int estimate = SDIM*(web.skel[VERTEX].max_ord+10);
S->table_size = size_estimate > 0 ?
( size_estimate > estimate ? estimate : size_estimate) :
estimate;
S->max_fill = 4*S->table_size/5; /* leave enough empty for decent hash */
if ( !hessian_quiet_flag )
{ sprintf(msg,"Sparse init alloc: %d\n",S->table_size);
outstring(msg);
}
S->hashcount = 0;
if ( S->hashtable ) temp_free((char*)S->hashtable);
S->hashtable =
(struct sp_entry *)temp_calloc(S->table_size,sizeof(struct sp_entry));
for ( i = 0 ; i < S->table_size ; i++ ) S->hashtable[i].row = HASHEMPTY;
S->hash_extraprobes = 0;
}
/********************************************************************
*
* function: sp_hash_expand()
*
* purpose: Expands hash table
*/
void sp_hash_expand ARGS1((S),
struct linsys *S)
{ struct sp_entry *newtable,*oldtable;
int i;
struct sp_entry *e;
int newsize;
int oldsize = S->table_size;
if ( !S->hashtable ) sp_hash_init(S,0);
newsize = S->table_size*2;
oldtable = S->hashtable;
newtable =
(struct sp_entry *)temp_calloc(newsize,sizeof(struct sp_entry));
for ( i = 0 ; i < newsize ; i++ ) newtable[i].row = HASHEMPTY;
S->table_size = newsize;
S->max_fill = 4*S->table_size/5;
S->hashtable = newtable;
/* reinsert */
for ( i = 0, e = oldtable ; i < oldsize ; i++,e++ )
if ( e->row != HASHEMPTY )
{ int spot = sp_hash(e->row,e->col) % S->table_size;
struct sp_entry *ee;
for ( ee = S->hashtable + spot; ee->row != HASHEMPTY ; spot++ )
{ if ( spot == S->table_size ) spot = 0;
ee = S->hashtable + spot;
}
*ee = *e;
}
temp_free((char*)oldtable);
if ( !hessian_quiet_flag )
{ sprintf(msg,"Expanded hashtable size: %d.\n",S->table_size);
outstring(msg);
}
}
/********************************************************************
*
* function: sp_hash_search()
*
* purpose: Finds existing entry or allocates entry.
* Installs key values, and adds hessian value.
*/
void sp_hash_search ARGS4((S,row,col,value),
struct linsys *S,
int row, int col, /* Note these are in reverse order as from hessian version */
REAL value) /* value to add */
{
struct sp_entry *e;
int spot;
if ( value == 0.0 ) return;
if ( S->hashcount >= S->max_fill )
sp_hash_expand(S);
/* search hash table */
spot = sp_hash(row,col) % S->table_size;
e = S->hashtable + spot;
while ( e->row != HASHEMPTY )
{ if ( (e->row == row) && (e->col == col) )
{ e->value += value;
return;
}
spot++;
if ( spot >= S->table_size ) spot -= S->table_size;
e = S->hashtable + spot;
S->hash_extraprobes++;
}
/* if here, then have empty slot and need to insert */
e->col = col; e->row = row; S->hashcount++;
e->value = value;
}
/********************************************************************
*
* function: sp_hash_end()
*
* purpose: Puts entries in sparse packed format; allocates own lists.
* Create sorted list of sparse entries, row major order
* Does 2-digit radix sort on row,col with count sort on each.
* Deallocate hessian hash table.
*
* return: Estimated size of hash table to use next time.
*/
int sp_hash_end ARGS4((S,rows,cols,index_start),
struct linsys *S,
int rows, /* number of rows */
int cols, /* number of columns */
int index_start) /* for 0 or 1 based indexing */
{ int i;
struct sp_entry *e;
int *counts;
int *starts;
int *spots;
int sum,oldsum;
S->N = rows;
S->maxN = rows > cols ? rows : cols;
S->IA = (int *)temp_calloc(S->maxN+1,sizeof(int));
counts = (int *)temp_calloc(3*cols+1,sizeof(int));
starts = counts + cols;
spots = starts + cols + 1;
/* first stage: column binning */
/* count entries in columns */
for ( i = 0, e = S->hashtable ; i < S->table_size ; i++, e++ )
if ( e->row != HASHEMPTY )
counts[e->col]++;
/* get starting points of each column */
for ( i = 0, sum = 0 ; i < cols ; i++ )
{
spots[i] = starts[i] = sum;
sum += counts[i];
}
starts[cols] = sum;
S->maxA = sum + S->maxN; /* extra room for later expansion */
S->JA = (int *)temp_calloc(S->maxA,sizeof(int));
S->A = (REAL *)temp_calloc(S->maxA,sizeof(REAL));
/* sort into column bins */
for ( i = 0, e = S->hashtable ; i < S->table_size ; i++,e++ )
{
struct sp_entry eorig;
struct sp_entry etmp;
if ( e->row == HASHEMPTY ) continue;
if ( i < spots[e->col] ) continue; /* already in place */
eorig = *e;
e->row = HASHEMPTY;
do
{ /* follow chain of replacements */
int spot;
spot = spots[eorig.col]++;
etmp = S->hashtable[spot];
S->hashtable[spot] = eorig;
eorig = etmp;
}
while ( eorig.row != HASHEMPTY ); /* stop when get back to empty */
}
/* Second stage: row binning */
/* count entries in row */
for ( i = 0, e = S->hashtable ; i < sum ; i++, e++ )
S->IA[e->row]++;
/* get starting points of each row */
for ( i = 0, sum = 0 ; i < rows ; i++ )
{ oldsum = sum;
sum += S->IA[i];
S->IA[i] = oldsum;
}
S->IA[rows] = sum;
/* sort into row bins */
for ( i = 0, e = S->hashtable ; i < sum ; i++,e++ )
{
S->JA[S->IA[e->row]] = e->col;
S->A[S->IA[e->row]] = e->value;
S->IA[e->row]++;
}
/* put back IA */
for ( i = rows ; i > 0 ; i-- )
S->IA[i] = S->IA[i-1];
S->IA[0] = 0;
if ( index_start )
{
for ( i = 0 ; i < S->IA[rows] ; i++ )
S->JA[i] += index_start;
for ( i = 0 ; i <= rows ; i++ )
S->IA[i] += index_start;
}
temp_free((char*)counts);
if ( !hessian_quiet_flag )
{ sprintf(msg,"Sparse entries: %d Final hashtable size: %d\n",
S->hashcount, S->table_size);
outstring(msg);
sprintf(msg,"Hash extra probes: %d\n",S->hash_extraprobes);
outstring(msg);
}
temp_free((char*)S->hashtable);
S->hashtable = NULL;
return S->IA[S->N] + S->IA[S->N]/3; /* estimate for next time */
}
/********************************************************************
End sparse hash routines.
********************************************************************/
/*******************************************************************
Using BLAS and LAPACK to factor large dense symmetric matrix
for Hessian with lots of constraints. To enable, -DBLAS in
Makefile, and link with libblas and liblapack (ATLAS or whatever;
Intel Math Kernel Library mkl_c.lib for Intel; needs mkl_sys.dll
also). Command line toggle blas_enable.
Usage: Incoming matrix should be block lower triangular, with
blocksize BLAS_BLOCKSIZE. Full blocks on diagonal, although
only lower triangle has to filled on entry to LD_block_factor().
Last odd rows also have to be full multiple of BLAS_BLOCKSIZE.
Call LD_block_factor(H,N) first, then LD_block_solve(H,B,X,N)
to solve for one right hand side.
********************************************************************/
/* Timings on block factoring, 1200 MHz dual Athlon MP. Entries are Mflops
Matrix size
block 512 1024 2048 4096 8192
size
16 233 225 204 192 184
32 340 360 366 371 373
64 315 362 410 443 459
128 211 283 340 377 399
256 131 184 240 288 321
512 99 122 164 213 254
For comparison, my LDL in plain C runs at 32 Mflops,
and LAPACK DPPTRF at 66 Mflops. Seems to use both CPUs
for the DGEMM matrix multiplies, but only one for factoring.
*/
#ifdef BLAS
/* CPU clock timing */
__int32 LD_block_factor_elapsed_time[2];
int blocksize = BLAS_BLOCKSIZE;
static REAL workspace[BLAS_BLOCKSIZE][BLAS_BLOCKSIZE];
static REAL *work[BLAS_BLOCKSIZE];
static REAL workv[BLAS_BLOCKSIZE];
static int ipiv[BLAS_BLOCKSIZE]; /* for Bunch-Kaufman pivot info */
/*************************************************************************
*
* function: LD_block_factor()
*
* Purpose: BLAS and LAPACK used to block factor symmetric dense matrix.
* Usage: Incoming matrix should be block lower triangular, with
* blocksize BLAS_BLOCKSIZE. Full blocks on diagonal, although
* only lower triangle has to filled on entry to LD_block_factor().
* Last odd rows also have to be full multiple of BLAS_BLOCKSIZE.
* H will be overwritten.
*
* Return value: >= 0 index of matrix
* < 0 error
*/
/**********************************************************************
*
* function: kb_DSYTRF()
*
* purpose: My replacement for buggy MKL code for DSYTRF
* Does in-place Bunch-Kaufman factoring of lowet
* triangular dense matrix (although full storage room).
*
* returns: index of matrix.
*/
REAL BK_alpha = 0.6404;
void L_swap_columns(H,N,stride,i,r)
REAL *H;
int N;
int stride;
int i,r; /* the columns to swap */
{ int j;
REAL tmp;
REAL *ispot;
REAL *rspot;
if ( i == r ) return;
if ( i > r ) { j = i; i = r; r = j; }
for ( j=0, ispot=H+i*stride, rspot=H+r*stride ; j < i ; j++,ispot++,rspot++ )
{ tmp = *ispot; *ispot = *rspot; *rspot = tmp; }
tmp = *ispot;
*ispot = H[r*stride+r];
H[r*stride+r] = tmp;
for ( j = i+1, ispot += stride, rspot++ ; j < r ; j++,ispot+=stride,rspot++ )
{ tmp = *ispot; *ispot = *rspot; *rspot = tmp; }
for ( j = r+1, ispot+=stride,rspot+=stride; j < N ;
j++,ispot+=stride,rspot+= stride)
{ tmp = *ispot; *ispot = *rspot; *rspot = tmp; }
}
/************************************************************************
*
* function: kb_DSYTRF()
*
* purpose: Bunch-Kaufman factor dense matrix.
* Uses lower triangle of full matrix.
*
* return: Index of matrix (number of negative entries on diagonal)
*/
int kb_DSYTRF(N,H,stride,ipiv,info)
int N; /* matrix size */
REAL *H; /* start of storage */
int stride; /* entries between row starts */
int *ipiv; /* returned pivot info; my own scheme:
1-based indexing
abs value is what original column wound up here;
pos for 1x1, neg for first(!) of 2x2 pivots.
*/
int *info; /* 0 for success, -1 error, 1 singular */
{ int negs = 0;
int i,j,k;
*info = 0; /* default is success */
for ( i = 0 ; i < N ; i++ ) ipiv[i] = i+1; /* identity perm */
for ( i = 0 ; i < N ; i++ )
{ REAL colmax,rcolmax;
int r; /* row of max value */
int pivotsize = 1;
REAL *ispot,*jspot,*kspot;
/* first step is pivot selection */
colmax = 0.0;
r = -1;
for ( j = i+1 ; j < N ; j++ )
{ REAL v = fabs(H[j*stride + i]);
if ( v > colmax ) { colmax = v; r = j; }
}
if ( r == -1 ) /* zero column */
{ if ( H[i*stride+i] < 0.0 ) negs++;
else if ( H[i*stride+i] == 0.0 ) *info = 1;
goto skippivot;
}
if ( fabs(H[i*stride + i]) >= BK_alpha*colmax )
goto dopivot;
/* now need max in column r */
rcolmax = colmax;
for ( j = i+i ; j <= r ; j++ )
{ REAL v = fabs(H[r*stride+j]);
if ( v > rcolmax ) rcolmax = v;
}
for ( j = r+1 ; j < N ; j++ )
{ REAL v = fabs(H[j*stride+r]);
if ( v > rcolmax ) rcolmax = v;
}
if ( fabs(H[i*stride+i])*rcolmax >= BK_alpha*colmax*colmax )
goto dopivot;
if ( fabs(H[r*stride+r]) >= BK_alpha*rcolmax )
{
L_swap_columns(H,N,stride,i,r);
j = ipiv[i]; ipiv[i] = ipiv[r]; ipiv[r] = j;
}
else
{ pivotsize = 2;
L_swap_columns(H,N,stride,i+1,r);
j = ipiv[i+1]; ipiv[i+1] = ipiv[r]; ipiv[r] = j;
}
dopivot:
if ( pivotsize == 1 )
{ REAL pivot;
ispot = H+i*stride+i;
pivot = *ispot;
if ( pivot == 0.0 ) {*info = 1; goto skippivot;}
if ( pivot < 0.0 ) negs++;
pivot = 1/pivot;
for ( j = i+1 ; j < N ; j++ )
{ REAL x;
jspot = H+j*stride+i;
x = *jspot;
*jspot *= pivot;
kspot = ispot+stride;
for ( k = i+1, jspot++ ; k <= j ; k++, jspot++, kspot+=stride )
*jspot -= *kspot*x;
}
}
else /* pivotsize 2 */
{ REAL det,p11,p21,p22,tmp;
ispot = H+i*stride+i;
p11 = *ispot; ispot += stride;
p21 = *ispot;
p22 = ispot[1];
det = p11*p22 - p21*p21;
if ( (det > 0.0) && (p11+p22 < 0.0) ) negs += 2;
else if ( det < 0.0 ) negs++;
tmp = p11;
p11 = p22/det;
p22 = tmp/det;
p21 = -p21/det;
for ( j = i+2; j < N ; j++ )
{ REAL x1,x2;
jspot = H+j*stride+i;
x1 = jspot[0]; x2 = jspot[1];
jspot[0] = p11*x1 + p21*x2;
jspot[1] = p21*x1 + p22*x2;
kspot = ispot+stride;
for ( k = i+2, jspot+=2 ; k <= j ; k++, jspot++, kspot+=stride )
*jspot -= kspot[0]*x1 + kspot[1]*x2;
}
ipiv[i] = -ipiv[i];
i++;
}
skippivot: ;
}
return negs;
}
/**********************************************************************
*
* function: kb_DSYTRS()
*
* purpose: solve for single rhs using factored matrix.
*/
void kb_DSYTRS(N,LD,stride,ipiv,B,work,info)
int N;
REAL *LD; /* from kb_DSYTRF() */
int stride;
int *ipiv; /* ipiv[i] is what column wound up in column i, 1-based indexing */
REAL *B; /* rhs,solution */
REAL *work; /* must be size N */
int *info;
{ int i,j;
REAL *X = work;
REAL *ispot,*jspot;
/* permute */
for ( i = 0 ; i < N ; i++ ) work[i] = B[abs(ipiv[i])-1];
/* solve left factor */
for ( i = 0, ispot = LD ; i < N ; i++, ispot += stride )
{ if ( ipiv[i] > 0 ) /* 1x1 pivot */
{ for ( j = 0, jspot = ispot ; j < i ; j++,jspot++ )
X[i] -= (*jspot)*X[j];
}
else /* 2x2 pivot */
{ for ( j = 0, jspot = ispot ; j < i ; j++,jspot++ )
{ X[i] -= (*jspot)*X[j];
X[i+1] -= jspot[stride]*X[j];
}
i++; ispot += stride;
}
}
for ( i = 0, ispot = LD ; i < N ; i++, ispot+=stride+1 )
{ if ( ipiv[i] > 0 ) /* 1x1 pivot */
X[i] /= *ispot;
else /* 2x2 pivot */
{ REAL p11 = *ispot;
REAL p21 = ispot[stride];
REAL p22 = ispot[stride+1];
REAL det = p11*p22 - p21*p21;
REAL x1 = X[i], x2 = X[i+1];
X[i] = (p22*x1 - p21*x2)/det;
X[i+1] = (-p21*x1 + p11*x2)/det;
i++; ispot += stride+1;
}
}
for ( i = N-1 ; i >= 0 ; i-- )
{ if ( ipiv[i] > 0 ) /* 1x1 pivot */
for ( j = i+1, jspot = ispot ; j < N ; j++ )
X[i] -= LD[j*stride+i]*X[j];
else /* 2x2 pivot */
{ for ( j = i+2 ; j < N ; j++ )
{ X[i] -= LD[j*stride+i]*X[j];
}
}
}
/* permute */
for ( i = 0 ; i < N ; i++ )
B[abs(ipiv[i])-1] = work[i];
}
/************************************************************************
*
* function: kb_DSYTRI()
*
* purpose: convert factored matrix to inverse.
*
*/
void kb_DSYTRI(N,H,stride,ipiv,info)
int N;
REAL *H; /* from kb_DSYTRF() */
int stride;
int *ipiv; /* ipiv[i] is what column wound up in column i, 1-based indexing */
int *info;
{ int i,j,k;
REAL *ispot,sum,tmp;
/* convert L to inverse */
for ( i = 0 ; i < N ; i++ )
{ int jstart = (ipiv[i] < 0) ? i+2 : i+1;
for ( j = jstart ; j < N ; j++ )
{ int endk = ((i>0) && (ipiv[i-1] < 0)) ? i-1 : i;
for ( k = 0 ; k < endk ; k++ )
H[j*stride+k] -= H[i*stride+k]*H[j*stride+i];
H[j*stride+i] = -H[j*stride+i];
}
}
/* convert D to inverse */
for ( i = 0 ; i < N ; i++ )
{ ispot = H + i*stride + i;
if ( ipiv[i] > 0 )
*ispot = 1/(*ispot);
else /* 2x2 pivot */
{ REAL p11 = *ispot;
REAL p21 = ispot[stride];
REAL p22 = ispot[stride+1];
REAL det = p11*p22 - p21*p21;
H[i*stride+i] = p22/det;
H[(i+1)*stride+i] = -p21/det;
H[(i+1)*stride+i+1] = p11/det;
i++;
}
}
/* multiply out L^TD into upper triangle */
for ( i = 0 ; i < N ; i++ )
{ if ( ipiv[i] > 0 )
{ REAL p = H[i*stride+i];
for ( k = 0 ; k < i ; k++ )
H[k*stride+i] = p*H[i*stride+k];
}
else
{ REAL p11 = H[i*stride+i];
REAL p21 = H[(i+1)*stride+i];
REAL p22 = H[(i+1)*stride+i+1];
for ( k = 0 ; k < i ; k++ )
{ H[k*stride+i] = p11*H[i*stride+k] + p21*H[(i+1)*stride+k];
H[k*stride+i+1] = p21*H[i*stride+k] + p22*H[(i+1)*stride+k];
}
H[i*stride+i+1] = H[(i+1)*stride+i];
i++;
}
}
/* multiply the two triangles L^TD*L into the lower */
for ( i = 0 ; i < N ; i++ )
{
if ( ipiv[i] > 0 ) /* 1x1 pivot */
{
for ( j = 0 ; j < i ; j++ )
{
for ( k = i, sum = 0.0 ; k < N ; k++ )
sum += H[i*stride+k]*H[k*stride+j];
H[i*stride+j] = sum;
}
for ( j = i+1, sum = 0.0 ; j < N ; j++ )
sum += H[i*stride+j]*H[j*stride+i];
H[i*stride+i] += sum;
}
else /* 2x2 pivot */
{
for ( j = 0 ; j < i ; j++ )
{ REAL tmp;
for ( k = i, sum = 0.0 ; k < N ; k++ )
sum += H[i*stride+k]*H[k*stride+j];
tmp = sum;
for ( k = i, sum = 0.0 ; k < N ; k++ )
sum += H[(i+1)*stride+k]*H[k*stride+j];
H[(i+1)*stride+j] = sum;
H[i*stride+j] = tmp;
}
/* diagonal */
for ( j = i+2, sum = 0.0 ; j < N ; j++ )
sum += H[(i+1)*stride+j]*H[j*stride+i];
tmp = sum;
for ( j = i+2, sum = 0.0 ; j < N ; j++ )
sum += H[i*stride+j]*H[j*stride+i];
H[i*stride+i] += sum;
for ( j = i+2, sum = 0.0 ; j < N ; j++ )
sum += H[(i+1)*stride+j]*H[j*stride+(i+1)];
H[(i+1)*stride+(i+1)] += sum;
H[(i+1)*stride+i] += tmp;
i++;
}
}
/* permute, using upper triangle as work space */
/* diagonal, top row as work space */
for ( i = 0 ; i < N ; i++ )
H[0*stride+abs(ipiv[i])-1] = H[i*stride+i];
for ( i = 1 ; i < N ; i++ )
H[i*stride+i] = H[0*stride+i];
/* now the main part */
for ( i = 1 ; i < N ; i++ )
{ int fromi = abs(ipiv[i])-1;
for ( j = 0 ; j < i ; j++ )
{ int fromj = abs(ipiv[j])-1;
if ( fromi > fromj )
H[fromj*stride+fromi] = H[i*stride+j];
else
H[fromi*stride+fromj] = H[i*stride+j];
}
}
/* copy upper to lower */
for ( i = 1 ; i < N ; i++ )
for ( j = 0 ; j < i ; j++ )
H[i*stride+j] = H[j*stride+i];
}
/*************************************************************************
*
* function: LD_block_factor()
*
* purpose: Do LDL factoring in block form to take advantage of DGEMM.
*
* return: Index.
*/
/* returns index */
int LD_block_factor( H, N ) /* actually, D^-1 on diagonal */
REAL **H; /* lower block triangular, row by row */
/* i.e. each consecutive BLOCKSIZE rows same length, */
/* in multiples of BLOCKSIZE */
int N; /* size */
{ int i,j,k;
int info;
int rowcount; /* rows in block; less than blocksize for last block */
int negs = 0;
for ( i = 0 ; i < N ; i += blocksize ) /* pivot (i,i) */
{ /* get pivot inverse in place */
int stride = i+blocksize;
rowcount = (N - i > blocksize) ? blocksize : N - i;
/* Inverse of diagonal block */
/* Bunch-Kaufman factor */
negs += kb_DSYTRF(rowcount,&H[i][i],stride,ipiv,&info);
/* now the inverse */
kb_DSYTRI(rowcount,&H[i][i],stride,ipiv,&info);
/* update row */
for ( j = i+blocksize ; j < N ; j += blocksize ) /* row j */
{ REAL x = H[j][i];
char transa = 'T';
char transb = 'N';
REAL alpha = -1.0;
REAL beta = 1.0;
int stridea;
int strideb;
int stridec;
char side = 'L';
int ii,jj;
char uplo;
rowcount = (N - j > blocksize) ? blocksize : N - j;
for ( k = i+blocksize ; k < j ; k += blocksize ) /* col k */
{ stridea = k+blocksize;
strideb = j+blocksize;
stridec = j+blocksize;
DGEMM(&transa,&transb,&blocksize,&rowcount,&blocksize,&alpha,
&H[k][i],&stridea,&H[j][i],&strideb,&beta,&H[j][k],&stridec);
}
/* H[j][i] = x*pivot; temp store result in work */
alpha = 1.0;
beta = 0.0;
stridea = i+blocksize;
strideb = j+blocksize;
stridec = blocksize;
alpha = 1.0; beta = 0.0;
side = 'L'; /* symmetric matrix on the left */
uplo = 'U'; /* transposed since Fortran */
DSYMM(&side,&uplo,&blocksize,&rowcount,&alpha,&H[i][i],&stridea,
&H[j][i],&strideb,&beta,&workspace[0][0],&stridec);
/* H[j][j] -= x*pivot*x; */
transa = 'T';
transb = 'N';
alpha = -1.0;
beta = 1.0;
stridea = j+blocksize;
strideb = blocksize;
stridec = j+blocksize;
DGEMM(&transa,&transb,&rowcount,&rowcount,&blocksize,&alpha,
&H[j][i],&stridea,&workspace[0][0],&strideb,&beta,&H[j][j],&stridec);
/* copy workspace back to H[j][i] */
for ( jj = 0 ; jj < rowcount ; jj++ )
for ( ii = 0 ; ii < blocksize ; ii++ )
H[j+jj][i+ii] = workspace[jj][ii];
}
}
return negs;
}
/**************************************************************************
*
* function: LD_block_solve()
*
* purpose: Solve for single right hand side using factoring produced
* by LD_block_factor().
*/
void LD_block_solve(LD,B,X,N)
REAL **LD; /* from LD_block_factor(), inverse blocks on diagonal */
REAL *B; /* rhs */
REAL *X; /* solution */
int N; /* size of system */
{ int i,j;
REAL alpha = 0.0;
REAL beta = 0.0;
int stridea = 1;
int incx=1,incy=1;
char trans = 'N';
int rowcount; /* rows in block; less than blocksize at end */
for ( i = 0 ; i < N ; i++ ) X[i] = B[i];
for ( i = 0 ; i < N ; i += blocksize )
{
rowcount = (N - i > blocksize) ? blocksize : N - i;
for ( j = 0 ; j < i ; j += blocksize )
{ /* X[i] -= LD[i][j]*X[j]; */
alpha = -1.0;
beta = 1.0;
stridea = i+blocksize;
incx = 1;
incy = 1;
trans = 'T';
DGEMV(&trans,&blocksize,&rowcount,&alpha,&LD[i][j],&stridea,
&X[j],&incx,&beta,&X[i],&incy);
}
}
for ( i = 0 ; i < N ; i += blocksize )
{ /* X[i] /= LD[i][i]; */
char uplo = 'U';
rowcount = (N - i > blocksize) ? blocksize : N - i;
alpha = 1.0;
beta = 0.0;
stridea = i+blocksize;
incx = 1;
incy = 1;
DSYMV(&uplo,&rowcount,&alpha,&LD[i][i],&stridea,&X[i],&incx,
&beta,&workv[0],&incy); /* need separate destination */
for ( j = 0 ; j < rowcount ; j++ )
X[i+j] = workv[j];
}
for ( i = N-rowcount ; i >= 0 ; i -= blocksize )
{
for ( j = i+blocksize ; j < N ; j += blocksize )
{ /* X[i] -= LD[j][i]*X[j]; */
rowcount = (N - j > blocksize) ? blocksize : N - j;
alpha = -1.0;
beta = 1.0;
stridea = j+blocksize;
incx = 1;
incy = 1;
trans = 'N';
DGEMV(&trans,&blocksize,&rowcount,&alpha,&LD[j][i],&stridea,
&X[j],&incx,&beta,&X[i],&incy);
}
}
}
#endif
/**********************************************************************/
/* Now some Bezier and Lagrange stuff for refining and graphics
subdivision
*/
/**********************************************************************
*
* function: bezier_eval()
*
* purpose: Evaluation of multi-dimensional simplicial Bezier basis
* function at given point.
*/
REAL bezier_eval ARGS4((order,dim,inx,x),
int order, /* Lagrange order */
int dim, /* simplicial dimension */
int *inx, /* which basis function, barycentric, sums to order */
REAL *x) /* barycentric coords of target, sums to 1 */
{ REAL prod, prodpart[MAXCOORD];
int i,j,k,mm;
for ( k = 0 ; k <= dim ; k++ ) prodpart[k] = 0.0;
for ( i = 0, prod = 1.0, mm = 1 ; i <= dim ; i++ )
for ( j = 0 ; j < inx[i] ; j++, mm++ )
{ for ( k = 0 ; k <= dim ; k++ )
{ prodpart[k] *= mm*x[i]/(j+1);
if ( i == k ) prodpart[k] += prod*mm/(j+1.);
}
prod *= mm*x[i]/(j+1.);
}
return prod;
}
/***************************************************************************
*
* function: bezier_eval_1d()
*
* purpose: Get point on curve at given parameter.
*/
void bezier_eval_1d ARGS5((order,sdim,p,ctrl,dest),
int order,
int sdim, /* space dimension*/
REAL p, /* parameter, 0 to 1 */
REAL **ctrl, /* control point coordinates */
REAL *dest) /* output point */
{ int inx[2];
REAL t[2];
int i,k;
t[0] = p; t[1] = 1 - p;
for ( k = 0 ; k < sdim ; k++ ) dest[k] = 0.0;
for ( i = 0 ; i <= order ; i++ )
{ REAL bezval;
inx[0] = order-i;
inx[1] = i;
bezval = bezier_eval(order,1,inx,t);
for ( k = 0 ; k < sdim ; k++ )
dest[k] += bezval*ctrl[i][k];
}
}
/***************************************************************************
*
* function: bezier_convert_1D_init()
*
* purpose: initialize matrix for converting from points on curve to
* control points.
*
*/
void bezier_convert_1D_init ARGS1((order),
int order)
{ int i,j;
REAL x[2]; /* barycentric coords of target point */
int inx[2]; /* barycentric index of basis function */
REAL **a = dmatrix(0,order,0,order);
REAL **b = dmatrix(0,order,0,order);
if ( bezier1invert[order] ) return;
/* fill in forward matrix */
for ( i = 0 ; i <= order ; i++ ) /* point on curve */
{ x[0] = (order-i)/(REAL)order;
x[1] = i/(REAL)order;
for ( j = 0 ; j <= order ; j++ ) /* control point */
{ inx[0] = order-j;
inx[1] = j;
a[i][j] = b[i][j] = bezier_eval(order,1,inx,x);
}
}
mat_inv(a,order+1);
bezier1invert[order] = a;
bezier1revert[order] = b;
}
/***************************************************************************
*
* function: bezier_convert_2D_init()
*
* purpose: initialize matrix for converting from points on surface to
* control points.
*
*/
void bezier_convert_2D_init ARGS1((order),
int order)
{ int i,j,k,m,kk,mm;
REAL x[3]; /* barycentric coords of target point */
int inx[3]; /* barycentric index of basis function */
int numpts = ((order+1)*(order+2))/2;
REAL **a = dmatrix(0,numpts-1,0,numpts-1);
REAL **b = dmatrix(0,numpts-1,0,numpts-1);
if ( bezier2invert[order] ) return;
/* fill in forward matrix */
for ( i = 0, kk=0 ; i <= order ; i++ ) /* point on curve */
for ( k = 0 ; i+k <= order ; k++,kk++ ) /* point on curve */
{ x[0] = (order-i-k)/(REAL)order;
x[1] = i/(REAL)order;
x[2] = k/(REAL)order;
for ( j = 0, mm=0 ; j <= order ; j++ ) /* control point */
for ( m = 0 ; m+j <= order ; m++,mm++ ) /* control point */
{ inx[0] = order-j-m;
inx[1] = j;
inx[2] = m;
a[kk][mm] = b[kk][mm] = bezier_eval(order,2,inx,x);
}
}
mat_inv(a,numpts);
bezier2invert[order] = a;
bezier2revert[order] = b;
}
/*************************************************************************
*
* function: bezier_trans_1d()
*
* purpose: Create transition matrix from old order bezier control points
* to new. Goes through intermediary of curve points.
*/
void bezier_trans_1d ARGS3((old_order,new_order,trans),
int old_order,
int new_order,
REAL **trans) /* trans[new][old] */
{ int i,k;
int inx[2];
REAL t[2];
MAT2D(x,MAXLAGRANGE+1,MAXLAGRANGE+1); /* old control to curve points */
if ( !bezier1invert[new_order] )
bezier_convert_1D_init(new_order);
/* old control to curve point matrix */
for ( i = 0 ; i <= new_order ; i++ )
{
t[0] = (new_order - i)/(REAL)new_order;
t[1] = i/(REAL)new_order;
for ( k = 0 ; k <= old_order ; k++ )
{ inx[0] = old_order-k; inx[1] = k;
x[i][k] = bezier_eval(old_order,1,inx,t);
}
}
/* now get final transition matrix */
mat_mult(bezier1invert[new_order],x,trans,new_order+1,new_order+1,old_order+1);
}
/*************************************************************************
*
* function: bezier_trans_2d()
*
* purpose: Create transition matrix from old order bezier control points
* to new. Goes through intermediary of surface points.
*/
void bezier_trans_2d ARGS3((old_order,new_order,trans),
int old_order,
int new_order,
REAL **trans) /* trans[new][old] */
{ int i,j,k,m,jj,kk;
int inx[3];
REAL t[3];
int old_numpts = ((old_order+1)*(old_order+2))/2;
int new_numpts = ((new_order+1)*(new_order+2))/2;
REAL **x;
/* old control to surface points */
x = dmatrix(0,new_numpts-1,0,old_numpts-1);
if ( !bezier2invert[new_order] )
bezier_convert_2D_init(new_order);
/* old control to surface point matrix */
for ( j = 0, jj=0 ; j <= new_order ; j++ )
for ( i = 0 ; i+j <= new_order ; i++,jj++ )
{
t[0] = (new_order - i - j)/(REAL)new_order;
t[1] = j/(REAL)new_order;
t[2] = i/(REAL)new_order;
for ( k = 0, kk = 0 ; k <= old_order ; k++ )
for ( m = 0 ; m+k <= old_order ; m++, kk++ )
{ inx[0] = old_order-k-m; inx[1] = k; inx[2] = m;
x[jj][kk] = bezier_eval(old_order,2,inx,t);
}
}
/* now get final transition matrix */
mat_mult(bezier2invert[new_order],x,trans,new_numpts,new_numpts,old_numpts);
}
/***************************************************************************
*
* function: bezier_refine_1d_init()
*
* purpose: set up matrices for calculating new control points for
* refined edge.
*/
void bezier_refine_1d_init ARGS1((order),
int order)
{ int i,k;
int inx[2];
REAL t[2];
MAT2D(x,2*MAXLAGRANGE+1,MAXLAGRANGE+1); /* old control to curve points */
if ( bezier_refine_1d[order] ) return;
bezier_refine_1d[order] = dmatrix(0,2*order,0,order);
if ( !bezier1invert[order] )
bezier_convert_1D_init(order);
/* old control to curve point matrix */
for ( i = 0 ; i <= 2*order ; i++ )
{
t[0] = (2*order - i)/(REAL)(2*order);
t[1] = i/(REAL)(2*order);
for ( k = 0 ; k <= order ; k++ )
{ inx[0] = order-k; inx[1] = k;
x[i][k] = bezier_eval(order,1,inx,t);
}
}
/* now get final transition matrix */
mat_mult(bezier1invert[order],x,bezier_refine_1d[order],
order+1,order+1,order+1);
mat_mult(bezier1invert[order],x+order,bezier_refine_1d[order]+order,
order+1,order+1,order+1);
}
/***************************************************************************
*
* function: bezier_refine_2d_init()
*
* purpose: set up matrices for calculating new control points for
* refined facet.
*/
void bezier_refine_2d_init ARGS1((order),
int order)
{ int i,j,k,m,kk,mm,jj;
int inx[3];
REAL t[3];
int old_numpts = ((order+1)*(order+2))/2;
int new_numpts = (2*order+1)*(order+1);
REAL ***x = dmatrix3(2*order+1,2*order+1,old_numpts);
/* old control to curve points */
REAL **z,**w; /* for pieces of whole matrix */
if ( bezier_refine_2d[order] ) return;
bezier_refine_2d[order] = dmatrix(0,new_numpts,0,old_numpts);
if ( !bezier2invert[order] )
bezier_convert_2D_init(order);
/* old control to curve point matrix */
for ( j = 0 ; j <= 2*order ; j++ )
for ( i = 0 ; i+j <= 2*order ; i++ )
{
t[0] = (2*order - i - j)/(REAL)(2*order);
t[1] = j/(REAL)(2*order);
t[2] = i/(REAL)(2*order);
for ( k = 0, kk = 0 ; k <= order ; k++ )
for ( m = 0 ; m+k <= order ; m++,kk++ )
{ inx[0] = order-k-m; inx[1] = k; inx[2] = m;
x[i][j][kk] = bezier_eval(order,2,inx,t);
}
}
/* now get final transition matrix in four sections */
z = dmatrix(0,old_numpts-1,0,old_numpts-1);
w = dmatrix(0,old_numpts-1,0,old_numpts-1);
/* lower left */
for ( j = 0, jj = 0 ; j <= order ; j++ )
for ( i = 0 ; i+j <= order ; i++, jj++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
z[jj][kk] = x[i][j][kk];
mat_mult(bezier2invert[order],z,w,old_numpts,old_numpts,old_numpts);
for ( j = 0, jj = 0, mm = 0 ; j <= order ; j++, mm += order )
for ( i = 0 ; i+j <= order ; i++, jj++, mm++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
bezier_refine_2d[order][mm][kk] = w[jj][kk];
/* lower right */
for ( j = 0, jj = 0 ; j <= order ; j++ )
for ( i = 0 ; i+j <= order ; i++, jj++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
z[jj][kk] = x[i+order][j][kk];
mat_mult(bezier2invert[order],z,w,old_numpts,old_numpts,old_numpts);
for ( j = 0, jj = 0, mm = order ; j <= order ; j++, mm += order )
for ( i = 0 ; i+j <= order ; i++, jj++, mm++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
bezier_refine_2d[order][mm][kk] = w[jj][kk];
/* upper left */
for ( j = 0, jj = 0 ; j <= order ; j++ )
for ( i = 0 ; i+j <= order ; i++, jj++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
z[jj][kk] = x[i][j+order][kk];
mat_mult(bezier2invert[order],z,w,old_numpts,old_numpts,old_numpts);
for ( j = 0, jj = 0, mm = 3*((order+1)*order)/2 ; j <= order ; j++ )
for ( i = 0 ; i+j <= order ; i++, jj++, mm++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
bezier_refine_2d[order][mm][kk] = w[jj][kk];
/* middle */
for ( j = order, jj = 0 ; j >= 0 ; j-- )
for ( i = order ; i+j >= order ; i--, jj++ )
for ( kk = 0 ; kk < old_numpts ; kk++ )
z[jj][kk] = x[i][j][kk];
mat_mult(bezier2invert[order],z,w,old_numpts,old_numpts,old_numpts);
for ( j=order, jj=0, mm = ((3*order+2)*(order+1))/2-1 ; j >= 0 ;
j--,mm -= 2*(order-j)-1 )
for ( i = order ; i+j >= order ; i--, jj++, mm-- )
for ( kk = 0 ; kk < old_numpts ; kk++ )
bezier_refine_2d[order][mm][kk] = w[jj][kk];
free_matrix3(x);
free_matrix(z);
free_matrix(w);
}
/***********************************************************************
*
* function: lagrange_eval_1d()
*
* purpose: Evaluate one curve point using Lagrange interpolation.
*/
void lagrange_eval_1d ARGS5((order,sdim,t,ctrl,dest),
int order,
int sdim, /* space dimension*/
REAL t, /* parameter, 0 to 1 */
REAL **ctrl, /* control point coordinates */
REAL *dest) /* output point */
{
int i,k,m;
for ( k = 0 ; k < sdim ; k++ )
dest[k] = 0.0;
for ( i = 0 ; i <= order ; i++ )
{
REAL p=1.0;
for ( m = 0 ; m <= order ; m++ )
{ if ( m == i ) continue;
p *= (t*order - m)/(i - m);
}
for ( k = 0 ; k < sdim ; k++ )
dest[k] += p*ctrl[i][k];
}
}
/***********************************************************************
*
* function: lagrange_eval_2d()
*
* purpose: Evaluate one surface point using Lagrange 2D interpolation.
*/
void lagrange_eval_2d ARGS5((order,sdim,t,ctrl,dest),
int order,
int sdim, /* space dimension*/
REAL *t, /* parameters, 0 to 1 */
REAL **ctrl, /* control point coordinates, in linear order */
REAL *dest) /* output point */
{
int i,j,k,m,jj;
for ( m = 0 ; m < sdim ; m++ )
dest[m] = 0.0;
for ( j = 0, jj = 0 ; j <= order ; j++ )
{
for ( i = 0 ; i+j <= order ; i++,jj++ )
{ REAL p=1.0;
k = order-i-j;
for ( m = 0 ; m < i ; m++ )
p *= (t[0]*order - m)/(i - m);
for ( m = 0 ; m < j ; m++ )
p *= (t[1]*order - m)/(j - m);
for ( m = 0 ; m < k ; m++ )
p *= ((1-t[0]-t[1])*order - m)/(k - m);
for ( m = 0 ; m < sdim ; m++ )
dest[m] += p*ctrl[jj][m];
}
}
}
/***************************************************************************
*
* function: bezier_eval_2d()
*
* purpose: Get point on surface at given parameters.
*/
void bezier_eval_2d ARGS5((order,sdim,p,ctrl,dest),
int order,
int sdim, /* space dimension*/
REAL *p, /* two parameters, 0 to 1 barycentric */
REAL **ctrl, /* control point coordinates, in linear order */
REAL *dest) /* output point */
{ int inx[3];
REAL t[3];
int i,j,k,jj;
t[0] = p[0]; t[1] = p[1]; t[2] = 1.0 - t[0] - t[1];
for ( k = 0 ; k < sdim ; k++ ) dest[k] = 0.0;
for ( j = 0, jj = 0 ; j <= order ; j++ )
for ( i = 0 ; i+j <= order ; i++,jj++ )
{ REAL bezval;
inx[0] = order-i-j;
inx[1] = j;
inx[2] = i;
bezval = bezier_eval(order,2,inx,t);
for ( k = 0 ; k < sdim ; k++ )
dest[k] += bezval*ctrl[jj][k];
}
}
/**************************************************************************
*
* function: tetra_vol()
*
* purpose: calculate volume of a tetrahedron in 3D from its four vertices.
*/
REAL tetra_vol ARGS4((a,b,c,d),
REAL *a, REAL *b, REAL *c, REAL *d)
{ REAL bb[3],cc[3],dd[3];
REAL vol;
int i;
for ( i = 0 ; i < 3 ; i++ )
{ bb[i] = b[i] - a[i];
cc[i] = c[i] - a[i];
dd[i] = d[i] - a[i];
}
vol = (bb[0]*(cc[1]*dd[2] - cc[2]*dd[1]) + bb[1]*(cc[2]*dd[0] - cc[0]*dd[2])
+ bb[2]*(cc[0]*dd[1] - cc[1]*dd[0]))/6;
return vol;
}
/****************************************************************************
*
* function: matrix_multiply_command()
*
* purpose: implements the matrix_multiply user command.
*/
void matrix_multiply_command ARGS6((a,b,c,adata,bdata,cdata),
struct array *a, struct array *b,struct array *c, /* array infofor the matrices */
REAL *adata, REAL *bdata, REAL *cdata ) /* data addresses */
{
int i,j,k;
if ( (a->dim == 2) && (b->dim == 2) )
{
if ( c->dim != 2 )
kb_error(3798,"matrix_multiply third array is not two-dimensional.\n",
RECOVERABLE);
if ( a->sizes[1] != b->sizes[0] )
kb_error(4012,
"matrix_multiply: sizes of first and second matrices disagree.\n",
RECOVERABLE);
if ( a->sizes[0] != c->sizes[0] )
kb_error(3217,
"matrix_multiply: sizes of first and third matrices disagree.\n",
RECOVERABLE);
if ( b->sizes[1] != c->sizes[1] )
kb_error(3862,
"matrix_multiply: sizes of second and third matrices disagree.\n",
RECOVERABLE);
/* finally ready to roll */
for ( i = 0 ; i < a->sizes[0] ; i++ )
for ( j = 0 ; j < b->sizes[1] ; j++ )
{ REAL sum = 0.0;
for ( k = 0 ; k < a->sizes[1] ; k++ )
sum += adata[i*a->sizes[1]+k]*bdata[k*b->sizes[1]+j];
cdata[i*c->sizes[1]+j] = sum;
}
return;
} /* end 2D by 2D */
if ( (a->dim == 1) && (b->dim == 2) )
{
if ( c->dim != 1 )
kb_error(4013,"matrix_multiply third array is not one-dimensional.\n",
RECOVERABLE);
if ( a->sizes[0] != b->sizes[0] )
kb_error(3860,
"matrix_multiply: sizes of first and second matrices disagree.\n",
RECOVERABLE);
if ( b->sizes[1] != c->sizes[0] )
kb_error(4010,
"matrix_multiply: sizes of second and third matrices disagree.\n",
RECOVERABLE);
/* finally ready to roll */
for ( j = 0 ; j < b->sizes[1] ; j++ )
{ REAL sum = 0.0;
for ( k = 0 ; k < a->sizes[0] ; k++ )
sum += adata[k]*bdata[k*b->sizes[1]+j];
cdata[j] = sum;
}
return;
} /* end 1D by 2D */
if ( (a->dim == 2) && (b->dim == 1) )
{
if ( c->dim != 1 )
kb_error(4014,"matrix_multiply third array is not one-dimensional.\n",
RECOVERABLE);
if ( a->sizes[1] != b->sizes[0] )
kb_error(4011,
"matrix_multiply: sizes of first and second matrices disagree.\n",
RECOVERABLE);
/* finally ready to roll */
for ( i = 0 ; i < a->sizes[0] ; i++ )
{ REAL sum = 0.0;
for ( k = 0 ; k < a->sizes[1] ; k++ )
sum += adata[i*a->sizes[1]+k]*bdata[k];
cdata[i] = sum;
}
return;
} /* end 2D by 1D */
kb_error(3869,"matrix_multiply: illegal matrix dimensions\n",RECOVERABLE);
}
/****************************************************************************
*
* function: matrix_inverse_command()
*
* purpose: implements the matrix_inverse user command.
*/
int matrix_inverse_command ARGS4((a,b,adata,bdata),
struct array *a,struct array *b,/* variable id numbers for the matrices */
REAL *adata,REAL *bdata /* source and destination matrices */
)
{
int i;
int retval = 1; /* 1 for success, 0 for singular */
REAL **bptrs;
if ( a->sizes[0] != a->sizes[1] )
kb_error(3218, "matrix_inverse: first matrix is not square.\n",
RECOVERABLE);
if ( b->sizes[0] != b->sizes[1] )
kb_error(3872, "matrix_inverse: second matrix is not square.\n",
RECOVERABLE);
if ( a->sizes[0] != b->sizes[0] )
kb_error(3873,
"matrix_inverse: sizes of first and second matrices disagree.\n",
RECOVERABLE);
if ( bdata != adata )
for ( i = 0 ; i < a->datacount ; i++ )
bdata[i] = adata[i];
/* set up row pointers in allocated space after data */
bptrs = (REAL**)(bdata + b->datacount);
for ( i = 0 ; i < b->sizes[0] ; i++ )
bptrs[i] = bdata + i*b->sizes[1];
/* finally ready to roll */
retval = mat_inv(bptrs,a->sizes[0]);
if ( retval < 0 )
retval = 0;
return retval;
}
/****************************************************************************
*
* function: matrix_determinant_command()
*
* purpose: implements the matrix_determinant user command.
*/
REAL matrix_determinant_command ARGS2((a,adata),
struct array *a, /* variable id numbers for the matrix */
REAL *adata ) /* data address */
{
REAL **atmp;
int i,j;
REAL retval;
if ( a->sizes[0] != a->sizes[1] )
kb_error(3220, "matrix_determinant: matrix is not square.\n",
RECOVERABLE);
if ( a->datatype != REAL_TYPE )
kb_error(3221,"matrix_determinant: matrix is not of type REAL.\n",
RECOVERABLE);
atmp = dmatrix(0,a->sizes[0],0,a->sizes[1]);
for ( i = 0 ; i < a->sizes[0] ; i++ )
for ( j = 0 ; j < a->sizes[1] ; j++ )
atmp[i][j] = adata[i*a->sizes[0]+j];
/* finally ready to roll */
retval = determinant(atmp,a->sizes[0]);
free_matrix(atmp);
return retval;
}
evolver-2.30c.dfsg/src/sqcurve2.c 0000644 0001753 0001753 00000246345 11410765113 017151 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************************
*
* File: sqcurve2.c
*
* Purpose: Does calculations needed for including square curvature
* in energy. Linear model only.
* Named quantity methods.
*/
#include "include.h"
static int h0_flag; /* set to use (H - H_0)^2 */
static REAL h0_value; /* value of H_0 */
static REAL sq_mean_mix; /* proportion for mix_sq_mean_curvature */
static REAL selfsim_coeff; /* self similarity */
long sqcurve_init_timestamp; /* when last initialized */
long sqcurve_grad_init_timestamp; /* when last initialized */
/* local prototypes */
void sqcurve_energy_precalc ARGS((vertex_id *,REAL (*)[MAXCOORD],WRAPTYPE*));
void sqcurve_grad_precalc ARGS((vertex_id *,edge_id *,REAL (*)[MAXCOORD],
WRAPTYPE*));
/***********************************************************************
*
* Function: sqcurve_method_init()
*
* Purpose: Initializes data structures for square curvature.
*/
void sqcurve_method_init(mode,mi)
int mode; /* METHOD_VALUE or METHOD_GRADIENT */
struct method_instance *mi;
{ int k,n;
facet_id f_id;
struct gen_quant_method *gm;
MAT2D(x,MAXCOORD,MAXCOORD);
vertex_id vv_id;
WRAPTYPE wraps[FACET_VERTS];
int eltype;
if ( web.modeltype != LINEAR )
kb_error(1758,"sq_mean_curvature method method only for LINEAR model.\n",
RECOVERABLE);
if ( everything_quantities_flag && square_curvature_flag)
GEN_QUANT(sq_mean_curv_quantity_num)->modulus =
globals(square_curvature_param)->value.real;
if ( mi )
{
if ( sq_mean_curvature_mi < 0 )
{ /* see what method indices correspond to what methods */
for ( n=0,gm = basic_gen_methods ; gm->name[0] != ' ' ; gm++,n++ )
{ if ( stricmp(gm->name,"sq_mean_curvature") == 0 )
sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"eff_area_sq_mean_curvature") == 0 )
eff_area_sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"normal_sq_mean_curvature") == 0 )
normal_sq_mean_curvature_mi = n;
if ( stricmp(gm->name,"mix_sq_mean_curvature") == 0 )
mix_sq_mean_curvature_mi = n;
}
}
if ( mi->gen_method == eff_area_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(1759,"eff_area_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
if ( mi->gen_method == normal_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(1760,"normal_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
if ( mi->gen_method == normal_sq_mean_curvature_mi )
if ( SDIM != 3 )
kb_error(1450,"mix_sq_mean_curvature method only for 3D space.\n",
RECOVERABLE);
/* get mix coefficient */
if ( mi->gen_method == normal_sq_mean_curvature_mi )
{ k = lookup_global("sq_mean_mix");
if ( k >= 0 ) sq_mean_mix = globals(k)->value.real;
else sq_mean_mix = 0.0;
}
} /* end if ( mi ) */
/* see if using (H - H_0)^2 adjustment */
h0_flag = 0;
h0_attr = find_extra("h_zero",&eltype);
if ( h0_attr >= 0 )
h0_flag = H0_IN_ATTR;
else
{ k = lookup_global("h_zero");
if ( k >= 0 )
{ h0_flag = H0_IN_GLOBAL;
h0_value = globals(k)->value.real;
}
}
if ( self_similar_flag )
{ int param = lookup_global(SELFSIM_NAME);
if ( param < 0 ) /* missing, so add */
{ param = add_global(SELFSIM_NAME);
globals(param)->value.real = 1.0; /* default */
globals(param)->flags |= ORDINARY_PARAM | RECALC_PARAMETER | ALWAYS_RECALC;
}
selfsim_coeff = globals(param)->value.real/6; /* area and volume factor */
if ( h0_flag == 0 ) { h0_flag = H0_IN_GLOBAL; h0_value = 0.0; }
}
/* necessary precalculations, if anything changed */
if ( ( mode == METHOD_VALUE )
&& ( sqcurve_init_timestamp < global_timestamp || !v_curve) )
{
v_curve = (struct v_curve_t *)temp_calloc(web.skel[VERTEX].max_ord+1,
sizeof(struct v_curve_t));
FOR_ALL_FACETS(f_id)
{ /* get side vectors */
int i,j;
vertex_id v_id[FACET_VERTS];
facetedge_id fe_id;
REAL side[FACET_EDGES][MAXCOORD];
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
v_id[i] = get_fe_tailv(fe_id);
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_id,x,wraps); /* in tail order */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = x[ii][j] - x[i][j];
}
sqcurve_energy_precalc(v_id,side,wraps);
}
sqcurve_init_timestamp = global_timestamp;
}
if ( ( mode == METHOD_GRADIENT )
&& ( sqcurve_grad_init_timestamp < global_timestamp || !v_curve ) )
{
MAT2D(a,MAXCOORD,MAXCOORD);
REAL af[MAXCOORD], gaf[MAXCOORD];
MAT2D(grad,MAXCOORD,MAXCOORD);
MAT2D(adft,MAXCOORD,MAXCOORD);
MAT3D(seconds,MAXCOORD,MAXCOORD,MAXCOORD);
v_curve = (struct v_curve_t *)temp_calloc(web.skel[VERTEX].max_ord+1,
sizeof(struct v_curve_t));
e_curve = (struct e_curve_t *)temp_calloc(web.skel[EDGE].max_ord+1,
sizeof(struct e_curve_t));
FOR_ALL_FACETS(f_id)
{ /* get side vectors */
int i,j;
vertex_id v_id[FACET_VERTS];
edge_id e_id[FACET_VERTS];
facetedge_id fe_id;
REAL side[FACET_EDGES][MAXCOORD];
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
v_id[i] = get_fe_tailv(fe_id);
e_id[i] = get_fe_edge(fe_id);
fe_id = get_next_edge(fe_id);
}
get_facet_verts(f_id,x,wraps); /* in tail order */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = x[ii][j] - x[i][j];
}
sqcurve_grad_precalc(v_id,e_id,side,wraps);
}
FOR_ALL_VERTICES(vv_id)
{ struct v_curve_t *vc = v_curve + loc_ordinal(vv_id);
if ( !boundary_curvature_flag ) vc->a = vc->area;
if ( (get_vattr(vv_id) & CONSTRAINT) && !(sqcurve_ignore_constr) )
{ conmap_t * conmap = get_v_constraint_map(vv_id);
int i,j,oncount = 0;
struct constraint *con[MAXCONPER];
REAL perp[MAXCOORD];
REAL dummy;
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
if ( conmap[j] & CON_HIT_BIT )
con[oncount++] = get_constraint(conmap[j]);
/* stuff for gradient of projection operator */
for ( j = 0 ; j < oncount ; j++ )
eval_second(con[j]->formula,get_coord(vv_id),SDIM,&dummy,
grad[j],seconds[j],vv_id);
/* construct matrix A */
for ( i = 0 ; i < oncount ; i++ )
for ( j = 0 ; j < oncount ; j++ )
a[i][j] = SDIM_dot(grad[i],grad[j]);
/* invert */
mat_inv(a,oncount);
mat_mult(a,grad,adft,oncount,oncount,SDIM);
matvec_mul(adft,vc->force,af,oncount,SDIM);
vec_mat_mul(af,grad,gaf,oncount,SDIM);
for ( k = 0 ; k < SDIM ; k++ )
{ REAL sum = 0.0;
for ( i = 0 ; i < oncount ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ sum += af[i]*seconds[i][k][j]*gaf[j];
sum += vc->force[j]*seconds[i][k][j]*af[i];
}
vc->fpgradf[k] = -2*sum;
}
constr_proj(TANGPROJ,oncount,con,get_coord(vv_id),
vc->force,perp,NULL,NO_DETECT,NULLID);
for ( j = 0 ; j < SDIM ; j++ )
vc->force[j] -= perp[j];
constr_proj(TANGPROJ,oncount,con,get_coord(vv_id),
vc->normal,perp,NULL,NO_DETECT,NULLID);
for ( j = 0 ; j < SDIM ; j++ )
vc->normal[j] -= perp[j];
}
if ( h0_flag )
{ vc->norm = SDIM_dot(vc->normal,vc->normal);
vc->f = SDIM_dot(vc->force,vc->normal);
vc->h = vc->f/vc->norm*3;
switch ( h0_flag )
{ case H0_IN_GLOBAL: vc->term = vc->h - h0_value; break;
case H0_IN_ATTR: vc->term = vc->h - *VREAL(vv_id,h0_attr); break;
}
}
}
sqcurve_grad_init_timestamp = global_timestamp;
}
}
/********************************************************************
*
* Function: sqcurve_energy_precalc()
*
* Purpose: Does square curvature energy calculation for a facet.
*
*/
void sqcurve_energy_precalc(v_id,side,wraps)
vertex_id *v_id; /* vertex list for facet */
REAL (*side)[MAXCOORD]; /* side vectors */
WRAPTYPE *wraps; /* in case of symmetry group */
{
REAL t1t1,t1t2,t2t2;
REAL det;
struct v_curve_t *vc[FACET_VERTS];
int i,j;
REAL area;
t1t1 = SDIM_dot(side[0],side[0]);
t1t2 = SDIM_dot(side[0],side[1]);
t2t2 = SDIM_dot(side[1],side[1]);
det = t1t1*t2t2 - t1t2*t1t2;
area = sqrt(det)/2;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vc[i] = v_curve + loc_ordinal(v_id[i]);
vc[i]->area += area;
}
if ( boundary_curvature_flag ) /* apportion area differently */
{ int fixcount = 0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
if ( get_vattr(v_id[i]) & (BOUNDARY|FIXED) ) fixcount++;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vc[i] = v_curve+loc_ordinal(v_id[i]);
if ( !(get_vattr(v_id[i]) & (BOUNDARY|FIXED)) )
vc[i]->a += 3*area/(3-fixcount);
}
}
if ( area > 0.0 )
{ if ( web.symmetry_flag )
{ REAL f[FACET_VERTS][MAXCOORD];
REAL wforce[MAXCOORD]; /* unwrapped forces */
for ( i = 0 ; i < SDIM ; i++ )
{ f[0][i] = -(t2t2*side[0][i]-t1t2*side[1][i])/4/area;
f[1][i] = (t2t2*side[0][i]-t1t2*side[1][i])/4/area;
f[2][i] = (t1t1*side[1][i]-t1t2*side[0][i])/4/area;
f[1][i] -= (t1t1*side[1][i]-t1t2*side[0][i])/4/area;
}
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{ (*sym_form_pullback)(get_coord(v_id[i]),wforce,f[i],wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->force[j] += wforce[j];
}
}
else for ( i = 0 ; i < SDIM ; i++ )
{ vc[0]->force[i] -= (t2t2*side[0][i]-t1t2*side[1][i])/4/area;
vc[1]->force[i] += (t2t2*side[0][i]-t1t2*side[1][i])/4/area;
vc[2]->force[i] += (t1t1*side[1][i]-t1t2*side[0][i])/4/area;
vc[1]->force[i] -= (t1t1*side[1][i]-t1t2*side[0][i])/4/area;
}
}
/* accumulate normal vector at each vertex; should pullback */
{ REAL normal[MAXCOORD];
cross_prod(side[0],side[1],normal);
for ( i = 0 ; i < FACET_VERTS ; i ++ )
{ if ( web.symmetry_flag && wraps[i] )
{ REAL wnorm[MAXCOORD];
(*sym_form_pullback)(get_coord(v_id[i]),wnorm,normal,wraps[i]);
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->normal[j] += wnorm[j];
}
else
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->normal[j] += normal[j];
}
}
}
/************************************************************************
*
* Function: sqcurve_grad_precalc()
*
* Purpose: Does square curvature grad calculation for a facet.
*
*/
void sqcurve_grad_precalc(v_id,e_id,side,wraps)
vertex_id *v_id; /* vertex list of facet */
edge_id *e_id; /* edge list */
REAL (*side)[MAXCOORD]; /* side vectors */
WRAPTYPE *wraps;
{
REAL det;
struct v_curve_t *vc[FACET_VERTS];
int i,j,k;
REAL force[FACET_VERTS][MAXCOORD];
REAL tt[FACET_VERTS][FACET_VERTS]; /* side dot products */
REAL area;
struct e_curve_t *ec[FACET_EDGES];
int fixcount=0;
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( k = 0 ; k <= j ; k++ )
tt[j][k] = tt[k][j] = SDIM_dot(side[j],side[k]);
det = tt[0][0]*tt[1][1] - tt[0][1]*tt[0][1];
area = sqrt(det)/2;
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ vc[i] = v_curve + loc_ordinal(v_id[i]);
vc[i]->area += area;
}
if ( boundary_curvature_flag ) /* apportion area differently */
{ fixcount = 0;
for ( i = 0 ; i < FACET_VERTS ; i++ )
if ( get_vattr(v_id[i]) & (BOUNDARY|FIXED) ) fixcount++;
for ( i = 0 ; i < FACET_VERTS ; i++ )
if ( !(get_vattr(v_id[i]) & (BOUNDARY|FIXED)) )
vc[i]->a += 3*area/(3-fixcount);
}
for ( i = 0 ; i < FACET_EDGES ; i++ )
ec[i] = e_curve + loc_ordinal(e_id[i]);
memset((char*)force,0,sizeof(force));
for ( j = 0 ; j < FACET_VERTS ; j++ )
{ int i1 = (j+1)%FACET_VERTS;
int i2 = (j+2)%FACET_VERTS;
for ( i = 0 ; i < SDIM ; i++ )
force[j][i] = (tt[i1][i1]*side[i2][i] - tt[i1][i2]*side[i1][i])
/4/area;
}
/* first and second derivatives at vertices; should add pullback */
for ( i = 0 ; i < FACET_VERTS ; i++ )
{ int ii = (i+1)%FACET_VERTS; /* opposite side from vertex i */
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->force[j] += force[i][j];
if ( boundary_curvature_flag && (fixcount != 3) )
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->star_force[j] += 3*force[i][j]/(3-fixcount);
for ( j = 0 ; j < SDIM ; j++ )
{ vc[i]->deriv2[j][j] += tt[ii][ii]/4/area;
for ( k = 0 ; k < SDIM ; k++ )
vc[i]->deriv2[j][k] -= (force[i][j]*force[i][k]+0.25*side[ii][j]
*side[ii][k])/area;
}
}
/* now first and second derivatives on edges; should add pullback */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
int i1 = (i+1)%FACET_EDGES;
int i2 = (i+2)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
{ ec[i]->deriv2[j][j] += tt[i1][i2]/4/area;
for ( k = 0 ; k < SDIM ; k++ )
if ( inverted(e_id[i]) )
ec[i]->deriv2[k][j] += (-side[i1][j]*side[i2][k]/2
+ side[i2][j]*side[i1][k]/4
-force[i1][j]*force[i][k])/area;
else
ec[i]->deriv2[j][k] += (-side[i1][j]*side[i2][k]/2
+ side[i2][j]*side[i1][k]/4
-force[i1][j]*force[i][k])/area;
if ( boundary_curvature_flag
&& (get_vattr(v_id[i2]) & (FIXED|BOUNDARY)) )
{ if ( inverted(e_id[i]) )
{ ec[i]->aderiv[0][j] += 0.5*force[i1][j];
ec[i]->aderiv[1][j] += 0.5*force[i][j];
}
else
{ ec[i]->aderiv[0][j] += 0.5*force[i][j];
ec[i]->aderiv[1][j] += 0.5*force[i1][j];
}
}
if ( inverted(e_id[i]) )
{ ec[i]->deriv[0][j] += force[i1][j];
ec[i]->deriv[1][j] += force[i][j];
}
else
{ ec[i]->deriv[0][j] += force[i][j];
ec[i]->deriv[1][j] += force[i1][j];
}
}
if ( self_similar_flag )
{ REAL cp[MAXCOORD];
int ii;
cross_prod(get_coord(get_edge_tailv(e_id[i])),
get_coord(get_edge_headv(e_id[i])), cp);
ii = inverted(e_id[i1]) ? 0 : 1;
for ( j = 0 ; j < SDIM ; j++ ) ec[i1]->volderiv[ii][j] += cp[j];
ii = inverted(e_id[i2]) ? 1 : 0;
for ( j = 0 ; j < SDIM ; j++ ) ec[i2]->volderiv[ii][j] += cp[j];
}
}
/* accumulate normal vector at each vertex */
{ REAL normal[MAXCOORD];
cross_prod(side[0],side[1],normal);
for ( i = 0 ; i < 3 ; i ++ )
for ( j = 0 ; j < SDIM ; j++ )
vc[i]->normal[j] += normal[j];
}
}
/***********************************************************************
*
* Function: sqcurve_method_cleanup()
*
* Purpose: Initializes data structures for square curvature.
*/
void sqcurve_method_cleanup()
{
if ( v_curve ) { temp_free((char*)v_curve); v_curve = NULL; }
if ( e_curve ) { temp_free((char*)e_curve); e_curve = NULL; }
}
/*************************************************************************
*
* function: sqcurve_method_value()
*
* purpose: Calculate squared mean curvature of given vertex
* from precalculated data. Does normal and eff_area versions also.
*
*/
REAL sqcurve_method_value(v_info)
struct qinfo *v_info;
{
vertex_id v_id = v_info->v[0];
REAL h,venergy;
ATTR attr = get_vattr(v_id);
int ordv = loc_ordinal(v_id);
struct v_curve_t *vc;
REAL denom,f;
REAL area; /* curvature normalization area */
/* kludge check here, needed for info_only individual attributes */
if ( sqcurve_init_timestamp < global_timestamp )
sqcurve_method_init(METHOD_VALUE,METH_INSTANCE(v_info->method));
if ( v_curve == NULL )
sqcurve_method_init(METHOD_VALUE,NULL);
vc = v_curve + ordv;
if ((attr & BOUNDARY) &&
!(METH_INSTANCE(v_info->method)->flags & IGNORE_CONSTR))
return 0.0;
if ((attr & FIXED) && !(METH_INSTANCE(v_info->method)->flags & IGNORE_FIXED))
return 0.0;
if ( vc->area == 0.0 ) return 0.0;
if ( METH_INSTANCE(v_info->method)->gen_method != sq_mean_curvature_mi )
{ /* need to check facet orientation consistency */
edge_id eid,starteid;
eid = starteid = get_vertex_edge(v_id);
do
{ facetedge_id fa,fb;
fa = get_edge_fe(eid);
fb = get_next_facet(fa);
if ( (fa != fb) &&
(inverted(get_fe_facet(fa))==inverted(get_fe_facet(fb))) )
{ sprintf(errmsg,
"Inconsistent orientation of \nfacets %s and %s at vertex %s.\n",
ELNAME(get_fe_facet(fa)),ELNAME1(get_fe_facet(fb)),
ELNAME(eid));
strcat(errmsg,"eff_area_sq_mean_curvature and normal_sq_mean_curvature need consistency.\n");
kb_error(2183,errmsg,RECOVERABLE);
}
eid = get_next_tail_edge(eid);
} while ( !equal_element(eid,starteid) );
}
if ( !boundary_curvature_flag )
{ vc->a = vc->area; area = vc->area/3; }
else { area = vc->area/3; }
if ( (attr & CONSTRAINT) &&
!(METH_INSTANCE(v_info->method)->flags & IGNORE_CONSTR) )
{ conmap_t * conmap = get_v_constraint_map(v_id);
int j,oncount = 0;
struct constraint *con[MAXCONPER];
REAL perp[MAXCOORD];
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
if ( conmap[j] & CON_HIT_BIT )
con[oncount++] = get_constraint(conmap[j]);
constr_proj(TANGPROJ,oncount,con,get_coord(v_id),
vc->force,perp,NULL,NO_DETECT,v_id);
for ( j = 0 ; j < SDIM ; j++ )
vc->force[j] -= perp[j];
constr_proj(TANGPROJ,oncount,con,get_coord(v_id),
vc->normal,perp,NULL,NO_DETECT,v_id);
for ( j = 0 ; j < SDIM ; j++ )
vc->normal[j] -= perp[j];
}
if ( METH_INSTANCE(v_info->method)->gen_method ==
normal_sq_mean_curvature_mi )
{ f = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->force,vc->normal);
if ( denom == 0.0 ) h = 0.0;
else h = 3*f/denom; /* mean, and normal was twice area */
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(v_id,h0_attr); break;
}
venergy = h*h;
}
else
if ( METH_INSTANCE(v_info->method)->gen_method==mix_sq_mean_curvature_mi )
{ /* normal_sq_mean part */
f = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->force,vc->normal);
if ( denom == 0.0 ) h = 0.0;
else h = 3*f/denom; /* mean, and normal was twice area */
/* add other part */
vc->h = h = h*sq_mean_mix + SDIM_dot(vc->force,vc->normal)/
SDIM_dot(vc->normal,vc->normal)*3*(1-sq_mean_mix);
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(v_id,h0_attr); break;
}
venergy = h*h;
}
else if ( h0_flag )
{ REAL term=0.0,sim;
vc->h = h = SDIM_dot(vc->force,vc->normal)/
SDIM_dot(vc->normal,vc->normal)*3;
/* since vc->normal = 6*volgrad */
switch ( h0_flag )
{ case H0_IN_GLOBAL: term = h - h0_value; break;
case H0_IN_ATTR: term = h - *VREAL(v_id,h0_attr); break;
}
if ( self_similar_flag )
{ vc->vol = SDIM_dot(get_coord(v_id),vc->normal);
sim = selfsim_coeff*vc->vol;
term -= sim;
}
venergy = term*term;
}
else if ( METH_INSTANCE(v_info->method)->gen_method
== eff_area_sq_mean_curvature_mi )
{ f = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->normal,vc->normal);
if ( denom == 0.0 ) venergy = 0.0;
else
venergy = 9*f/denom; /* 9 = 36/4 */
}
else /* plain squared curvature */
venergy = SDIM_dot(vc->force,vc->force)/area/area/4;
return venergy*vc->a/3;
}
/*************************************************************************
*
* function: sqcurve_method_grad()
*
* purpose: Convert square curvature data into forces for a vertex.
*
*/
REAL sqcurve_method_grad(v_info)
struct qinfo *v_info;
{
vertex_id v_id = v_info->v[0];
edge_id e_id,ee_id,eee_id;
int i,j;
REAL e,e1,e2,denom;
REAL f[MAXCOORD];
REAL fudge1,fudge2,fudge3; /* combinations of values */
REAL fudge11=0.0,fudge12=0.0,fudge13=0.0; /* combinations of values */
REAL fudge21=0.0,fudge22=0.0,fudge23=0.0; /* combinations of values */
REAL h; /* curvature */
REAL area; /* curvature normalization area */
REAL a; /* integral area allocation */
struct v_curve_t *vc = v_curve + loc_ordinal(v_id);
ATTR attr = get_vattr(v_id);
REAL ad[MAXCOORD];
REAL venergy = 0.0;
REAL *grad = v_info->grad[0];
if ( div_normal_curvature_flag )
kb_error(1761,"Force not implemented yet for div_normal_curvature.\n",
RECOVERABLE );
for ( i = 0 ; i < SDIM ; i++ ) grad[i] = 0.0;
if ((attr & BOUNDARY) && !(METH_INSTANCE(v_info->method)->flags & IGNORE_CONSTR))
return 0.0;
if ((attr & FIXED) && !(METH_INSTANCE(v_info->method)->flags & IGNORE_FIXED))
return 0.0;
if ( vc->area == 0.0 ) return 0.0;
if ( !boundary_curvature_flag ) { area = a = vc->a/3; }
else { a = vc->a/3; area = vc->area/3; }
for ( i = 0 ; i < SDIM ;i++ ) /* alloc area deriv */
if ( boundary_curvature_flag )
ad[i] = vc->star_force[i]/3;
else ad[i] = vc->force[i]/3;
/* vertex self-second derivatives */
if ( METH_INSTANCE(v_info->method)->gen_method==normal_sq_mean_curvature_mi )
{ e = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->force,vc->normal);
if ( denom != 0.0 )
{
h = 3*e/denom;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(v_id,h0_attr); break;
}
venergy = h*h;
fudge1 = 4*h/denom*vc->area;
fudge2 = fudge1*e/denom/2;
fudge3 = h*h/3;
for ( i = 0 ; i < SDIM ; i++ )
f[i] = fudge1*SDIM_dot(vc->force,vc->deriv2[i])
- fudge2*SDIM_dot(vc->normal,vc->deriv2[i])
+ fudge3*(boundary_curvature_flag ? vc->star_force[i] :
vc->force[i]);
}
else
for ( i = 0 ; i < SDIM ; i++ ) f[i] =0.0;
}
else
if ( METH_INSTANCE(v_info->method)->gen_method==mix_sq_mean_curvature_mi )
{
/* normal_sq_mean part */
e = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->force,vc->normal);
h = 0.0;
if ( denom != 0.0 )
{
h = 3*e/denom;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(v_id,h0_attr); break;
}
fudge1 = 4/denom;
fudge2 = fudge1*e/denom/2;
fudge3 = h*h/3;
for ( i = 0 ; i < SDIM ; i++ )
f[i] = fudge1*SDIM_dot(vc->force,vc->deriv2[i])
- fudge2*SDIM_dot(vc->normal,vc->deriv2[i]);
}
else
for ( i = 0 ; i < SDIM ; i++ ) f[i] =0.0;
/* add other part */
{
REAL net;
REAL fd[MAXCOORD];
REAL aread[MAXCOORD];
for ( i = 0 ; i < SDIM ;i++ )
fd[i] = SDIM_dot(vc->normal,vc->deriv2[i])/vc->norm*3;
for ( i = 0 ; i < SDIM ;i++ )
{ aread[i] = vc->force[i]/3;
if ( boundary_curvature_flag ) ad[i] = vc->star_force[i]/3;
else ad[i] = aread[i];
}
h = (h*sq_mean_mix+(1-sq_mean_mix)*vc->term); /* make combination */
for ( i = 0 ; i < SDIM ; i++ )
{ net = 2*h*(f[i]*sq_mean_mix+(1-sq_mean_mix)*fd[i])*a + h*h*ad[i];
grad[i] += net;
}
}
venergy = h*h;
}
else if ( METH_INSTANCE(v_info->method)->gen_method == eff_area_sq_mean_curvature_mi )
{ e = SDIM_dot(vc->force,vc->force);
denom = SDIM_dot(vc->normal,vc->normal);
if ( denom != 0.0 )
{ for ( i = 0 ; i < SDIM ; i++ )
f[i] = 18*SDIM_dot(vc->force,vc->deriv2[i])/denom*a
+ 9*e/denom*ad[i];
venergy = 9*e/denom; /* 9 = 36/4 */
}
else
for ( i = 0 ; i < SDIM ; i++ ) f[i] =0.0;
}
else /* squared curvature */
{ e = SDIM_dot(vc->force,vc->force)/vc->area*3.0/4;
for ( i = 0 ; i < SDIM ; i++ )
{ f[i] = (2*SDIM_dot(vc->force,vc->deriv2[i])
- 4/3.0*e*vc->force[i])/vc->area*3.0/4;
f[i] += vc->fpgradf[i]/vc->area*3.0/4;
}
venergy = e*3/vc->area/4;
}
if ( h0_flag &&
!(METH_INSTANCE(v_info->method)->gen_method==normal_sq_mean_curvature_mi) )
{
REAL net,sim;
REAL fd[MAXCOORD],simd[MAXCOORD];
REAL aread[MAXCOORD];
for ( i = 0 ; i < SDIM ;i++ )
fd[i] = SDIM_dot(vc->normal,vc->deriv2[i])/vc->norm*3;
for ( i = 0 ; i < SDIM ;i++ )
{ aread[i] = vc->force[i]/3;
if ( boundary_curvature_flag ) ad[i] = vc->star_force[i]/3;
else ad[i] = aread[i];
}
if ( self_similar_flag )
{ vc->vol = SDIM_dot(get_coord(v_id),vc->normal);
sim = selfsim_coeff*vc->vol/area;
vc->term -= sim/area;
for ( i = 0 ; i < SDIM ;i++ )
{ simd[i] = selfsim_coeff*vc->normal[i];
grad[i] += 2*vc->term* (- simd[i])*a;
}
}
for ( i = 0 ; i < SDIM ; i++ )
{ net = 2*vc->term*fd[i]*a + vc->term*vc->term*ad[i];
grad[i] += net;
}
}
else
for ( i = 0 ; i < SDIM ; i++ )
grad[i] += f[i];
ee_id = get_vertex_edge(v_id);
eee_id = ee_id;
if ( valid_id(eee_id) ) do
{
vertex_id headv;
vertex_id tailv;
struct e_curve_t *ec;
struct v_curve_t *vc1;
struct v_curve_t *vc2;
REAL s[MAXCOORD],cross1[MAXCOORD],cross2[MAXCOORD];
REAL denom1=0.0,denom2=0.0;
REAL s0[MAXCOORD];
REAL wa[MAXCOORD],wb[MAXCOORD],w[MAXCOORD],aw[MAXCOORD],vw[MAXCOORD];
facetedge_id fe;
facet_id f_id;
if ( inverted(eee_id) ) e_id = inverse_id(eee_id);
else e_id = eee_id;
headv = get_edge_headv(e_id);
tailv = get_edge_tailv(e_id);
ec = e_curve + loc_ordinal(e_id);
vc1 = v_curve + loc_ordinal(tailv);
vc2 = v_curve + loc_ordinal(headv);
if ( (vc1->area == 0.0) || (vc2->area == 0.0) ) continue;
if ( METH_INSTANCE(v_info->method)->gen_method == normal_sq_mean_curvature_mi )
{ facetedge_id fe_a;
facetedge_id fe_b;
REAL sa[MAXCOORD],sb[MAXCOORD];
fe = get_edge_fe(e_id);
fe_a = get_prev_edge(fe);
fe_b = get_prev_edge(get_next_facet(fe));
get_edge_side(e_id,s0);
get_edge_side(get_fe_edge(fe_a),sa);
cross_prod(vc1->force,sa,cross1);
if ( (assume_oriented_flag && inverted(get_fe_facet(fe_a)))
|| (!assume_oriented_flag && triple_prod(vc1->normal,sa,s0) < 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross1[i] = -cross1[i];
if ( fe_b != fe_a ) /* check for single edge on constraint */
{ get_edge_side(get_fe_edge(fe_b),sb);
cross_prod(vc1->force,sb,s);
if ( (assume_oriented_flag && inverted(get_fe_facet(fe_b)))
|| (!assume_oriented_flag && triple_prod(vc1->normal,sb,s0) < 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross1[i] -= s[i];
else for ( i = 0 ; i < SDIM ; i++ ) cross1[i] += s[i];
}
e1 = SDIM_dot(vc1->force,vc1->force);
denom1 = SDIM_dot(vc1->force,vc1->normal);
if ( denom1 != 0.0 )
{ h = 3*e1/denom1;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(headv,h0_attr); break;
}
fudge11 = 4*h/denom1*vc1->area;
fudge12 = fudge11*e1/denom1/2;
fudge13 = h*h/3;
}
else fudge11 = fudge12 = fudge13 = 0.0;
e2 = SDIM_dot(vc2->force,vc2->force);
denom2 = SDIM_dot(vc2->force,vc2->normal);
if ( denom2 != 0.0 )
{ h = 3*e2/denom2;
switch ( h0_flag )
{ case H0_IN_GLOBAL: h -= h0_value; break;
case H0_IN_ATTR: h -= *VREAL(tailv,h0_attr); break;
}
fudge21 = 4*h/denom2*vc2->area;
fudge22 = fudge21*e2/denom2/2;
fudge23 = h*h/3;
}
else fudge21 = fudge22 = fudge23 = 0.0;
cross_prod(vc2->force,sa,cross2);
if ( (assume_oriented_flag && !inverted(get_fe_facet(fe_a)))
|| (!assume_oriented_flag && triple_prod(vc2->normal,sa,s0) > 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross2[i] = -cross2[i];
if ( fe_b != fe_a ) /* check for single edge on constraint */
{ cross_prod(vc2->force,sb,s);
if ( (assume_oriented_flag && !inverted(get_fe_facet(fe_b)))
|| (!assume_oriented_flag && triple_prod(vc2->normal,sb,s0) > 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross2[i] -= s[i];
else for ( i = 0 ; i < SDIM ; i++ ) cross2[i] += s[i];
}
}
else if ( METH_INSTANCE(v_info->method)->gen_method
== eff_area_sq_mean_curvature_mi )
{
facetedge_id fe_a;
facetedge_id fe_b;
REAL sa[MAXCOORD],sb[MAXCOORD];
fe = get_edge_fe(e_id);
fe_a = get_prev_edge(fe);
fe_b = get_prev_edge(get_next_facet(fe));
get_edge_side(e_id,s0);
get_edge_side(get_fe_edge(fe_a),sa);
cross_prod(vc1->normal,sa,cross1);
if ( (assume_oriented_flag && inverted(get_fe_facet(fe_a)))
|| (!assume_oriented_flag && SDIM_dot(cross1,s0) < 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross1[i] = -cross1[i];
if ( fe_b != fe_a ) /* check for single edge on constraint */
{ get_edge_side(get_fe_edge(fe_b),sb);
cross_prod(vc1->normal,sb,s);
if ( (assume_oriented_flag && inverted(get_fe_facet(fe_b)))
|| (!assume_oriented_flag && SDIM_dot(s,s0) < 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross1[i] -= s[i];
else for ( i = 0 ; i < SDIM ; i++ ) cross1[i] += s[i];
}
e1 = SDIM_dot(vc1->force,vc1->force);
denom1 = SDIM_dot(vc1->normal,vc1->normal);
e2 = SDIM_dot(vc2->force,vc2->force);
denom2 = SDIM_dot(vc2->normal,vc2->normal);
cross_prod(vc2->normal,sa,cross2);
if ( (assume_oriented_flag && !inverted(get_fe_facet(fe_a)))
|| (!assume_oriented_flag && SDIM_dot(cross2,s0) > 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross2[i] = -cross2[i];
if ( fe_b != fe_a ) /* check for single edge on constraint */
{ cross_prod(vc2->normal,sb,s);
if ( (assume_oriented_flag && !inverted(get_fe_facet(fe_b)))
|| (!assume_oriented_flag && SDIM_dot(s,s0) > 0.0 ) )
for ( i = 0 ; i < SDIM ; i++ ) cross2[i] -= s[i];
else for ( i = 0 ; i < SDIM ; i++ ) cross2[i] += s[i];
}
}
else /* squared curvature */
{ e1 = SDIM_dot(vc1->force,vc1->force)/vc1->area*3.0/4;
e2 = SDIM_dot(vc2->force,vc2->force)/vc2->area*3.0/4;
}
if ( inverted(eee_id) )
{ int tattr = get_vattr(tailv);
if ( (!(tattr & FIXED) ||
(METH_INSTANCE(v_info->method)->flags & IGNORE_FIXED))
&& (!(tattr & BOUNDARY) ||
(METH_INSTANCE(v_info->method)->flags & IGNORE_CONSTR))
)
{ /* force on head due to curvature at tail */
if ( METH_INSTANCE(v_info->method)->gen_method
== normal_sq_mean_curvature_mi )
for ( i = 0 ; i < SDIM ; i++ )
{ f[i] = fudge11*SDIM_dot(vc1->force,ec->deriv2[i])
- fudge12*(cross1[i]+SDIM_dot(vc1->normal,ec->deriv2[i]))
+ fudge13*ec->deriv[1][i] ;
}
else if (METH_INSTANCE(v_info->method)->gen_method
==eff_area_sq_mean_curvature_mi )
for ( i = 0 ; i < SDIM ; i++ )
{ if ( denom1 != 0.0 )
f[i] = 6*SDIM_dot(vc1->force,ec->deriv2[i])/denom1*vc1->area
+ 3*e1/denom1*ec->deriv[1][i]
- 6*e1/denom1/denom1*cross1[i]*vc1->area;
else f[i] = 0.0;
}
else /* squared curvature */
for ( i = 0 ; i < SDIM ; i++ )
f[i] = (- 4/3.0*e1*ec->deriv[1][i]
+ 2*SDIM_dot(vc1->force,ec->deriv2[i]))/vc1->area*3.0/4;
if ( h0_flag && !(METH_INSTANCE(v_info->method)->gen_method
== normal_sq_mean_curvature_mi) )
{ REAL fd[MAXCOORD],net;
fe = get_edge_fe(e_id);
get_edge_side(get_fe_edge(get_next_edge(fe)),wa);
get_edge_side(get_fe_edge(get_next_edge(get_next_facet(fe))),wb);
f_id = get_fe_facet(fe);
if ( inverted(f_id) )
for ( i = 0 ; i < SDIM ; i++ ) w[i] = wb[i] - wa[i];
else for ( i = 0 ; i < SDIM ; i++ ) w[i] = wa[i] - wb[i];
cross_prod(w,vc1->force,aw);
cross_prod(w,vc1->normal,vw);
for ( i = 0 ; i < SDIM ; i++ )
{ fd[i] = (SDIM_dot(vc1->normal,ec->deriv2[i])/vc1->norm
+ aw[i]/vc1->norm - vc1->f*2*vw[i]/vc1->norm/vc1->norm)*3;
ad[i] = ec->deriv[1][i]/3;
}
area = vc1->area/3;
a = vc1->a/3;
for ( i = 0 ; i < SDIM ; i++ )
{
net = 2*vc1->term*fd[i]*a
+ vc1->term*vc1->term*(ad[i]+ec->aderiv[1][i]/3);
if ( self_similar_flag )
net += 2*vc1->term*(-selfsim_coeff*ec->volderiv[1][i])*a;
grad[i] += net;
}
}
else
for ( i = 0 ; i < SDIM ; i++ )
grad[i] += f[i];
}
}
else /* not inverted */
if ( (!(get_vattr(headv) & FIXED) ||
(METH_INSTANCE(v_info->method)->flags & IGNORE_FIXED))
&& (!(get_vattr(headv) & BOUNDARY) ||
(METH_INSTANCE(v_info->method)->flags & IGNORE_CONSTR))
)
{ /* force on tail due to curvature at head */
if ( METH_INSTANCE(v_info->method)->gen_method == normal_sq_mean_curvature_mi )
for ( i = 0 ; i < SDIM ; i++ )
{ f[i] = fudge23*ec->deriv[0][i] - fudge22*cross2[i];
for ( j = 0 ; j < SDIM ; j++ )
f[i] += fudge21*vc2->force[j]*ec->deriv2[j][i]
- fudge22*vc2->normal[j]*ec->deriv2[j][i];
}
else if ( METH_INSTANCE(v_info->method)->gen_method == eff_area_sq_mean_curvature_mi )
for ( i = 0 ; i < SDIM ; i++ )
{ if ( denom2 != 0.0 )
{ f[i] = 3*e2/denom2*ec->deriv[0][i]
- 6*e2/denom2/denom2*cross2[i]*vc2->area;
for ( j = 0 ; j < SDIM ; j++ )
f[i] += 6*vc2->force[j]*ec->deriv2[j][i]/denom2*vc2->area;
}
else f[i] = 0.0;
}
else /* squared curvature */
for ( i = 0 ; i < SDIM ; i++ )
{ f[i] = -4/3.0*e2*ec->deriv[0][i]/vc2->area*3.0/4;
for ( j = 0 ; j < SDIM ; j++ )
f[i] += 2*vc2->force[j]*ec->deriv2[j][i]/vc2->area*3.0/4;
}
if ( h0_flag &&
!(METH_INSTANCE(v_info->method)->gen_method == normal_sq_mean_curvature_mi) )
{ REAL fd[MAXCOORD],net;
fe = get_edge_fe(e_id);
get_edge_side(get_fe_edge(get_next_edge(fe)),wa);
get_edge_side(get_fe_edge(get_next_edge(get_next_facet(fe))),wb);
f_id = get_fe_facet(fe);
if ( inverted(f_id) )
for ( i = 0 ; i < SDIM ; i++ ) w[i] = wb[i] - wa[i];
else for ( i = 0 ; i < SDIM ; i++ ) w[i] = wa[i] - wb[i];
cross_prod(vc2->force,w,aw);
cross_prod(vc2->normal,w,vw);
for ( i = 0 ; i < SDIM ; i++ )
{ for ( j = 0, fd[i] = 0.0 ; j < SDIM ; j++ )
fd[i] += vc2->normal[j]*ec->deriv2[j][i];
fd[i] = (fd[i]/vc2->norm
+ aw[i]/vc2->norm - vc2->f*2*vw[i]/vc2->norm/vc2->norm)*3;
ad[i] = ec->deriv[0][i]/3;
}
area = vc2->area/3;
a = vc2->a/3;
for ( i = 0 ; i < SDIM ; i++ )
{
net = 2*vc2->term*fd[i]*a
+ vc2->term*vc2->term*(ad[i]+ec->aderiv[0][i]/3);
if ( self_similar_flag )
net += 2*vc2->term*(-selfsim_coeff*ec->volderiv[0][i])*a;
grad[i] += net;
}
}
else
for ( i = 0 ; i < SDIM ; i++ )
grad[i] += f[i];
}
eee_id = get_next_tail_edge(eee_id);
} while ( !equal_id(eee_id,ee_id) );
return venergy*vc->a/3;
} /* end sqcurve_method_grad */
/*************************************************************************
square mean curvature for string
With optional power in variable curvature_power
**************************************************************************/
/************************************************************************
*
* function: sqcurve_string_init()
*
* purpose:
*/
void sqcurve_string_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2864,"Method sqcurve_string only for LINEAR model.\n",
RECOVERABLE);
sqcurve_energy_string_init(); /* sets up curve_power */
}
void sqcurve_string_marked_init(mode,mi)
int mode;
struct method_instance *mi;
{ int eltype;
if ( web.modeltype != LINEAR )
kb_error(2865,"Method sqcurve_string only for LINEAR model.\n",
RECOVERABLE);
marked_edge_attr = find_extra(MARKED_EDGE_ATTR_NAME,&eltype);
if ( eltype != EDGE )
kb_error(2184,"sqcurve_string_mark should be an edge attribute.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: sqcurve_string_value()
*
* purpose: Calculate square curvature energy for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sqcurve_string_value(v_info)
struct qinfo *v_info;
{
REAL s1,s2,s1s2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
REAL energy;
REAL hh,a1,a2;
REAL power;
if ( v_info->vcount < 3 ) return 0.;
if ( METH_INSTANCE(v_info->method)->flags & METH_PARAMETER_1 )
power = METH_INSTANCE(v_info->method)->parameter_1;
else power = curve_power;
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1s2 = SDIM_dot(side1,side2);
a1 = 1 + s1s2/s1/s2;
a2 = (s1 + s2)/2;
if ( (a1 <= 0.0) || (a2 == 0.0) ) return 0.0;
hh = (2*a1+12*a1*a1/36)/a2/a2;
energy = a2*pow(hh,power/2);
return energy;
}
/************************************************************************
*
* function: sqcurve_string_grad()
*
* purpose: Calculate square curvature force for string model
* Works locally vertex by vertex.
*
*/
REAL sqcurve_string_grad(v_info)
struct qinfo *v_info;
{
REAL s1,s2,s1s2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
int i,k;
REAL hh,a1,a2,energy;
REAL a1g[2][MAXCOORD],a2g[2][MAXCOORD];
REAL s[2];
REAL *side[2];
REAL term; /* common factor */
REAL power;
if ( v_info->vcount < 3 ) return 0.0;
if ( METH_INSTANCE(v_info->method)->flags & METH_PARAMETER_1 )
power = METH_INSTANCE(v_info->method)->parameter_1;
else power = curve_power;
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1s2 = SDIM_dot(side1,side2);
a1 = 2 + 2*s1s2/s1/s2;
a2 = (s1 + s2)/2;
if (a2 == 0.0) return 0.0;
hh = (a1+3*a1*a1/36)/a2/a2;
if ( hh <= 0.0 )
{ hh = 0.0;
energy = 0.0;
}
else
energy = a2*pow(hh,power/2);
side[0] = side1; side[1] = side2; s[0] = s1; s[1] = s2;
for ( k = 0 ; k < 2 ; k++ )
{ REAL coeff = 2*s1s2/s[k]/s[k]/s[k]/s[1-k];
for ( i = 0 ; i < SDIM ; i++ )
{ a1g[k][i] = 2*side[1-k][i]/s1/s2 - coeff*side[k][i];
a2g[k][i] = 0.5*side[k][i]/s[k];
}
}
for ( i = 0 ; i < SDIM ; i++ ) v_info->grad[0][i] = 0.0;
term = a2*pow(hh,power/2-1);
for ( k = 0 ; k < 2 ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ REAL f;
f = a2g[k][i]*energy/a2 + term*power/2
*(a1g[k][i]*(1+6*a1/36)/a2/a2 - (2*a1+6*a1*a1/36)/a2/a2/a2*a2g[k][i]);
v_info->grad[k+1][i] = f;
v_info->grad[0][i] += -f;
}
return energy;
}
/************************************************************************
*
* function: sqcurve_string_hess()
*
* purpose: Calculate square curvature hessian for string model
* Works locally vertex by vertex.
*
*/
REAL sqcurve_string_hess(v_info)
struct qinfo *v_info;
{
REAL s1,s2,s1s2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
REAL *side[2];
int i,k,kk,ii;
REAL a1,a2,energy;
REAL a1g[2][MAXCOORD],a2g[2][MAXCOORD];
REAL a1h[2][2][MAXCOORD][MAXCOORD],a2h[2][2][MAXCOORD][MAXCOORD];
REAL s[2];
REAL ****h = v_info->hess;
REAL term; /* common factor */
REAL power;
if ( v_info->vcount < 3 ) return 0.0;
if ( METH_INSTANCE(v_info->method)->flags & METH_PARAMETER_1 )
power = METH_INSTANCE(v_info->method)->parameter_1;
else power = curve_power;
if ( power != 2 )
kb_error(1762,"Hessian not implemented for curvature_power != 2.\n",
RECOVERABLE);
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1s2 = SDIM_dot(side1,side2);
a1 = 1 + s1s2/s1/s2;
a2 = (s1 + s2)/2;
if ( a2 == 0.0 ) return 0.0;
energy = 2*(a1+6*a1*a1/36)/a2;
side[0] = side1; side[1] = side2; s[0] = s1; s[1] = s2;
for ( k = 0 ; k < 2 ; k++ )
{ term = s1s2/s[k]/s[k]/s[k]/s[1-k];
for ( i = 0 ; i < SDIM ; i++ )
{ a1g[k][i] = side[1-k][i]/s1/s2 - term*side[k][i];
a2g[k][i] = 0.5*side[k][i]/s[k];
}
}
for ( i = 0 ; i < SDIM ; i++ ) v_info->grad[0][i] = 0.0;
term = (a1+6*a1*a1/36)/a2/a2;
for ( k = 0 ; k < 2 ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ REAL f = 2*(a1g[k][i]*(1+12*a1/36)/a2 - term*a2g[k][i]);
v_info->grad[k+1][i] = f;
v_info->grad[0][i] += -f;
}
/* hessian */
memset((char*)a1h,0,sizeof(a1h));
memset((char*)a2h,0,sizeof(a2h));
for ( k = 0 ; k < 2 ; k++ )
{ REAL terma = 3*s1s2/s[k]/s[k]/s[k]/s[k]/s[k]/s[1-k];
REAL termb = s1s2/s[k]/s[k]/s[k]/s[1-k]/s[1-k]/s[1-k];
REAL termc = 1/s[k]/s[1-k]/s[1-k]/s[1-k];
term = 1/s[k]/s[k]/s[k]/s[1-k];
for ( i = 0 ; i < SDIM ; i++ )
{ a1h[k][1-k][i][i] += 1/s1/s2;
for ( ii = 0 ; ii < SDIM ; ii++ )
{ a1h[k][k][i][ii] += -side[1-k][i]*term*side[k][ii];
a1h[k][1-k][i][ii] +=
-side[1-k][i]*termc*side[1-k][ii];
}
for ( ii = 0 ; ii < SDIM ; ii++ )
{ a1h[k][k][i][ii] += -side[1-k][ii]*term*side[k][i];
a1h[k][1-k][i][ii] += -side[k][ii]*term*side[k][i];
a1h[k][k][i][ii] += terma*side[k][i]*side[k][ii];
a1h[k][1-k][i][ii] += termb*side[k][i]*side[1-k][ii];
}
a1h[k][k][i][i] += - s1s2*term;
a2h[k][k][i][i] += 0.5/s[k];
for ( ii = 0 ; ii < SDIM ; ii++ )
a2h[k][k][i][ii] += -0.5*side[k][i]/s[k]/s[k]/s[k]*side[k][ii];
}
}
for ( k = 0 ; k < 2 ; k++ )
for ( kk = 0 ; kk < 2 ; kk++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( ii = 0 ; ii < SDIM ; ii++ )
{ REAL f = 2*((a1h[k][kk][i][ii]*(1+12*a1/36)+12*a1g[k][i]*a1g[kk][ii]/36)/a2
- a1g[k][i]*(1+12*a1/36)*a2g[kk][ii]/a2/a2
- a1g[kk][ii]*(1+12*a1/36)*a2g[k][i]/a2/a2
- (a1+6*a1*a1/36)*a2h[k][kk][i][ii]/a2/a2
+ 2*(a1+6*a1*a1/36)*a2g[k][i]*a2g[kk][ii]/a2/a2/a2);
h[k+1][kk+1][i][ii] += f;
h[k+1][0][i][ii] += -f;
h[0][kk+1][i][ii] += -f;
h[0][0][i][ii] += f;
}
return energy;
}
/*************************************************************************
Square curvature for string with intrinsic curvature
Plane only; intrinsic curvature in vertex attribute
"h_zero" or variable h_zero. Edges assumed to all be oriented
in the same direction.
**************************************************************************/
/************************************************************************
*
* function: sqcurve2_string_init()
*
* purpose:
*/
void sqcurve2_string_init(mode,mi)
int mode;
struct method_instance *mi;
{ int eltype;
int k;
if ( web.modeltype != LINEAR )
kb_error(3211,"Method sqcurve_string only for LINEAR model.\n",
RECOVERABLE);
/* see if using (H - H_0)^2 adjustment */
h0_flag = 0;
h0_attr = find_extra("h_zero",&eltype);
if ( h0_attr >= 0 )
h0_flag = H0_IN_ATTR;
else
{ k = lookup_global("h_zero");
if ( k >= 0 )
{ h0_flag = H0_IN_GLOBAL;
h0_value = globals(k)->value.real;
}
}
}
/************************************************************************
*
* function: sqcurve2_string_value()
*
* purpose: Calculate square curvature energy for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sqcurve2_string_value(v_info)
struct qinfo *v_info;
{
REAL s1,s2,s1xs2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
REAL energy;
REAL h,h0,hh,a1,a2;
if ( v_info->vcount < 3 ) return 0.;
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1xs2 = side1[0]*side2[1] - side1[1]*side2[0];
a1 = s1xs2/s1/s2; /* sin(theta) */
a2 = (s1 + s2)/2;
if ( a2 == 0.0 ) return 0.0;
h = a1/a2; /* curvature */
if ( h0_flag == H0_IN_ATTR )
h0 = *VREAL(v_info->id,h0_attr);
else
h0 = h0_value;
hh = (h - h0)*(h - h0); /* square net curvature */
energy = a2*hh;
return energy;
}
/************************************************************************
*
* function: sqcurve2_string_grad()
*
* purpose: Calculate square curvature force for string model
* Works locally vertex by vertex.
*
*/
REAL sqcurve2_string_grad(v_info)
struct qinfo *v_info;
{
REAL s1,s2,s1xs2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
int i,k;
REAL hh,h,h0,a1,a2,energy;
REAL a1g[2][MAXCOORD],a2g[2][MAXCOORD];
REAL s[2];
REAL *side[2];
if ( v_info->vcount < 3 ) return 0.;
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1xs2 = side1[0]*side2[1] - side1[1]*side2[0];
a1 = s1xs2/s1/s2; /* sin(theta) */
a2 = (s1 + s2)/2;
if ( a2 == 0.0 ) return 0.0;
h = a1/a2; /* curvature */
if ( h0_flag == H0_IN_ATTR )
h0 = *VREAL(v_info->id,h0_attr);
else
h0 = h0_value;
hh = (h - h0)*(h - h0); /* square net curvature */
energy = a2*hh;
side[0] = side1; side[1] = side2; s[0] = s1; s[1] = s2;
for ( k = 0 ; k < 2 ; k++ )
{ REAL coeff = s1xs2/s[k]/s[k]/s[k]/s[1-k];
for ( i = 0 ; i < SDIM ; i++ )
{ a1g[k][i] = (k==i?1:-1)*side[1-k][1-i]/s1/s2 - coeff*side[k][i];
a2g[k][i] = 0.5*side[k][i]/s[k];
}
}
for ( i = 0 ; i < SDIM ; i++ ) v_info->grad[0][i] = 0.0;
for ( k = 0 ; k < 2 ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
{ REAL f;
f = a2g[k][i]*hh + a2*2*(h - h0)*(a1g[k][i]/a2 - a1/a2/a2*a2g[k][i]);
v_info->grad[k+1][i] = f;
v_info->grad[0][i] += -f;
}
return energy;
}
/*************************************************************************
square mean curvature for string, version 3
Uses (1/L1 + 1/L2)/2 instead of 1/(L1+L2) for inverse
length to encourage equal size edges.
**************************************************************************/
/************************************************************************
*
* function: sqcurve3_string_init()
*
* purpose:
*/
void sqcurve3_string_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(4864,"Method sqcurve3_string only for LINEAR model.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: sqcurve3_string_all()
*
* purpose: Calculate square curvature energy etc. for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sqcurve3_string_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, METHOD_HESSIAN */
{
REAL s1,s2,s1s2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
REAL energy;
REAL a1,a2;
REAL da1[3][MAXCOORD],da2[3][MAXCOORD];
REAL dda1[3][3][MAXCOORD][MAXCOORD],dda2[3][3][MAXCOORD][MAXCOORD];
int i,j,k,kk;
if ( v_info->vcount != 3 ) return 0.;
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s1s2 = SDIM_dot(side1,side2);
if ( (s1 == 0.0) || (s2 == 0.0) ) return 0.0;
a1 = 1 + s1s2/s1/s2; /* 1 - cos(theta)^2 */
a2 = (1/s1 + 1/s2)/2; /* inverse length approximation */
energy = (2*a1+a1*a1/3)*a2;
if ( mode == METHOD_VALUE )
return energy;
/* Gradient */
for ( i = 0 ; i < SDIM ; i++ )
{ da1[1][i] = side2[i]/s1/s2 - s1s2/s1/s1/s1/s2*side1[i];
da1[2][i] = side1[i]/s1/s2 - s1s2/s1/s2/s2/s2*side2[i];
da1[0][i] = -da1[1][i] - da1[2][i];
da2[1][i] = -1./2/s1/s1/s1*side1[i];
da2[2][i] = -1./2/s2/s2/s2*side2[i];
da2[0][i] = -da2[1][i] - da2[2][i];
}
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
v_info->grad[k][i] = (2 + 2*a1/3)*da1[k][i]*a2 + (2*a1+a1*a1/3)*da2[k][i];
if ( mode == METHOD_GRADIENT )
return energy;
/* Hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
for ( j = 0 ; j < SDIM ; j++ )
{
dda1[1][1][i][j] = -side2[i]/s1/s1/s1/s2*side1[j]
- side2[j]/s1/s1/s1/s2*side1[i]
+ 3*s1s2/s1/s1/s1/s1/s1/s2*side1[i]*side1[j]
+ (j==i ? -s1s2/s1/s1/s1/s2 : 0.0);
dda1[1][2][i][j] = -side2[i]/s1/s2/s2/s2*side2[j]
- side1[j]/s1/s1/s1/s2*side1[i]
+ s1s2/s1/s1/s1/s2/s2/s2*side1[i]*side2[j]
+ (j==i ? 1/s1/s2 : 0.0);
dda1[2][1][i][j] = -side1[i]/s1/s1/s1/s2*side1[j]
- side2[j]/s1/s2/s2/s2*side2[i]
+ s1s2/s1/s1/s1/s2/s2/s2*side2[i]*side1[j]
+ (j==i ? 1/s1/s2 : 0.0);
dda1[2][2][i][j] = -side1[i]/s1/s2/s2/s2*side2[j]
- side1[j]/s1/s2/s2/s2*side2[i]
+ 3*s1s2/s1/s2/s2/s2/s2/s2*side2[i]*side2[j]
+ (j==i ? -s1s2/s1/s2/s2/s2 : 0.0);
dda1[0][1][i][j] = -dda1[1][1][i][j] - dda1[2][1][i][j];
dda1[0][2][i][j] = -dda1[1][2][i][j] - dda1[2][2][i][j];
dda1[0][0][i][j] = -dda1[0][1][i][j] - dda1[0][2][i][j];
dda2[1][1][i][j] = 3./2/s1/s1/s1/s1/s1*side1[j]*side1[i]
+ (j==i ? -1./2/s1/s1/s1 : 0.0 );
dda2[1][2][i][j] = 0.0;
dda2[2][1][i][j] = 0.0;
dda2[2][2][i][j] = 3./2/s2/s2/s2/s2/s2*side2[j]*side2[i]
+ (j==i ? -1./2/s2/s2/s2 : 0.0 );
dda2[0][1][i][j] = -dda2[1][1][i][j] - dda2[2][1][i][j];
dda2[0][2][i][j] = -dda2[1][2][i][j] - dda2[2][2][i][j];
dda2[0][0][i][j] = -dda2[0][1][i][j] - dda2[0][2][i][j];
}
}
for ( k = 0 ; k < v_info->vcount ; k++ )
for ( kk = 0 ; kk < v_info->vcount ; kk++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
v_info->hess[k][kk][i][j] = (2*da1[kk][j]/3)*da1[k][i]*a2
+ (2 + 2*a1/3)*dda1[k][kk][i][j]*a2
+ (2 + 2*a1/3)*da1[k][i]*da2[kk][j]
+ (2 + 2*a1/3)*da1[kk][j]*da2[k][i]
+ (2*a1+a1*a1/3)*dda2[k][kk][i][j];
return energy;
}
REAL sqcurve3_string_value(v_info)
struct qinfo *v_info;
{ return sqcurve3_string_all(v_info,METHOD_VALUE);
}
REAL sqcurve3_string_grad(v_info)
struct qinfo *v_info;
{ return sqcurve3_string_all(v_info,METHOD_GRADIENT);
}
REAL sqcurve3_string_hess(v_info)
struct qinfo *v_info;
{ return sqcurve3_string_all(v_info,METHOD_HESSIAN);
}
/* end sqcurve3_string method */
/*************************************************************************
Square mean curvature for cylinder in string model
Cylindrical axis is x axis.
Includes 2*pi factor.
Includes the 1/2 factor in the definition of mean curvature.
Functions can actually do any power of (h-h0),
so could set up other methods easily.
**************************************************************************/
REAL sq_mean_curv_cyl_all ARGS(( struct qinfo *, int, REAL ));
/************************************************************************
*
* function: sq_mean_curv_cyl_init()
*
* purpose:
*/
void sq_mean_curv_cyl_init(mode,mi)
int mode;
struct method_instance *mi;
{ int k;
int eltype;
if ( web.modeltype != LINEAR )
kb_error(2486,"sq_mean_curv_cyl method only for LINEAR model.\n",
RECOVERABLE);
/* see if using (H - H_0)^2 adjustment */
h0_flag = 0;
h0_attr = find_extra("h_zero",&eltype);
if ( h0_attr >= 0 )
h0_flag = H0_IN_ATTR;
else
{ k = lookup_global("h_zero");
if ( k >= 0 )
{ h0_flag = H0_IN_GLOBAL;
h0_value = globals(k)->value.real;
}
}
}
REAL sq_mean_curv_cyl_all(v_info,mode,power)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, METHOD_HESSIAN */
REAL power;
{
REAL s1,s2; /* edge lengths */
REAL *side1 = v_info->sides[0][0],*side2 = v_info->sides[0][1];
REAL energy;
REAL area; /* of entire pair of frustrums */
REAL h,hh;
REAL r0,r1,r2; /* radii; r1 is middle radius, at varying vertex */
REAL dadx[3],dadr[3]; /* index refers to v_info order */
REAL ddadxdx[3][3],ddadxdr[3][3],ddadrdr[3][3],ddadrdx[3][3],dhdx[3],dhdr[3];
REAL ddhdxdx[3][3],ddhdxdr[3][3],ddhdrdr[3][3],ddhdrdx[3][3];
REAL dddadxdxdx[3][3][3];
REAL dddadxdxdr[3][3][3];
REAL dddadxdrdx[3][3][3];
REAL dddadxdrdr[3][3][3];
REAL dddadrdxdx[3][3][3];
REAL dddadrdxdr[3][3][3];
REAL dddadrdrdx[3][3][3];
REAL dddadrdrdr[3][3][3];
REAL root;
int i,j;
int sign; /* of curvature */
if ( (v_info->vcount == 2) &&
(fabs(v_info->x[0][1]) < 1e-10) )
{ /* assume this is an endpoint on the axis, so we do special
concentrated squared curvature */
edge_id e_id = get_vertex_edge(v_info->id);
int sign = inverted(e_id) ? 1 : -1; /* in case of h0 */
REAL ss = SDIM_dot(side1,side1);
REAL dx = v_info->x[1][0] - v_info->x[0][0];
REAL prod; /* full power */
REAL hterm; /* h - h0 */
REAL gradprod=0.0; /* one less power, for grad */
REAL hessprod=0.0; /* two less power, for hess */
int k;
REAL dx_dx0=-1,dx_dx1=1,dx_dy0=0,dx_dy1=0;
REAL dss_dx0,dss_dx1,dss_dy0,dss_dy1;
REAL dhterm_dx0,dhterm_dx1,dhterm_dy0,dhterm_dy1;
REAL dprod_dx0,dprod_dy0,dprod_dx1,dprod_dy1;
REAL dss_dx0_dx0,dss_dx0_dx1,dss_dx0_dy0=0,dss_dx0_dy1=0;
REAL dss_dx1_dx0,dss_dx1_dx1,dss_dx1_dy0=0,dss_dx1_dy1=0;
REAL dss_dy0_dx0=0,dss_dy0_dx1=0,dss_dy0_dy0,dss_dy0_dy1;
REAL dss_dy1_dx0=0,dss_dy1_dx1=0,dss_dy1_dy0,dss_dy1_dy1;
REAL dhterm_dx0_dx0,dhterm_dx0_dx1,dhterm_dx0_dy0,dhterm_dx0_dy1;
REAL dhterm_dx1_dx0,dhterm_dx1_dx1,dhterm_dx1_dy0,dhterm_dx1_dy1;
REAL dhterm_dy0_dx0,dhterm_dy0_dx1,dhterm_dy0_dy0,dhterm_dy0_dy1;
REAL dhterm_dy1_dx0,dhterm_dy1_dx1,dhterm_dy1_dy0,dhterm_dy1_dy1;
REAL dprod_dx0_dx0,dprod_dx0_dx1,dprod_dx0_dy0,dprod_dx0_dy1;
REAL dprod_dx1_dx0,dprod_dx1_dx1,dprod_dx1_dy0,dprod_dx1_dy1;
REAL dprod_dy0_dx0,dprod_dy0_dx1,dprod_dy0_dy0,dprod_dy0_dy1;
REAL dprod_dy1_dx0,dprod_dy1_dx1,dprod_dy1_dy0,dprod_dy1_dy1;
hterm = sign*2*dx/ss - h0_value;
for ( prod = 1.0, k = 0 ; k < power ; k++ )
{ hessprod = gradprod;
gradprod = prod;
prod *= hterm;
}
energy = prod*M_PI*ss/4;
if ( mode == METHOD_VALUE )
return energy;
/* gradient */
dss_dx0 = -2*side1[0];
dss_dx1 = 2*side1[0];
dss_dy0 = -2*side1[1];
dss_dy1 = 2*side1[1];
dhterm_dx0 = sign*2*(-1/ss - dx/ss/ss*dss_dx0);
dhterm_dy0 = sign*2*( - dx/ss/ss*dss_dy0);
dhterm_dx1 = sign*2*( 1/ss - dx/ss/ss*dss_dx1);
dhterm_dy1 = sign*2*( - dx/ss/ss*dss_dy1);
dprod_dx0 = power*gradprod*dhterm_dx0;
dprod_dx1 = power*gradprod*dhterm_dx1;
dprod_dy0 = power*gradprod*dhterm_dy0;
dprod_dy1 = power*gradprod*dhterm_dy1;
v_info->grad[0][0] = dprod_dx0*M_PI*ss/4 +prod*M_PI*dss_dx0/4;
v_info->grad[0][1] = 0.0; /* assuming constrained to axis */
v_info->grad[1][0] = dprod_dx1*M_PI*ss/4 +prod*M_PI*dss_dx1/4;
v_info->grad[1][1] = dprod_dy1*M_PI*ss/4 +prod*M_PI*dss_dy1/4;
if ( mode == METHOD_GRADIENT )
return energy;
/* hessian */
dss_dx0_dx0 = 2;
dss_dx0_dx1 = -2;
dss_dx1_dx0 = -2;
dss_dx1_dx1 = 2;
dss_dy0_dy0 = 2;
dss_dy0_dy1 = -2;
dss_dy1_dy0 = -2;
dss_dy1_dy1 = 2;
dhterm_dx0_dx0 = sign*2*(1/ss/ss*dss_dx0 - dx_dx0/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dx0*dss_dx0 - dx/ss/ss*dss_dx0_dx0);
dhterm_dx0_dx1 = sign*2*(1/ss/ss*dss_dx1 - dx_dx1/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dx1*dss_dx0 - dx/ss/ss*dss_dx0_dx1);
dhterm_dx0_dy0 = sign*2*(1/ss/ss*dss_dy0 - dx_dy0/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dy0*dss_dx0 - dx/ss/ss*dss_dx0_dy0);
dhterm_dx0_dy1 = sign*2*(1/ss/ss*dss_dy1 - dx_dy1/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dy1*dss_dx0 - dx/ss/ss*dss_dx0_dy1);
dhterm_dy0_dx0 = sign*2*(-dx_dx0/ss/ss*dss_dy0 +2*dx/ss/ss/ss*dss_dx0*dss_dy0
- dx/ss/ss*dss_dy0_dx0);
dhterm_dy0_dx1 = sign*2*(-dx_dx1/ss/ss*dss_dy0 +2*dx/ss/ss/ss*dss_dx1*dss_dy0
- dx/ss/ss*dss_dy0_dx1);
dhterm_dy0_dy0 = sign*2*(-dx_dy0/ss/ss*dss_dy0 +2*dx/ss/ss/ss*dss_dy0*dss_dy0
- dx/ss/ss*dss_dy0_dy0);
dhterm_dy0_dy1 = sign*2*(-dx_dy1/ss/ss*dss_dy0 +2*dx/ss/ss/ss*dss_dy1*dss_dy0
- dx/ss/ss*dss_dy0_dy1);
dhterm_dx1_dx0 = sign*2*(-1/ss/ss*dss_dx0 - dx_dx0/ss/ss*dss_dx1
+2*dx/ss/ss/ss*dss_dx0*dss_dx1 - dx/ss/ss*dss_dx1_dx0);
dhterm_dx1_dx1 = sign*2*(-1/ss/ss*dss_dx1 - dx_dx1/ss/ss*dss_dx1
+2*dx/ss/ss/ss*dss_dx1*dss_dx1 - dx/ss/ss*dss_dx1_dx1);
dhterm_dx1_dy0 = sign*2*(-1/ss/ss*dss_dy0 - dx_dy0/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dy0*dss_dx1 - dx/ss/ss*dss_dx1_dy0);
dhterm_dx1_dy1 = sign*2*(-1/ss/ss*dss_dy1 - dx_dy1/ss/ss*dss_dx0
+2*dx/ss/ss/ss*dss_dy1*dss_dx1 - dx/ss/ss*dss_dx1_dy1);
dhterm_dy1_dx0 = sign*2*(-dx_dx0/ss/ss*dss_dy1 +2*dx/ss/ss/ss*dss_dx0*dss_dy1
- dx/ss/ss*dss_dy1_dx0);
dhterm_dy1_dx1 = sign*2*(-dx_dx1/ss/ss*dss_dy1 +2*dx/ss/ss/ss*dss_dx1*dss_dy1
- dx/ss/ss*dss_dy1_dx1);
dhterm_dy1_dy0 = sign*2*(-dx_dy0/ss/ss*dss_dy1 +2*dx/ss/ss/ss*dss_dy0*dss_dy1
- dx/ss/ss*dss_dy1_dy0);
dhterm_dy1_dy1 = sign*2*(-dx_dy1/ss/ss*dss_dy1 +2*dx/ss/ss/ss*dss_dy1*dss_dy1
- dx/ss/ss*dss_dy1_dy1);
dprod_dx0_dx0 = power*(power-1)*hessprod*dhterm_dx0*dhterm_dx0
+ power*gradprod*dhterm_dx0_dx0;
dprod_dx0_dx1 = power*(power-1)*hessprod*dhterm_dx0*dhterm_dx1
+ power*gradprod*dhterm_dx0_dx1;
dprod_dx0_dy0 = power*(power-1)*hessprod*dhterm_dx0*dhterm_dy0
+ power*gradprod*dhterm_dx0_dy0;
dprod_dx0_dy1 = power*(power-1)*hessprod*dhterm_dx0*dhterm_dy1
+ power*gradprod*dhterm_dx0_dy1;
dprod_dx1_dx0 = power*(power-1)*hessprod*dhterm_dx1*dhterm_dx0
+ power*gradprod*dhterm_dx1_dx0;
dprod_dx1_dx1 = power*(power-1)*hessprod*dhterm_dx1*dhterm_dx1
+ power*gradprod*dhterm_dx1_dx1;
dprod_dx1_dy0 = power*(power-1)*hessprod*dhterm_dx1*dhterm_dy0
+ power*gradprod*dhterm_dx1_dy0;
dprod_dx1_dy1 = power*(power-1)*hessprod*dhterm_dx1*dhterm_dy1
+ power*gradprod*dhterm_dx1_dy1;
dprod_dy0_dx0 = power*(power-1)*hessprod*dhterm_dy0*dhterm_dx0
+ power*gradprod*dhterm_dy0_dx0;
dprod_dy0_dx1 = power*(power-1)*hessprod*dhterm_dy0*dhterm_dx1
+ power*gradprod*dhterm_dy0_dx1;
dprod_dy0_dy0 = power*(power-1)*hessprod*dhterm_dy0*dhterm_dy0
+ power*gradprod*dhterm_dy0_dy0;
dprod_dy0_dy1 = power*(power-1)*hessprod*dhterm_dy0*dhterm_dy1
+ power*gradprod*dhterm_dy0_dy1;
dprod_dy1_dx0 = power*(power-1)*hessprod*dhterm_dy1*dhterm_dx0
+ power*gradprod*dhterm_dy1_dx0;
dprod_dy1_dx1 = power*(power-1)*hessprod*dhterm_dy1*dhterm_dx1
+ power*gradprod*dhterm_dy1_dx1;
dprod_dy1_dy0 = power*(power-1)*hessprod*dhterm_dy1*dhterm_dy0
+ power*gradprod*dhterm_dy1_dy0;
dprod_dy1_dy1 = power*(power-1)*hessprod*dhterm_dy1*dhterm_dy1
+ power*gradprod*dhterm_dy1_dy1;
v_info->hess[0][0][0][0] = M_PI/4*(dprod_dx0_dx0*ss + dprod_dx0*dss_dx0
+ dprod_dx0*dss_dx0 + prod*dss_dx0_dx0);
v_info->hess[0][0][0][1] = 0.0;
v_info->hess[0][1][0][0] = -v_info->hess[0][0][0][0];
v_info->hess[0][1][0][1] = M_PI/4*(dprod_dx0_dy1*ss + dprod_dx0*dss_dy1
+ dprod_dy1*dss_dx0 + prod*dss_dx0_dy1);
v_info->hess[0][0][1][0] = 0.0; /* assuming constrained to axis */
v_info->hess[0][0][1][1] = 0.0; /* assuming constrained to axis */
v_info->hess[0][1][1][0] = 0.0; /* assuming constrained to axis */
v_info->hess[0][1][1][1] = 0.0; /* assuming constrained to axis */
v_info->hess[1][0][0][0] = v_info->hess[0][1][0][0];
v_info->hess[1][0][0][1] = 0.0;
v_info->hess[1][1][0][0] = -v_info->hess[1][0][0][0];
v_info->hess[1][1][0][1] = M_PI/4*(dprod_dx1_dy1*ss + dprod_dx1*dss_dy1
+ dprod_dy1*dss_dx1 + prod*dss_dx1_dy1);
v_info->hess[1][0][1][0] = v_info->hess[0][1][0][1];
v_info->hess[1][0][1][1] = v_info->hess[0][1][1][1];
v_info->hess[1][1][1][0] = v_info->hess[1][1][0][1];
v_info->hess[1][1][1][1]= M_PI/4*(dprod_dy1_dy1*ss + dprod_dy1*dss_dy1
+ dprod_dy1*dss_dy1 + prod*dss_dy1_dy1);
return energy;
}
if ( v_info->vcount < 3 ) return 0.;
/* now regular case */
r0 = v_info->x[1][1];
r1 = v_info->x[0][1];
r2 = v_info->x[2][1];
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
area = s1*(r0 + r1)/2 + s2*(r1 + r2)/2;
dadx[0] = -side1[0]*(r0+r1)/2/s1 - side2[0]*(r1+r2)/2/s2;
dadr[0] = (r1*r1 - r0*r0)/s1/2 + s1/2 + (r1*r1 - r2*r2)/s2/2 + s2/2;
sign = ( dadr[0] < 0 ) ? -1 : 1;
root = sqrt(dadx[0]*dadx[0] + dadr[0]*dadr[0]);
h = sign*root/area; /* half factor included here */
switch ( h0_flag )
{ case H0_IN_GLOBAL: hh = h - h0_value; break;
case H0_IN_ATTR: hh = h - *VREAL(v_info->id,h0_attr); break;
default: hh = h;
}
if ( power == 2.0 ) energy = 2*M_PI*hh*hh*area/2;
else if ( power == 1.0 ) energy = 2*M_PI*hh*area/2;
else energy = 2*M_PI*area/2*pow(fabs(hh),power);
if ( mode == METHOD_VALUE )
return energy;
/* Gradient */
/* Note: v_info->grad[i][j] is component j of gradient at vertex i */
dadx[1] = side1[0]*(r0+r1)/2/s1;
dadr[1] = -(r1*r1 - r0*r0)/s1/2 + s1/2;
dadx[2] = side2[0]*(r1+r2)/2/s2;
dadr[2] = -(r1*r1 - r2*r2)/s2/2 + s2/2;
ddadxdx[0][1] = -(r0+r1)/2/s1 + side1[0]*(r0+r1)/2/s1/s1/s1*side1[0];
ddadxdx[0][2] = -(r1+r2)/2/s2 + side2[0]*(r1+r2)/2/s2/s2/s2*side2[0];
ddadxdx[0][0] = -ddadxdx[0][1] - ddadxdx[0][2];
/* dadx[0] = -side1[0]*(r0+r1)/2/s1 - side2[0]*(r1+r2)/2/s2; */
ddadxdr[0][1] = -side1[0]/2/s1 - side1[0]*(r1*r1-r0*r0)/s1/s1/s1/2;
ddadxdr[0][2] = -side2[0]/2/s2 - side2[0]*(r1*r1-r2*r2)/s2/s2/s2/2;
ddadxdr[0][0] = -side1[0]/2/s1 + side1[0]*(r1*r1-r0*r0)/s1/s1/s1/2
-side2[0]/2/s2 + side2[0]*(r1*r1-r2*r2)/s2/s2/s2/2;
ddadrdx[0][1] = ((r1*r1-r0*r0)/2*(-1)/s1/s1 + 1/2.)*(side1[0]/s1);
ddadrdx[0][2] = ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 1/2.)*(side2[0]/s2);
ddadrdx[0][0] = -ddadrdx[0][1]-ddadrdx[0][2];
ddadrdr[0][0] = r1/s1 + ((r1*r1-r0*r0)/2*(-1)/s1/s1 + 0.5)/s1*(r1-r0)
+ r1/s2 + ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 0.5)/s2*(r1-r2);
ddadrdr[0][1] = -r0/s1 +((r1*r1-r0*r0)/2*(-1)/s1/s1 + 0.5)/s1*(r0-r1);
ddadrdr[0][2] = -r2/s2 + ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 0.5)/s2*(r2-r1);
for ( i = 0 ; i < 3 ; i++ )
{ dhdx[i] = sign*(.5/root/area*
(2*dadx[0]*ddadxdx[0][i] + 2*dadr[0]*ddadrdx[0][i]))
- h/area*dadx[i];
dhdr[i] = sign*(.5/root/area*
(2*dadx[0]*ddadxdr[0][i] + 2*dadr[0]*ddadrdr[0][i]))
- h/area*dadr[i];
}
if ( power == 2.0 )
{ for ( i = 0 ; i < 3 ; i++ )
{ v_info->grad[i][0] = 2*M_PI*(2*hh*dhdx[i]*area + hh*hh*dadx[i])/2;
v_info->grad[i][1] = 2*M_PI*(2*hh*dhdr[i]*area + hh*hh*dadr[i])/2;
}
}
else if ( power == 1.0 )
{ for ( i = 0 ; i < 3 ; i++ )
{ v_info->grad[i][0] = 2*M_PI*(dhdx[i]*area + hh*dadx[i])/2;
v_info->grad[i][1] = 2*M_PI*(dhdr[i]*area + hh*dadr[i])/2;
}
}
else
{ REAL pp = pow(fabs(hh),power-1);
for ( i = 0 ; i < 3 ; i++ )
{ v_info->grad[i][0] = 2*M_PI*(power*pp*dhdx[i]*area + pp*hh*dadx[i])/2;
v_info->grad[i][1] = 2*M_PI*(power*pp*dhdr[i]*area + pp*hh*dadr[i])/2;
}
}
if ( mode == METHOD_GRADIENT )
return energy;
/* Hessian */
/* Note: v_info->hess[i][ii][j][jj] is component j of vertex i and
component jj of vertex ii */
/* dadx[1] = side1[0]*(r0+r1)/2/s1; */
ddadxdx[1][1] = (r0+r1)/2/s1 - side1[0]*(r0+r1)/2/s1/s1/s1*side1[0];
ddadxdx[1][2] = 0;
ddadxdx[1][0] = -ddadxdx[1][1];
ddadxdr[1][1] = side1[0]/2/s1 + side1[0]*(r0+r1)/s1/s1/s1/2*(r1-r0);
ddadxdr[1][2] = 0;
ddadxdr[1][0] = side1[0]/2/s1 - side1[0]*(r0+r1)/s1/s1/s1/2*(r1-r0);
/* dadr[1] = -(r1*r1 - r0*r0)/s1/2 + s1/2; */
ddadrdx[1][1] = (-(r1*r1-r0*r0)/2*(-1)/s1/s1 + 1/2.)*(side1[0]/s1);
ddadrdx[1][2] = 0;
ddadrdx[1][0] = -ddadrdx[1][1];
ddadrdr[1][0] = -r1/s1 + (-(r1*r1-r0*r0)/2*(-1)/s1/s1 + 0.5)/s1*(r1-r0);
ddadrdr[1][1] = r0/s1 + (-(r1*r1-r0*r0)/2*(-1)/s1/s1 + 0.5)/s1*(r0-r1);
ddadrdr[1][2] = 0;
/* dadx[2] = side2[0]*(r1+r2)/2/s2; */
ddadxdx[2][1] = 0;
ddadxdx[2][2] = (r1+r2)/2/s2 - side2[0]*(r1+r2)/2/s2/s2/s2*side2[0];
ddadxdx[2][0] = -ddadxdx[2][2];
ddadxdr[2][1] = 0;
ddadxdr[2][2] = side2[0]/2/s2 + side2[0]*(r2+r1)/s2/s2/s2/2*(r1-r2);
ddadxdr[2][0] = side2[0]/2/s2 - side2[0]*(r2+r1)/s2/s2/s2/2*(r1-r2);
/* dadr[2] = -(r1*r1 - r2*r2)/s2/2 + s2/2; */
ddadrdx[2][1] = 0;
ddadrdx[2][2] = (-(r1*r1-r2*r2)/2*(-1)/s2/s2 + 1/2.)*(side2[0]/s2);
ddadrdx[2][0] = -ddadrdx[2][2];
ddadrdr[2][0] = -r1/s2 + (-(r1*r1-r2*r2)/2*(-1)/s2/s2 + 0.5)/s2*(r1-r2);
ddadrdr[2][1] = 0;
ddadrdr[2][2] = r2/s2 + (-(r1*r1-r2*r2)/2*(-1)/s2/s2 + 0.5)/s2*(r2-r1);
/* ddadxdx[0][1] = -(r0+r1)/2/s1 + side1[0]*(r0+r1)/2/s1/s1/s1*side1[0]; */
dddadxdxdx[0][1][0] = -(r0+r1)/2/s1/s1/s1/(-2)*(-2*side1[0])
- 2*side1[0]*(r0+r1)/2/s1/s1/s1
- 1.5*side1[0]*side1[0]*(r0+r1)/2/s1/s1/s1/s1/s1*(-2*side1[0]);
dddadxdxdx[0][1][1] = -dddadxdxdx[0][1][0];
dddadxdxdx[0][1][2] = 0;
dddadxdxdr[0][1][0] = -1./2/s1 + side1[0]/2/s1/s1/s1*side1[0]
+ (-(r0+r1)/2*(-1)/s1/s1 + side1[0]*(r0+r1)/2*(-3)/s1/s1/s1/s1*side1[0])
*(r1-r0)/s1;
dddadxdxdr[0][1][1] = -1./2/s1 + side1[0]/2/s1/s1/s1*side1[0]
+ (-(r0+r1)/2*(-1)/s1/s1 + side1[0]*(r0+r1)/2*(-3)/s1/s1/s1/s1*side1[0])
*(r0-r1)/s1;
dddadxdxdr[0][1][2] = 0;
/* ddadxdx[0][2] = -(r1+r2)/2/s2 + side2[0]*(r1+r2)/2/s2/s2/s2*side2[0]; */
dddadxdxdx[0][2][0] = + 2*side2[0]*(-1)*(r1+r2)/2/s2/s2/s2
+ (-(r1+r2)/2*(-1)/s2/s2 + side2[0]*(r1+r2)/2*(-3)/s2/s2/s2/s2*side2[0])
*(-side2[0])/s2;
dddadxdxdx[0][2][1] = 0;
dddadxdxdx[0][2][2] = -dddadxdxdx[0][2][0];
dddadxdxdr[0][2][0] = -1./2/s2 + side2[0]/2/s2/s2/s2*side2[0] +
(-(r1+r2)/2*(-1)/s2/s2 + side2[0]*(r1+r2)/2*(-3)/s2/s2/s2/s2*side2[0])
*(r1-r2)/s2;
dddadxdxdr[0][2][1] = 0;
dddadxdxdr[0][2][2] = -1./2/s2 + side2[0]/2/s2/s2/s2*side2[0] +
(-(r1+r2)/2*(-1)/s2/s2 + side2[0]*(r1+r2)/2*(-3)/s2/s2/s2/s2*side2[0])
*(r2-r1)/s2;
/* ddadxdx[0][0] = -ddadxdx[0][1] - ddadxdx[0][2]; */
dddadxdxdx[0][0][0] = -dddadxdxdx[0][1][0] - dddadxdxdx[0][2][0];
dddadxdxdx[0][0][1] = -dddadxdxdx[0][1][1] - dddadxdxdx[0][2][1];
dddadxdxdx[0][0][2] = -dddadxdxdx[0][1][2] - dddadxdxdx[0][2][2];
dddadxdxdr[0][0][0] = -dddadxdxdr[0][1][0] - dddadxdxdr[0][2][0];
dddadxdxdr[0][0][1] = -dddadxdxdr[0][1][1] - dddadxdxdr[0][2][1];
dddadxdxdr[0][0][2] = -dddadxdxdr[0][1][2] - dddadxdxdr[0][2][2];
/* ddadxdr[0][1] = -side1[0]/2/s1 - side1[0]*(r1*r1-r0*r0)/s1/s1/s1/2; */
dddadxdrdx[0][1][0] = dddadxdxdr[0][0][1];
dddadxdrdx[0][1][1] = dddadxdxdr[0][1][1];
dddadxdrdx[0][1][2] = dddadxdxdr[0][2][1];
dddadxdrdr[0][1][0] = -side1[0]*2*r1/s1/s1/s1/2 +
(-side1[0]/2*(-1)/s1/s1 - side1[0]*(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1/2)
*(r1-r0)/s1;
dddadxdrdr[0][1][1] = -side1[0]*(-2)*r0/s1/s1/s1/2 +
(-side1[0]/2*(-1)/s1/s1 - side1[0]*(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1/2)
*(r0-r1)/s1;
dddadxdrdr[0][1][2] = 0;
/* ddadxdr[0][2] = -side2[0]/2/s2 - side2[0]*(r1*r1-r2*r2)/s2/s2/s2/2 */;
dddadxdrdx[0][2][0] = dddadxdxdr[0][0][2];
dddadxdrdx[0][2][1] = dddadxdxdr[0][1][2];
dddadxdrdx[0][2][2] = dddadxdxdr[0][2][2];
dddadxdrdr[0][2][0] = -side2[0]*2*r1/s2/s2/s2/2 +
+ (-side2[0]/2*(-1)/s2/s2 - side2[0]*(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2/2) *
(r1-r2)/s2;
dddadxdrdr[0][2][1] = 0;
dddadxdrdr[0][2][2] = -side2[0]*(-2)*r2/s2/s2/s2/2 +
+ (-side2[0]/2*(-1)/s2/s2 - side2[0]*(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2/2) *
(r2-r1)/s2;
/* ddadxdr[0][0] = -side1[0]/2/s1 + side1[0]*(r1*r1-r0*r0)/s1/s1/s1/2
-side2[0]/2/s2 + side2[0]*(r1*r1-r2*r2)/s2/s2/s2/2; */
dddadxdrdx[0][0][0] = dddadxdxdr[0][0][0];
dddadxdrdx[0][0][1] = dddadxdxdr[0][1][0];
dddadxdrdx[0][0][2] = dddadxdxdr[0][2][0];
dddadxdrdr[0][0][0] = side1[0]*2*r1/s1/s1/s1/2 + side2[0]*2*r1/s2/s2/s2/2
+ (side1[0]/2/s1/s1 + side1[0]*(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1/2)*(r1-r0)/s1
+ (side2[0]/2/s2/s2 + side2[0]*(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2/2)*(r1-r2)/s2;
dddadxdrdr[0][0][1] = side1[0]*(-2)*r0/s1/s1/s1/2
+ (side1[0]/2/s1/s1 + side1[0]*(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1/2)*(r0-r1)/s1;
dddadxdrdr[0][0][2] = side2[0]*(-2)*r2/s2/s2/s2/2
+ (side2[0]/2/s2/s2 + side2[0]*(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2/2)*(r2-r1)/s2;
/* ddadrdx[0][1] = ((r1*r1-r0*r0)/2*(-1)/s1/s1 + 1/2.)*(side1[0]/s1); */
dddadrdxdx[0][1][0] = ((r1*r1-r0*r0)/2*(-1)/s1/s1 + 1/2.)*(-1/s1)
+ side1[0]*((r1*r1-r0*r0)/2*(-1)*(-3)/s1/s1/s1/s1 + 1/2.*(-1)/s1/s1)
*(-side1[0])/s1;
dddadrdxdx[0][1][1] = ((r1*r1-r0*r0)/2*(-1)/s1/s1 + 1/2.)*(1/s1)
+ side1[0]*((r1*r1-r0*r0)/2*(-1)*(-3)/s1/s1/s1/s1 + 1/2.*(-1)/s1/s1)
*(side1[0])/s1;
dddadrdxdx[0][1][2] = 0;
dddadrdxdr[0][1][0] = 2*r1/2*(-1)/s1/s1*(side1[0]/s1) +
side1[0]*((r1*r1-r0*r0)/2*(-1)*(-3)/s1/s1/s1/s1
+ 1/2.*(-1)/s1/s1)*(r1-r0)/s1;
dddadrdxdr[0][1][1] = -2*r0/2*(-1)/s1/s1*(side1[0]/s1) +
side1[0]*((r1*r1-r0*r0)/2*(-1)*(-3)/s1/s1/s1/s1
+ 1/2.*(-1)/s1/s1)*(r0-r1)/s1;
dddadrdxdr[0][1][2] = 0;
/* ddadrdx[0][2] = ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 1/2.)*(side2[0]/s2); */
dddadrdxdx[0][2][0] = ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 1/2.)*(-1/s2)
+ side2[0]*((r1*r1-r2*r2)/2*(-1)*(-3)/s2/s2/s2/s2 + 1/2.*(-1)/s2/s2)
*(-side2[0])/s2;
dddadrdxdx[0][2][1] = 0;
dddadrdxdx[0][2][2] = ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 1/2.)*(1/s2)
+ side2[0]*((r1*r1-r2*r2)/2*(-1)*(-3)/s2/s2/s2/s2 + 1/2.*(-1)/s2/s2)
*(side2[0])/s2;
dddadrdxdr[0][2][0] = 2*r1/2*(-1)/s2/s2*(side2[0]/s2) +
side2[0]*((r1*r1-r2*r2)/2*(-1)*(-3)/s2/s2/s2/s2
+ 1/2.*(-1)/s2/s2)*(r1-r2)/s2;
dddadrdxdr[0][2][1] = 0;
dddadrdxdr[0][2][2] = -2*r2/2*(-1)/s2/s2*(side2[0]/s2) +
side2[0]*((r1*r1-r2*r2)/2*(-1)*(-3)/s2/s2/s2/s2
+ 1/2.*(-1)/s2/s2)*(r2-r1)/s2;
/* ddadrdx[0][0] = -ddadrdx[0][1]-ddadrdx[0][2]; */
dddadrdxdx[0][0][0] = -dddadrdxdx[0][1][0]-dddadrdxdx[0][2][0];
dddadrdxdx[0][0][1] = -dddadrdxdx[0][1][1]-dddadrdxdx[0][2][1];
dddadrdxdx[0][0][2] = -dddadrdxdx[0][1][2]-dddadrdxdx[0][2][2];
dddadrdxdr[0][0][0] = -dddadrdxdr[0][1][0]-dddadrdxdr[0][2][0];
dddadrdxdr[0][0][1] = -dddadrdxdr[0][1][1]-dddadrdxdr[0][2][1];
dddadrdxdr[0][0][2] = -dddadrdxdr[0][1][2]-dddadrdxdr[0][2][2];
/* ddadrdr[0][0] = r1/s1 + (-(r1*r1-r0*r0)/s1/s1/s1 + 1/s1)*(r1-r0)/2
+ r1/s2 + (-(r1*r1-r2*r2)/s2/s2/s2 + 1/s2)*(r1-r2)/2; */
dddadrdrdx[0][0][0] = dddadrdxdr[0][0][0];
dddadrdrdx[0][0][1] = dddadrdxdr[0][1][0];
dddadrdrdx[0][0][2] = dddadrdxdr[0][2][0];
dddadrdrdr[0][0][0] = 1/s1 - 2*r1/s1/s1/s1*(r1-r0)/2
+ (-(r1*r1-r0*r0)/s1/s1/s1 + 1/s1)/2
+ (-r1/s1/s1 + (-(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1 - 1/s1/s1)*(r1-r0)/2)
*(r1-r0)/s1
+ 1/s2 - 2*r1/s2/s2/s2*(r1-r2)/2
+ (-(r1*r1-r2*r2)/s2/s2/s2 + 1/s2)/2
+ (-r1/s2/s2 + (-(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2 - 1/s2/s2)*(r1-r2)/2)
*(r1-r2)/s2;
dddadrdrdr[0][0][1] = 2*r0/s1/s1/s1*(r1-r0)/2
- (-(r1*r1-r0*r0)/s1/s1/s1 + 1/s1)/2
+ (-r1/s1/s1 + (-(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1 - 1/s1/s1)*(r1-r0)/2)
*(r0-r1)/s1;
dddadrdrdr[0][0][2] = 2*r2/s2/s2/s2*(r1-r2)/2
- (-(r1*r1-r2*r2)/s2/s2/s2 + 1/s2)/2
+ (-r1/s2/s2 + (-(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2 - 1/s2/s2)*(r1-r2)/2)
*(r2-r1)/s2;
/* ddadrdr[0][1] = -r0/s1 +(-(r1*r1-r0*r0)/s1/s1/s1 + 1/s1)*(r0-r1)/2; */
dddadrdrdx[0][1][0] = dddadrdxdr[0][0][1];
dddadrdrdx[0][1][1] = dddadrdxdr[0][1][1];
dddadrdrdx[0][1][2] = dddadrdxdr[0][2][1];
dddadrdrdr[0][1][0] = dddadrdrdr[0][0][1];
dddadrdrdr[0][1][1] = -1/s1 + 2*r0/s1/s1/s1*(r0-r1)/2
+ (-(r1*r1-r0*r0)/s1/s1/s1 + 1/s1)/2
+ (r0/s1/s1 + (-(r1*r1-r0*r0)*(-3)/s1/s1/s1/s1 + (-1)/s1/s1)*(r0-r1)/2)
*(r0-r1)/s1;
dddadrdrdr[0][1][2] = 0;
/* ddadrdr[0][2] = -r2/s2 + ((r1*r1-r2*r2)/2*(-1)/s2/s2 + 0.5)/s2*(r2-r1); */
dddadrdrdx[0][2][0] = dddadrdxdr[0][0][2];
dddadrdrdx[0][2][1] = dddadrdxdr[0][1][2];
dddadrdrdx[0][2][2] = dddadrdxdr[0][2][2];
dddadrdrdr[0][2][0] = dddadrdrdr[0][0][2];
dddadrdrdr[0][2][1] = dddadrdrdr[0][1][2];
dddadrdrdr[0][2][2] = -1/s2 + 2*r2/s2/s2/s2*(r2-r1)/2
+ (-(r1*r1-r2*r2)/s2/s2/s2 + 1/s2)/2
+ (r2/s2/s2 + (-(r1*r1-r2*r2)*(-3)/s2/s2/s2/s2 + (-1)/s2/s2)*(r2-r1)/2)
*(r2-r1)/s2;
for ( i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
{ ddhdxdx[i][j] = sign*(
(-.5)*.5/root/root/root/area*
(2*dadx[0]*ddadxdx[0][i] + 2*dadr[0]*ddadrdx[0][i])
*(2*dadx[0]*ddadxdx[0][j] + 2*dadr[0]*ddadrdx[0][j])
+ (-1)*.5/root/area/area*dadx[j]*
(2*dadx[0]*ddadxdx[0][i] + 2*dadr[0]*ddadrdx[0][i])
+ .5/root/area*
(2*ddadxdx[0][j]*ddadxdx[0][i] + 2*ddadrdx[0][j]*ddadrdx[0][i])
+ .5/root/area*
(2*dadx[0]*dddadxdxdx[0][i][j] + 2*dadr[0]*dddadrdxdx[0][i][j])
)
- dhdx[j]/area*dadx[i]
- (-1)*h/area/area*dadx[j]*dadx[i]
- h/area*ddadxdx[i][j];
ddhdxdr[i][j] = sign*(
(-.5)*.5/root/root/root/area*
(2*dadx[0]*ddadxdx[0][i] + 2*dadr[0]*ddadrdx[0][i])
*(2*dadx[0]*ddadxdr[0][j] + 2*dadr[0]*ddadrdr[0][j])
+ (-1)*.5/root/area/area*dadr[j]*
(2*dadx[0]*ddadxdx[0][i] + 2*dadr[0]*ddadrdx[0][i])
+ .5/root/area*
(2*ddadxdr[0][j]*ddadxdx[0][i] + 2*ddadrdr[0][j]*ddadrdx[0][i])
+ .5/root/area*
(2*dadx[0]*dddadxdxdr[0][i][j] + 2*dadr[0]*dddadrdxdr[0][i][j])
)
- dhdr[j]/area*dadx[i]
- (-1)*h/area/area*dadr[j]*dadx[i]
- h/area*ddadxdr[i][j];
ddhdrdx[i][j] = sign*(
(-.5)*.5/root/root/root/area*
(2*dadx[0]*ddadxdr[0][i] + 2*dadr[0]*ddadrdr[0][i])
*(2*dadx[0]*ddadxdx[0][j] + 2*dadr[0]*ddadrdx[0][j])
+ (-1)*.5/root/area/area*dadx[j]*
(2*dadx[0]*ddadxdr[0][i] + 2*dadr[0]*ddadrdr[0][i])
+ .5/root/area*
(2*ddadxdx[0][j]*ddadxdr[0][i] + 2*ddadrdx[0][j]*ddadrdr[0][i])
+ .5/root/area*
(2*dadx[0]*dddadxdrdx[0][i][j] + 2*dadr[0]*dddadrdrdx[0][i][j])
)
- dhdx[j]/area*dadr[i]
- (-1)*h/area/area*dadx[j]*dadr[i]
- h/area*ddadrdx[i][j];
ddhdrdr[i][j] = sign*(
(-.5)*.5/root/root/root/area*
(2*dadx[0]*ddadxdr[0][i] + 2*dadr[0]*ddadrdr[0][i])
*(2*dadx[0]*ddadxdr[0][j] + 2*dadr[0]*ddadrdr[0][j])
+ (-1)*.5/root/area/area*dadr[j]*
(2*dadx[0]*ddadxdr[0][i] + 2*dadr[0]*ddadrdr[0][i])
+ .5/root/area*
(2*ddadxdr[0][j]*ddadxdr[0][i] + 2*ddadrdr[0][j]*ddadrdr[0][i])
+ .5/root/area*
(2*dadx[0]*dddadxdrdr[0][i][j] + 2*dadr[0]*dddadrdrdr[0][i][j])
)
- dhdr[j]/area*dadr[i]
- (-1)*h/area/area*dadr[j]*dadr[i]
- h/area*ddadrdr[i][j];
}
if ( power == 2.0 )
{ for ( i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
{ v_info->hess[i][j][0][0] = M_PI*( 2*dhdx[j]*dhdx[i]*area
+ 2*dhdx[j]*hh*dadx[i] + 2*hh*ddhdxdx[i][j]*area
+ hh*hh*ddadxdx[i][j] + 2*hh*dhdx[i]*dadx[j]);
v_info->hess[i][j][0][1] = M_PI*( 2*dhdr[j]*dhdx[i]*area
+ 2*dhdr[j]*hh*dadx[i] + 2*hh*ddhdxdr[i][j]*area
+ hh*hh*ddadxdr[i][j] + 2*hh*dhdx[i]*dadr[j]);
v_info->hess[i][j][1][0] = M_PI*( 2*dhdx[j]*dhdr[i]*area
+ 2*dhdx[j]*hh*dadr[i] + 2*hh*ddhdrdx[i][j]*area
+ hh*hh*ddadrdx[i][j] + 2*hh*dhdr[i]*dadx[j]);
v_info->hess[i][j][1][1] = M_PI*( 2*dhdr[j]*dhdr[i]*area
+ 2*dhdr[j]*hh*dadr[i] + 2*hh*ddhdrdr[i][j]*area
+ hh*hh*ddadrdr[i][j] + 2*hh*dhdr[i]*dadr[j]);
}
}
else if ( power == 1.0 )
{ for ( i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
{ v_info->hess[i][j][0][0] = M_PI*(ddhdxdx[i][j]*area + dhdx[j]*dadx[i]
+ dhdx[i]*dadx[j] + hh*ddadxdx[i][j]);
v_info->hess[i][j][0][1] = M_PI*(ddhdxdr[i][j]*area + dhdr[j]*dadx[i]
+ dhdx[i]*dadr[j] + hh*ddadxdr[i][j]);
v_info->hess[i][j][1][0] = M_PI*(ddhdxdr[i][j]*area + dhdx[j]*dadr[i]
+ dhdr[i]*dadx[j] + hh*ddadxdr[i][j]);
v_info->hess[i][j][1][1] = M_PI*(ddhdrdr[i][j]*area + dhdr[j]*dadr[i]
+ dhdr[i]*dadr[j] + hh*ddadrdr[i][j]);
}
}
else
{ REAL pp = pow(fabs(hh),power-1);
for ( i = 0 ; i < 3 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
{ v_info->hess[i][j][0][0] = M_PI*(
power*(power-1)*pp/hh*dhdx[j]*dhdx[i]*area + power*pp*dhdx[j]*dadx[i]
+ power*pp*ddhdxdx[i][j]*area + pp*hh*ddadxdx[i][j]
+ power*pp*dhdx[i]*dadx[j]);
v_info->hess[i][j][0][1] = M_PI*(
power*(power-1)*pp/hh*dhdr[j]*dhdx[i]*area + power*pp*dhdr[j]*dadx[i]
+ power*pp*ddhdxdr[i][j]*area + pp*hh*ddadxdr[i][j]
+ power*pp*dhdx[i]*dadr[j]);
v_info->hess[i][j][1][0] = M_PI*(
power*(power-1)*pp/hh*dhdx[j]*dhdr[i]*area + power*pp*dhdx[j]*dadr[i]
+ power*pp*ddhdxdr[i][j]*area + pp*hh*ddadxdr[i][j]
+ power*pp*dhdr[i]*dadx[j]);
v_info->hess[i][j][1][1] = M_PI*(
power*(power-1)*pp/hh*dhdr[j]*dhdr[i]*area + power*pp*dhdr[j]*dadr[i]
+ power*pp*ddhdrdr[i][j]*area + pp*hh*ddadrdr[i][j]
+ power*pp*dhdr[i]*dadr[j]);
}
}
return energy;
}
/************************************************************************
*
* function: sq_mean_curv_cyl_value()
*
* purpose: Calculate square curvature energy for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sq_mean_curv_cyl_value(v_info)
struct qinfo *v_info;
{
return sq_mean_curv_cyl_all(v_info,METHOD_VALUE,2.0);
}
/************************************************************************
*
* function: sq_mean_curv_cyl_grad()
*
* purpose: Calculate square curvature gradient for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sq_mean_curv_cyl_grad(v_info)
struct qinfo *v_info;
{
return sq_mean_curv_cyl_all(v_info,METHOD_GRADIENT,2.0);
}
/************************************************************************
*
* function: sq_mean_curv_cyl_hess()
*
* purpose: Calculate square curvature hessian for string model
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sq_mean_curv_cyl_hess(v_info)
struct qinfo *v_info;
{
return sq_mean_curv_cyl_all(v_info,METHOD_HESSIAN,2.0);
}
/*************************************************************************
Square gaussian curvature for surface of revolution in string model.
Contributed by John Frank, jrf@mit.edu
Cylindrical axis is x axis.
Includes 2*pi factor.
**************************************************************************/
REAL sq_gauss_curv_cyl_all ARGS(( struct qinfo *, int));
/************************************************************************
*
* function: sq_gauss_curv_cyl_init()
*
* purpose: Any overall initialization needed each time the method
* is evaluated.
*/
void sq_gauss_curv_cyl_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(4486,"sq_gaussian_curv_cyl method only for LINEAR model.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: sq_gauss_curv_cyl_all()
*
* purpose: Combined calculations for one vertex for sq_gaussian_curv_cyl
* method.
*/
REAL sq_gauss_curv_cyl_all(v_info,mode)
struct qinfo *v_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{ REAL energy = 0.0;
/* Notes on incoming data:
v_info->vcount is number of vertices in v_info; it will be 3
for an interior vertex and 2 for an endpoint.
v_info->x[0][] is the coordinates of the vertex in question.
v_info->x[1][] is the coordinates of one neighbor vertex.
v_info->x[2][] is the coordinates of the other neighbor vertex.
v_info->sides[0][0][] is the vector from vertex 0 to vertex 1.
v_info->sides[0][1][] is the vector from vertex 0 to vertex 2.
*/
/* calculate value for single vertex here */
if ( mode == METHOD_VALUE )
return energy;
/* Gradient */
/* calculate gradient for the energy of the vertex here */
if ( mode == METHOD_GRADIENT )
return energy;
/* Hessian */
/* calculate hessian for the energy of the vertex here */
return energy;
}
/************************************************************************
*
* function: sq_gauss_curv_cyl_value()
*
* purpose: Calculate square gaussian curvature energy for surface
* of revolution in string model.
* Works locally vertex by vertex. Assumes two edges per vertex.
*
*/
REAL sq_gauss_curv_cyl_value(v_info)
struct qinfo *v_info;
{
return sq_gauss_curv_cyl_all(v_info,METHOD_VALUE);
}
/************************************************************************
*
* function: sq_gauss_curv_cyl_grad()
*
* purpose: Calculate square gaussian curvature gradient for
* surface of revolution in string model.
*
*/
REAL sq_gauss_curv_cyl_grad(v_info)
struct qinfo *v_info;
{
return sq_gauss_curv_cyl_all(v_info,METHOD_GRADIENT);
}
/************************************************************************
*
* function: sq_gauss_curv_cyl_hess()
*
* purpose: Calculate square curvature hessian for surface of revolution
* in string model.
*
*/
REAL sq_gauss_curv_cyl_hess(v_info)
struct qinfo *v_info;
{
return sq_gauss_curv_cyl_all(v_info,METHOD_HESSIAN);
}
evolver-2.30c.dfsg/src/inline.h 0000644 0001753 0001753 00000021233 11410765113 016645 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/***************************************************************
* File: inline.h *
* Purpose: Functions eligible for inlining. Various systems *
* have various things that need to be done to get inilning to *
* work, *
***************************************************************/
#if defined(INLINE)
INLINE void set_attr(id,attrib)
element_id id;
ATTR attrib;
{
elptr(id)->attr |= attrib;
}
INLINE void unset_attr(id,attrib)
element_id id;
ATTR attrib;
{
elptr(id)->attr &= ~attrib;
}
INLINE void set_fe_edge(fe_id,e_id)
facetedge_id fe_id;
edge_id e_id;
{
if ( inverted(fe_id) ) invert(e_id);
feptr(fe_id)->fe_edge_id = e_id;
top_timestamp = ++global_timestamp;
}
INLINE edge_id get_fe_edge(fe_id)
facetedge_id fe_id;
{
edge_id e_id;
e_id = feptr(fe_id)->fe_edge_id;
/*
if ( inverted(fe_id) ) invert(e_id);
return e_id;
*/
return same_sign(e_id,fe_id);
}
INLINE facet_id get_fe_facet(fe_id)
facetedge_id fe_id;
{
facet_id f_id;
if ( !valid_id(fe_id) ) return NULLFACET;
f_id = feptr(fe_id)->fe_facet_id;
if ( inverted(fe_id) ) invert(f_id);
return f_id;
}
INLINE facetedge_id get_prev_edge(fe_id)
facetedge_id fe_id;
{
if ( inverted(fe_id) ) return inverse_id(feptr(fe_id)->nextedge[1]);
else return feptr(fe_id)->nextedge[0];
}
INLINE facetedge_id get_next_edge(fe_id)
facetedge_id fe_id;
{
if ( inverted(fe_id) ) return inverse_id(feptr(fe_id)->nextedge[0]);
else return feptr(fe_id)->nextedge[1];
}
INLINE facetedge_id get_prev_facet(fe_id)
facetedge_id fe_id;
{
if ( inverted(fe_id) )
return inverse_id(feptr(fe_id)->nextfacet[1]);
else
return feptr(fe_id)->nextfacet[0];
}
INLINE facetedge_id get_next_facet(fe_id)
facetedge_id fe_id;
{
if ( inverted(fe_id) )
return inverse_id(feptr(fe_id)->nextfacet[0]);
else
return feptr(fe_id)->nextfacet[1];
}
INLINE void set_prev_edge(fe_id,fe)
facetedge_id fe_id;
facet_id fe;
{
if ( !valid_id(fe_id) ) return;
if ( inverted(fe_id) )
{ invert(fe);
feptr(fe_id)->nextedge[1] = fe;
}
else
feptr(fe_id)->nextedge[0] = fe;
top_timestamp = ++global_timestamp;
}
INLINE void set_next_edge(fe_id,fe)
facetedge_id fe_id,fe;
{
if ( !valid_id(fe_id) ) return;
if ( inverted(fe_id) )
{ invert(fe);
feptr(fe_id)->nextedge[0] = fe;
}
else
feptr(fe_id)->nextedge[1] = fe;
}
INLINE void set_prev_facet(fe_id,fe)
facetedge_id fe_id,fe;
{
if ( !valid_id(fe_id) ) return;
if ( inverted(fe_id) )
{ invert(fe);
feptr(fe_id)->nextfacet[1] = fe;
}
else
feptr(fe_id)->nextfacet[0] = fe;
top_timestamp = ++global_timestamp;
}
INLINE void set_next_facet(fe_id,fe)
facetedge_id fe_id,fe;
{
if ( !valid_id(fe_id) ) return;
if ( inverted(fe_id) )
{ invert(fe);
feptr(fe_id)->nextfacet[0] = fe;
}
else
feptr(fe_id)->nextfacet[1] = fe;
}
INLINE void set_edge_wrap(e_id,wrap)
edge_id e_id;
WRAPTYPE wrap;
{
*EINT(e_id,E_WRAP_ATTR) = inverted(e_id) ? (*sym_inverse)(wrap) : wrap ;
}
INLINE WRAPTYPE get_edge_wrap(e_id)
edge_id e_id;
{
WRAPTYPE wrap = *EINT(e_id,E_WRAP_ATTR) ;
return ( inverted(e_id) ? (*sym_inverse)(wrap) : wrap );
}
INLINE void set_edge_fe(e_id,fe)
edge_id e_id;
facetedge_id fe;
{
if ( inverted(e_id) ) invert(fe);
eptr(e_id)->fe_id = fe;
top_timestamp = ++global_timestamp;
}
INLINE facetedge_id get_edge_fe(e_id)
edge_id e_id;
{ struct edge *ep;
facetedge_id fe;
ep = eptr(e_id);
if ( !ep ) return NULLID;
fe = ep->fe_id;
if ( inverted(e_id) ) invert(fe);
return fe;
}
INLINE vertex_id get_edge_tailv(e_id)
edge_id e_id;
{
if ( inverted(e_id) )
return get_edge_vertices(e_id)[web.headvnum];
else
return get_edge_vertices(e_id)[0];
}
INLINE vertex_id get_edge_headv(e_id)
edge_id e_id;
{
if ( inverted(e_id) )
return get_edge_vertices(e_id)[0];
else
return get_edge_vertices(e_id)[web.headvnum];
}
INLINE void set_edge_tailv(e_id,v_id)
edge_id e_id;
vertex_id v_id;
{ vertex_id oldv;
/* make sure edge not in loop of old vertex */
oldv = get_edge_tailv(e_id);
if ( valid_id(oldv) && !equal_id(oldv,v_id) )
remove_vertex_edge(oldv,e_id);
if ( inverted(e_id) )
get_edge_vertices(e_id)[web.headvnum] = v_id;
else
get_edge_vertices(e_id)[0] = v_id;
insert_vertex_edge(v_id,e_id);
top_timestamp = ++global_timestamp;
}
INLINE void set_edge_headv(e_id,v_id)
edge_id e_id;
vertex_id v_id;
{
if ( inverted(e_id) )
get_edge_vertices(e_id)[0] = v_id;
else
get_edge_vertices(e_id)[web.headvnum] = v_id;
insert_vertex_edge(v_id,inverse_id(e_id));
top_timestamp = ++global_timestamp;
}
INLINE void set_edge_midv(e_id,v_id)
edge_id e_id;
vertex_id v_id;
{ get_edge_vertices(e_id)[2] = v_id;
set_vertex_edge(v_id,e_id);
set_attr(v_id,Q_MIDPOINT);
top_timestamp = ++global_timestamp;
}
INLINE body_id get_facet_body(f_id)
facet_id f_id;
{
if ( web.skel[BODY].count == 0 ) return NULLID;
if ( !valid_id(f_id) ) return NULLID;
if ( inverted(f_id) ) return F_ELID(f_id,F_BODY_LIST_ATTR)[1];
else return F_ELID(f_id,F_BODY_LIST_ATTR)[0];
}
INLINE facetedge_id get_facet_fe(f_id)
facet_id f_id;
{
facetedge_id fe;
if ( !valid_id(f_id) ) return NULLID;
fe = fptr(f_id)->fe_id;
if ( inverted(f_id) ) invert(fe);
return fe;
}
INLINE edge_id get_next_tail_edge(e_id) edge_id e_id;
{ return eptr(e_id)->next_vedge[inverted(e_id) ?1: 0] ; }
INLINE edge_id get_next_head_edge(e_id) edge_id e_id;
{ return inverse_id(eptr(e_id)->next_vedge[inverted(e_id) ?0: 1]); }
INLINE void set_next_tail_edge(e_id,ee_id) edge_id e_id,ee_id;
{ eptr(e_id)->next_vedge[inverted(e_id) ?1: 0] = (ee_id); }
INLINE facet_id get_body_facet(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->f_id : NULLID ); }
INLINE facetedge_id get_body_fe(b_id) body_id b_id;
{ facet_id f_id = valid_id(b_id) ? bptr(b_id)->f_id : NULLID ;
return valid_id(f_id) ? get_facet_fe(f_id) : NULLID;
}
INLINE facetedge_id get_vertex_fe(v_id) vertex_id v_id;
{ edge_id xx_id=vptr(v_id)->e_id;
return valid_id(xx_id)?same_sign(eptr(xx_id)->fe_id,xx_id):NULLID;
}
INLINE void set_body_facet(b_id,f_id) body_id b_id; facet_id f_id;
{ if ( valid_id(b_id) ) bptr(b_id)->f_id = (f_id); }
INLINE REAL get_body_density(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->density : 0.0 ) ; }
INLINE REAL get_body_volume(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->volume : 0.0 ) ; }
INLINE REAL get_body_fixvol(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->fixvol : 0.0 ) ; }
INLINE REAL get_body_abstotal(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->abstotal : 0.0 ) ; }
INLINE REAL get_body_pressure(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->pressure : 0.0 ) ; }
INLINE REAL get_body_volconst(b_id) body_id b_id;
{ return ( valid_id(b_id) ? bptr(b_id)->volconst : 0.0 ) ; }
INLINE void set_body_density(b_id,v) body_id b_id; REAL v;
{ ( valid_id(b_id) ? bptr(b_id)->density = (v) : 0.0 ) ; }
INLINE void set_body_pressure(b_id,v) body_id b_id; REAL v;
{ ( valid_id(b_id) ? bptr(b_id)->pressure = (v) : 0.0 ) ; }
INLINE void set_body_volconst(b_id,v) body_id b_id; REAL v;
{ if ( !valid_id(b_id) ) return;
bptr(b_id)->volconst = v;
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(b_id));
q->volconst = v;
}
}
/*************************************************************************
*
* function: get_extra()
*
* purpose: return pointer to value of extra attribute of an element.
*/
INLINE char *get_extra(id,n)
element_id id;
int n; /* number of extra attribute */
{ int type = id_type(id);
return ( (char*)elptr(id) + EXTRAS(type)[n].offset);
}
/*************************************************************************
*
* function: get_extra_ptr()
*
* purpose: return pointer to value of extra attribute of an element.
*/
INLINE char *get_extra_ptr(id,ext)
element_id id;
struct extra *ext; /* extra attribute defining structure */
{
return ( (char*)elptr(id) + ext->offset);
}
/***********************************************************************
*
* function: get_meth_offset()
*
* purpose: return offset of method instance list in element structure.
*/
INLINE int get_meth_offset(type)
int type; /* of element */
{ int meth_offset;
meth_offset = EXTRAS(type)[web.meth_attr[type]].offset;
return meth_offset;
}
#endif
evolver-2.30c.dfsg/src/query.c 0000644 0001753 0001753 00000042041 11410765113 016527 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************
*
* File: query.c
*
* Contents: query interpreter for Surface Evolver
*/
#include "include.h"
#include "ytab.h"
int commandverb;
/***********************************************************************
History mechanism.
Command texts are stored in linear array history_space[], separated by
nulls, most recent first. history_offsets[] contains indices of starts
of commands, -1 for no command.
history_number is permanent counter of commands.
history_count is number of currently saved commands.
**************************************************************************/
/**************************************************************************
*
* function: new_history()
*
* purpose: Appends command to history list, queue fashion.
*/
void new_history ARGS1((text),
char *text)
{ size_t length;
int k;
if ( history_space == NULL )
{ history_space = my_list_calloc(HISTORYSPACE,1,ETERNAL_BLOCK);
for ( k = 0 ; k < MAXHISTORY ; k++ ) history_offsets[k] = -1; /* empty */
history_count = 0;
}
length = strlen(text)+1;
if ( length >= HISTORYSPACE-5 )
{ kb_error(1585,"Command too long to save in history list.\n",WARNING);
return;
}
kb_memmove(history_space+length,history_space,HISTORYSPACE-length);
for ( k = history_count-1 ; k >= 0 ; k-- )
{ /* adjust pointers in history list */
history_offsets[k+1] = history_offsets[k] + (int)length;
if ( history_offsets[k+1] >= HISTORYSPACE )
{ history_offsets[k+1] = -1; history_count--; }
}
strcpy(history_space,text);
history_offsets[0] = 0;
if ( history_count < MAXHISTORY-1 ) history_count++;
history_number++;
}
/**************************************************************************
*
* function: old_history()
*
* purpose: Checks commands beginning with ! for history list match.
* return: retval from command()
*/
int old_history ARGS1((text),
char *text)
{ char *h;
int k;
int hnum;
int retval = 0;
if ( history_space == NULL )
{ history_space = my_list_calloc(HISTORYSPACE,1,ETERNAL_BLOCK);
for ( k = 0 ; k < MAXHISTORY ; k++ ) history_offsets[k] = -1; /* empty */
history_count = 0;
}
if (text[1] == '!' )
{
if ( history_count > 0 )
{ k = 0; goto do_old;
}
else { kb_error(1586,"History list is empty.\n",WARNING); return retval; }
}
else if ( isdigit(text[1]) )
{ hnum = atoi(text+1);
k = history_number - hnum;
if ( (k >= 0) && (k < history_count) )
goto do_old;
else kb_error(1587,"Command not in history list.\n",RECOVERABLE);
}
else for ( k = 0 ; k < history_count ; k++ )
{ h = history_space+history_offsets[k];
if ( strlen(h) < strlen(text+1) ) continue; /* prevent compare overrun */
if ( strncmp(h,text+1,strlen(text+1)) == 0 )
goto do_old;
}
kb_error(1588,"Command not found in history.\n",RECOVERABLE);
do_old:
h = history_space + history_offsets[k];
outstring(h);outstring("\n");
retval = command(h,ADD_TO_HISTORY); /* reinserts fulltext copy in history list */
return retval;
}
/**************************************************************************
*
* function: catfulltext()
*
* purpose: catenates line to full text of command
*/
void catfulltext ARGS1((stuff),
char *stuff)
{
if ( fulltextsize > MAXCMDSIZE-3 ) return; /* too long */
if ( fulltextsize > 0 )
{ strcat(fulltext," "); /* indentation */
fulltextsize += 2;
}
strncpy(fulltext+fulltextsize,stuff,MAXCMDSIZE-fulltextsize);
fulltextsize = strlen(fulltext);
if ( fulltext[fulltextsize-1] != '\n' ) fulltext[fulltextsize++] = '\n';
fulltext[fulltextsize] = '\0';
}
/**************************************************************************
*
* function: command()
*
* purpose: Executes a text command string.
*
* return: END_COMMANDS if current command interpreter loop is to end.
* 0 else
*/
int command ARGS2((text,mode),
char *text,
int mode) /* NO_HISTORY or ADD_TO_HISTORY */
{
struct expnode qnode; /* for query expression */
int retval = 0;
int old_scope;
struct treenode *old_list;
int old_listtop, old_listmax;
int old_brace_depth = brace_depth;
memset(&qnode,0,sizeof(struct expnode));
sprintf(qnode.name,"command");
old_listmax = listmax;
old_list = list; old_listtop = listtop; /* for nested parsing */
listmax = 30;
list = (struct treenode *)mycalloc(listmax,sizeof(struct treenode));
list[1].type = SETUP_FRAME_;
listtop = 2;
loopdepth = 0;
parse_error_flag = 0;
lists_flag = 0;
cmdptr = text;
old_scope = begin_scope();
#ifdef __cplusplus
try
{
#else
if ( setjmp(cmdbuf) )
{ set_scope(old_scope);
cmdptr = NULL;
myfree((char *)list);
list = NULL;
memset(local_scope_bases,0,sizeof(local_scope_bases));
local_nest_depth = 0;
return 0;
}
#endif
verb_flag = 1; /* tell lex we need a verb first */
old_global_count = web.global_count; /* for error recovery */
old_perm_global_count = web.perm_global_count; /* for error recovery */
/* local_nest_depth = 0; */
init_local_scope(0);
fulltextsize = 0;
catfulltext(text);
retval = yybegin(); /* 0 for accept, 1 for error */
qnode.locals = localbase;
if ( localbase )
qnode.locals->flags |= LL_IN_USE;
exit_local_scope();
cmdptr = NULL;
if ( (retval == 1) || (parse_error_flag) )
{ myfree((char *)list);
if ( list == permlist ) permlist = NULL;
list = NULL; set_scope(old_scope);
return 0;
}
qnode.start=list;
qnode.root = list + listtop - 1;
if ( qnode.root->type == SETUP_FRAME_ ) /* empty command */
{ retval = 0;
goto command_exit;
}
if ( qnode.root->type != CMDLIST_ ) /* expression or something */
kb_error(1589,"Illegal command.\n",COMMAND_ERROR);
list[0] = list[listtop-1]; /* root also in first spot */
if ( list[0].left ) list[0].left += listtop - 1;
if ( list[0].right ) list[0].right += listtop - 1;
/* put DONE marker after root */
list[listtop++].type = FINISHED;
/* figure stack usage */
stack_usage(&qnode);
/* set element loop flag bit in nodes */
if ( !function_kludge_flag )
mark_element_loops(&list[0],0);
if ( logfd )
fprintf(logfd,"%s\n",text);
/* add to history list */
if ( mode == ADD_TO_HISTORY )
new_history(fulltext);
/* initialize current element to NULLID */
aggregate_depth = 0; calc_quant_flag = 0;
exit_flag = 0;
eval(&qnode,NULL,NULLID,NULL);
retval = exit_flag ? END_COMMANDS : 1;
exit_flag = 0;
command_exit:
qnode.flag = USERCOPY; /* so free_expr will work */
free_expr(&qnode);
list = NULL;
set_scope(old_scope);
list = old_list; listtop = old_listtop; /* for nested parsing */
listmax = old_listmax;
brace_depth = old_brace_depth;
return retval;
#ifdef __cplusplus
}
catch(cmd_excep c)
{ set_scope(old_scope);
cmdptr = NULL;
myfree((char *)list);
list = NULL;
memset(local_scope_bases,0,sizeof(local_scope_bases));
local_nest_depth = 0;
return 0;
}
#endif
}
/*************************************************************************
*
* function: stack_usage()
*
* purpose: figure maximum stack usage of expression or command.
*
*/
void stack_usage ARGS1((ex ),
struct expnode *ex)
{ int usage = 0;
struct treenode *node ;
#ifdef _DEBUG
int didwarn = 0;
#endif
ex->stack_max = 0;
for ( node = ex->start+1 ; node->type != FINISHED ; node++ )
{ usage += node->stack_delta;
if ( usage > ex->stack_max ) ex->stack_max = usage;
#ifdef _DEBUG
if ( (usage < 0) && (!didwarn) )
{ sprintf(errmsg,"Internal error: stack usage negative, node type %d.\n",
node->type);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2670,errmsg,WARNING);
didwarn = 1;
}
node->stack_spot = usage;
#endif
}
}
/***********************************************************************
*
* Function: mark_element_loops()
*
* Purpose: Mark flags of expression nodes that are within
* element loops, so can know when freeing discards is
* ill-advised. Recursively transverses tree pre-order.
*/
void mark_element_loops(root,mark)
struct treenode *root;
int mark; /* whether root in loop */
{ if ( mark )
root->flags |= IN_ELEMENT_LOOP;
else mark = root->flags & IN_ELEMENT_LOOP;
if ( root->left )
mark_element_loops(root+root->left,mark);
if ( root->right )
mark_element_loops(root+root->right,mark);
}
/************************************************************************
*
* function: print_profiling()
*
* purpose: Print profiling elapsed times. Prints comma form of clock
8 counts.
*/
void commaize(s) /* put commas in integers at end of string */
char *s;
{ int n,k,groups,j;
k = strlen(s);
while ( k > 0 )
{
/* find last digit */
for ( n = k; n > 0 ; n-- )
if ( isdigit(s[n]) ) break;
if ( !isdigit(s[n]) ) return;
/* find first digit */
for ( k = n-1 ; k > 0 ; k-- )
if ( !isdigit(s[k]) ) break;
groups = (n-k-1)/3;
for ( j = k+1 ; j < n ; j++ )
{ s[j-groups] = s[j];
if ( ((n-j+groups) % 4) == 0 )
{ groups--;
s[j-groups] = ',';
}
}
}
}
void print_profiling()
{
#ifdef PROF_EVALS
int i,k;
int do_flag = 0;
outstring("\nInclusive profiling counts: \n");
outstring(" Name CPU Cycles\n");
for ( i = 0 ; i < web.global_count ; i++ )
{
if ( globals(i)->flags & (FUNCTION_NAME|PROCEDURE_NAME|SUBROUTINE) )
{
sprintf(msg," %30s %15.f\n",globals(i)->name,
globals(i)->value.proc.elapsed_time);
commaize(msg);
outstring(msg);
}
}
for ( i = 0, do_flag = 0; i < NUMELEMENTS ; i++ )
if ( show_expr_table[i].root )
do_flag = 1;
if ( do_flag )
{
outstring("\nElement show expressions:\n");
outstring(" Element CPU Cycles\n");
for ( i = 0 ; i < NUMELEMENTS ; i++ )
{ sprintf(msg," %30s %15.f\n",typenames[i],show_expr_table[i].elapsed_time);
commaize(msg);
outstring(msg);
}
}
for ( i = LOW_INST, do_flag = 0 ; i < meth_inst_count ; i++ )
if ( METH_INSTANCE(i)->expr[0] )
do_flag = 1;
if ( do_flag )
{
outstring("\nMethod instance expressions:\n");
outstring(" Method instance CPU Cycles\n");
for ( i = LOW_INST; i < meth_inst_count ; i++ )
{ REAL total_time = 0.0;
struct method_instance *mi = METH_INSTANCE(i);
for ( k = 0 ; k < MAXMEXPR ; k++ )
if ( mi->expr[k] )
total_time += mi->expr[k]->elapsed_time;
else break;
sprintf(msg," %40s %15.f\n",mi->name,total_time);
commaize(msg);
outstring(msg);
}
}
for ( i = 0, do_flag = 0 ; i < web.bdrymax ; i++ )
if ( web.boundaries[i].coordf[0] )
do_flag = 1;
if ( do_flag )
{
outstring("\nBoundary expressions:\n");
outstring(" Boundary Formula Cycles Energy Cycles Content Cycles\n");
for ( i = 0 ; i < web.bdrymax ; i++ )
{ REAL coord_time = 0.0;
REAL energy_time = 0.0;
REAL content_time = 0.0;
struct boundary *b = web.boundaries + i;
if ( !b->coordf[0] )
continue;
for ( k = 0 ; k < SDIM ; k++ )
{ if ( b->coordf[k] )
coord_time += b->coordf[k]->elapsed_time;
if ( b->envect[k] )
energy_time += b->envect[k]->elapsed_time;
if ( b->convect[k] )
content_time += b->convect[k]->elapsed_time;
}
sprintf(msg,"%30s %15.f %15.f %15.f\n",b->name,coord_time,energy_time,content_time);
commaize(msg);
outstring(msg);
}
}
for ( i = 0, do_flag = 0 ; i < web.maxcon ; i++ )
if ( get_constraint(i)->formula )
do_flag = 1;
if ( do_flag )
{
outstring("\nConstraint expressions\n");
outstring(" Constraint Formula Cycles Energy Cycles Content Cycles\n");
for ( i = 0 ; i < web.maxcon ; i++ )
{ struct constraint *con = get_constraint(i);
REAL coord_time = 0.0;
REAL energy_time = 0.0;
REAL content_time = 0.0;
if ( !con->formula )
continue;
for ( k = 0 ; k < SDIM ; k++ )
{ if ( con->formula )
coord_time += con->formula->elapsed_time;
if ( con->envect[k] )
energy_time += con->envect[k]->elapsed_time;
if ( con->convect[k] )
content_time += con->convect[k]->elapsed_time;
}
sprintf(msg,"%30s %15.f %15.f %15.f\n",con->name,coord_time,energy_time,content_time);
commaize(msg);
outstring(msg);
}
}
#else
outstring("Evaluation profiling not enabled; compile with PROF_EVALS.\n");
#endif
}
/************************************************************************
*
* function: reset_profiling()
*
* purpose: Reset profiling elapsed times.
*/
void reset_profiling()
{ int i,k;
for ( i = 0 ; i < web.global_count ; i++ )
{
if ( globals(i)->flags & (FUNCTION_NAME|PROCEDURE_NAME|SUBROUTINE) )
globals(i)->value.proc.elapsed_time = 0.0;
}
for ( i = 0 ; i < NUMELEMENTS ; i++ )
{ show_expr_table[i].elapsed_time = 0.0;
}
for ( i = LOW_INST; i < meth_inst_count ; i++ )
{
struct method_instance *mi = METH_INSTANCE(i);
for ( k = 0 ; k < MAXMEXPR ; k++ )
if ( mi->expr[k] )
mi->expr[k]->elapsed_time = 0.0;
else break;
}
for ( i = 0 ; i < web.bdrymax ; i++ )
{
struct boundary *b = web.boundaries + i;
if ( !b->coordf[0] )
continue;
for ( k = 0 ; k < SDIM ; k++ )
{ b->coordf[k]->elapsed_time = 0.0;
b->envect[k]->elapsed_time = 0.0;
b->convect[k]->elapsed_time = 0.0;
}
}
for ( i = 0 ; i < web.maxcon ; i++ )
{ struct constraint *con = get_constraint(i);
if ( !con->formula )
continue;
for ( k = 0 ; k < SDIM ; k++ )
{ con->formula->elapsed_time = 0.0;
con->envect[k]->elapsed_time = 0.0;
con->convect[k]->elapsed_time = 0.0;
}
}
}
/***************************************************************************
*
* function: mark_recalc_params()
*
* purpose: Traverse quantities and expressions and things and find
* variables whose change should cause a recalc().
*/
void mark_recalc_params()
{
int n,i,k,j;
/* Clear old recalc flags */
for ( n = 0 ; n < web.global_count ; n++ )
{ struct global *g = globals(n);
if ( g->flags & ALWAYS_RECALC )
g->flags |= RECALC_PARAMETER;
else
g->flags &= ~RECALC_PARAMETER;
}
/* Go through all expressions attached to various things. */
if ( torus_period_expr[0][0].root )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ mark_recalc_expr(&torus_period_expr[i][j]);
mark_recalc_expr(&torus_display_period_expr[i][j]);
}
if ( mobility_flag ) mark_recalc_expr(&mobility_formula);
if ( mobility_tensor_flag )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
mark_recalc_expr(&torus_period_expr[i][j]);
if ( web.metric_flag )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
mark_recalc_expr(&web.metric[i][j]);
for ( i = 0 ; i < NUMELEMENTS ; i++ )
mark_recalc_expr(show_expr[i]);
for ( i = 0 ; i < web.bdrymax ; i++ )
{ struct boundary *b = web.boundaries + i;
if ( !(b->attr & IN_USE) ) continue;
if ( b->attr & CON_ENERGY )
for ( j = 0 ; j < SDIM ; j++ )
{ mark_recalc_expr(b->coordf[j]);
mark_recalc_expr(b->envect[j]);
mark_recalc_expr(b->convect[j]);
}
}
for ( i = 0 ; i < web.maxcon ; i++ )
{ struct constraint *con = get_constraint(i);
if ( !(con->attr & IN_USE) ) continue;
if ( con->attr & CON_ENERGY )
{ mark_recalc_expr(con->formula);
for ( j = 0 ; j < SDIM ; j++ )
{ mark_recalc_expr(con->envect[j]);
mark_recalc_expr(con->convect[j]);
}
}
}
for ( k = LOW_INST ; k < meth_inst_count ; k++ )
{ struct method_instance * mi = METH_INSTANCE(k); /* since some init may move things */
struct gen_quant *q;
if ( mi->quant >= 0 ) q = GEN_QUANT(mi->quant);
else continue;
if ( !(q->flags & Q_ENERGY) ) continue;
for ( i = 0 ; i < MAXMEXPR ; i++ )
mark_recalc_expr(mi->expr[i]);
}
} /* end mark_recalc_params() */
/*************************************************************************
*
* function: mark_recalc_expr()
*
* purpose: Mark the functions and variables in an expression known
* to cause recalc.
*
* return: how many new ones marked
*/
int mark_recalc_expr(ex)
struct expnode *ex;
{ int count = 0 ;
struct treenode *node;
if ( ex == NULL ) return 0;
if ( ex->start == NULL ) return 0;
for ( node = ex->start ; node != ex->root ; node ++ )
if ( node->type == PUSHGLOBAL_ )
{ struct global *g;
if ( (node->op1.name_id &(~GLOBMASK))==LOCALVAR )
continue;
g = globals(node->op1.name_id);
if ( g->flags & RECALC_PARAMETER )
continue;
g->flags |= RECALC_PARAMETER;
count ++;
}
return count;
} /* end mark_recalc_expr() */
evolver-2.30c.dfsg/src/lex.h 0000644 0001753 0001753 00000001671 11410765113 016163 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/************************************************************
*
* File: lex.h
*
* Contents: Definitions for lexical analyzer for reading
* data files.
*/
#ifndef _LEX_H_
#define _LEX_H_
/* Data type for yylval and parse semantics stack. */
typedef struct { int i; /* standard integer yylval */
int qnum;
REAL r;
int etype; /* element type */
int datatype; /* expression datatype */
struct sym *symptr; /* iteration variable names */
char lexeme[32]; /* for identifiers */
} yystype;
#define YYSTYPE yystype
extern YYSTYPE yylval; /* parser terminal value */
#endif
evolver-2.30c.dfsg/src/hessian3.c 0000644 0001753 0001753 00000165243 11410765113 017111 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* file: hessian3.c
*
* Contents: hessian related routines.
* Old hessian calculators.
* Some YSMP drivers.
* Metric setup routines.
*/
#include "include.h"
/********************************************************************
*
* function: area_hessian()
*
* purpose: fill in hessian matrix with area derivatives
* also does volume constraints
*
*/
void area_hessian(S,rhs)
struct linsys *S;
REAL *rhs;
{
int i,j,k;
facet_id f_id;
MAT2D(self2,MAXCOORD,MAXCOORD);
MAT2D(otherD,MAXCOORD,MAXCOORD);
/* fill in sparse matrix rows and volume constraint rows */
FOR_ALL_FACETS(f_id)
{
REAL side[FACET_EDGES][MAXCOORD]; /* 3 sides of facet */
REAL ss[FACET_EDGES]; /* squares of sides */
REAL sd[FACET_EDGES]; /* dot of side with next side */
facetedge_id fe_id;
struct hess_verlist *v[FACET_VERTS];
REAL two_area; /* twice area of facet */
REAL first[FACET_VERTS][MAXCOORD]; /* first partials */
REAL density = get_facet_density(f_id);
vertex_id v_id[FACET_VERTS];
if ( density == 0.0 ) continue;
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ v_id[i] = get_fe_tailv(fe_id);
v[i] = get_vertex_vhead(v_id[i]);
get_fe_side(fe_id,side[i]);
fe_id = get_next_edge(fe_id);
}
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ ss[i] = SDIM_dot(side[i],side[i]);
sd[i] = -SDIM_dot(side[(i+1)%FACET_EDGES],side[(i+2)%FACET_EDGES]);
}
two_area = sqrt(ss[1]*ss[2] - sd[0]*sd[0]);
/* first derivatives of area */
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
int ii,jj;
REAL grad[MAXCOORD];
if ( v[i]->freedom <= 0 ) continue;
ii = (i+2)%FACET_EDGES; /* side previous vertex i */
jj = (i+1)%FACET_EDGES; /* side opposite vertex i, next vertex */
for ( k = 0 ; k < SDIM ; k++ )
{ first[i][k] = (side[ii][k]*ss[jj] - sd[i]*(-side[jj][k]))/2/two_area;
grad[k] = density*first[i][k];
}
fill_grad(S,v[i],grad,rhs);
}
/* second derivatives */
if ( hess_flag )
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ REAL self,other;
int ii,jj;
if ( v[i]->freedom <= 0 ) continue;
ii = (i+2)%FACET_EDGES; /* side previous vertex i */
jj = (i+1)%FACET_EDGES; /* side opposite vertex i, next vertex */
/* for now, all degrees of freedom are coordinate */
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
{ self = -(side[jj][j]*side[jj][k])/2;
if ( j == k ) self += ss[jj]/2;
self2[j][k] =
density*(self - 2*first[i][j]*first[i][k])/two_area;
if ( v[jj]->freedom <= 0 ) continue;
other = -side[ii][j]*side[jj][k] - side[jj][j]*(-side[ii][k])/2;
if ( j == k ) other -= sd[i]/2;
otherD[j][k] =
density*(other - 2*first[i][j]*first[jj][k])/two_area;
}
fill_self_entry(S,v_id[i],self2);
if ( v[jj]->freedom > 0 )
fill_mixed_entry(S,v_id[i],v_id[jj],otherD);
}
}
} /* end area_hessian() */
/********************************************************************
*
* function: edge_energy_hessian()
*
* purpose: edge constraint hessian
*
*/
void edge_energy_hessian(S,rhs)
struct linsys *S;
REAL *rhs;
{ int i,j;
int head,tail;
edge_id e_id;
MAT2D(first,2,MAXCOORD);
MAT4D(second,2,2,MAXCOORD,MAXCOORD);
/* do edges */
FOR_ALL_EDGES(e_id)
{
struct hess_verlist *v[MAXCOORD];
vertex_id *v_id = get_edge_vertices(e_id);
if ( ! get_e_constraint_map(e_id)[0] ) continue;
for ( i = 0 ; i < 2 ; i++ )
v[i] = get_vertex_vhead(v_id[i]);
memset((char*)first[0],0,sizeof(REAL)*2*MAXCOORD);
memset((char*)second[0][0][0],0,sizeof(REAL)*2*2*MAXCOORD*MAXCOORD);
edge_constr_hessian(S,e_id,first,second);
/* first derivatives on right hand side */
for ( i = 0 ; i < 2 ; i++ )
fill_grad(S,v[i],first[i],rhs);
/* second derivatives */
if ( hess_flag )
for ( i = 0 ; i < 2 ; i++ )
for ( j = i ; j < 2 ; j++ )
{
if ( (v[i]->freedom==0) || (v[j]->freedom==0) ) continue;
if ( loc_ordinal(v_id[i]) > loc_ordinal(v_id[j]) )
{ tail = i; head = j; }
else { tail = j; head = i; }
fill_mixed_entry(S,v_id[tail],v_id[head],second[tail][head]);
}
}
} /* end edge_energy_hessian() */
/********************************************************************
*
* function: edge_constr_hessian()
*
* purpose: fill in hessian matrix for constraint energy of one edge
*
*/
void edge_constr_hessian(S,e_id,first,second)
struct linsys *S;
edge_id e_id;
REAL **first;
REAL ****second;
{
REAL *tcoord,*hcoord;
struct constraint *constr;
int i,m;
REAL side[MAXCOORD];
REAL green[MAXCOORD];
REAL green_deriv_space[MAXCOORD][MAXCOORD];
REAL *green_deriv[MAXCOORD];
int j,sign;
conmap_t *conmap;
REAL midpt[MAXCOORD];
REAL grad[MAXCOORD];
conmap = get_e_constraint_map(e_id);
if ( !conmap[0] ) return;
if ( get_eattr(e_id) & NEGBOUNDARY ) sign = -1;
else sign = 1;
if ( inverted(e_id) ) sign = -sign;
tcoord = get_coord(get_edge_tailv(e_id));
hcoord = get_coord(get_edge_headv(e_id));
for ( j = 0 ; j < SDIM ; j++ )
{
side[j] = hcoord[j] - tcoord[j];
green_deriv[j] = green_deriv_space[j];
}
for ( j = 1 ; j <= (int)conmap[0] ; j++ )
{
constr = get_constraint(conmap[j]);
if ( !(constr->attr & CON_ENERGY)
|| (constr->compcount != SDIM) ) continue;
for ( m = 0 ; m < gauss1D_num ; m++ )
{
for ( i = 0 ; i < SDIM ; i++ )
midpt[i] = gauss1Dpt[m]*hcoord[i] + (1 - gauss1Dpt[m])*tcoord[i];
for ( i = 0 ; i < SDIM ; i++ )
eval_all(constr->envect[i],midpt,SDIM,&green[i],green_deriv[i],e_id);
vec_mat_mul(side,green_deriv,grad,SDIM,SDIM);
for ( i = 0 ; i < SDIM ; i++ )
{ int jj;
first[0][i] += sign*gauss1Dwt[m]*((1-gauss1Dpt[m])*grad[i]-green[i]);
first[1][i] += sign*gauss1Dwt[m]*(gauss1Dpt[m]*grad[i] + green[i]);
if ( hess_flag )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ second[0][0][i][jj] -= sign*gauss1Dwt[m]*
(green_deriv[i][jj]+green_deriv[jj][i])*(1-gauss1Dpt[m]);
second[0][1][i][jj] += sign*gauss1Dwt[m]*
(-green_deriv[i][jj]*(1-gauss1Dpt[m])
+ green_deriv[jj][i]*gauss1Dpt[m]);
second[1][0][i][jj] += sign*gauss1Dwt[m]*
(-green_deriv[jj][i]*(1-gauss1Dpt[m])
+ green_deriv[i][jj]*gauss1Dpt[m]);
second[1][1][i][jj] += sign*gauss1Dwt[m]*
(green_deriv[i][jj]+green_deriv[jj][i])*gauss1Dpt[m];
}
}
}
}
} /* end edge_constr_hessian() */
/********************************************************************
*
* function: body_hessian()
*
* purpose: fill in hessian matrix with body volume constraints
*
* return: number of bodies that have volume constraints
*/
int body_hessian(S,rhs)
struct linsys *S;
REAL *rhs;
{
int i,j;
int count = 0;
facet_id f_id;
body_id b_id;
REAL *Z;
REAL coe;
MAT2D(otherD,MAXCOORD,MAXCOORD);
MAT2D(self,MAXCOORD,MAXCOORD);
REAL zsum,ssum;
Z = (REAL *)temp_calloc(web.skel[BODY].max_ord+1,sizeof(REAL));
FOR_ALL_BODIES(b_id)
if ( get_battr(b_id) & FIXEDVOL )
Z[loc_ordinal(b_id)] = get_body_pressure(b_id);
/* Z is vector of coefficients for adding constraint hessians */
if ( hess_debug )
{ printf("Z vector: \n");
for ( i = 0 ; i < web.skel[BODY].max_ord+1 ; i++ )
printf("%d %g\n",i,(DOUBLE)Z[i]);
}
/* rhs for body constraint rows */
if ( rhs_flag && !everything_quantities_flag )
FOR_ALL_BODIES(b_id)
{ REAL *current = rhs + S->bodyrowstart + loc_ordinal(b_id);
if ( get_battr(b_id) & FIXEDVOL )
*current = -(get_body_fixvol(b_id) - get_body_volume(b_id));
}
/* body volume constraints, linear part */
FOR_ALL_FACETS(f_id)
{
REAL side[FACET_EDGES][MAXCOORD]; /* 3 sides of facet */
facetedge_id fe_id;
struct hess_verlist *v[FACET_VERTS];
REAL *x[FACET_VERTS]; /* for volume calculation */
body_id bb_id;
int do_b, do_bb; /* flags for whether bodies fixed */
int a;
if ( get_attr(f_id) & NONCONTENT ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ a = get_battr(b_id);
do_b = (a & FIXEDVOL) && !(a & REDUNDANT_BIT);
} else do_b = 0;
bb_id = get_facet_body(inverse_id(f_id));
if ( valid_id(bb_id) )
{ a = get_battr(bb_id);
do_bb = (a & FIXEDVOL) && !(a & REDUNDANT_BIT);
} else do_bb = 0;
if ( !do_b && !do_bb ) continue;
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ v[i] = get_vertex_vhead(get_fe_tailv(fe_id));
x[i] = get_coord(get_fe_tailv(fe_id));
get_fe_side(fe_id,side[i]);
fe_id = get_next_edge(fe_id);
}
coe = 0.0;
if ( valid_id(b_id) )
coe += Z[loc_ordinal(b_id)];
if ( valid_id(bb_id) )
coe -= Z[loc_ordinal(bb_id)];
zsum = (x[0][2]+x[1][2]+x[2][2]);
ssum = side[0][0]*side[1][1] - side[0][1]*side[1][0];
for ( i = 0 ; i < FACET_VERTS ; i++ )
{
int currentrow;
REAL g[MAXCOORD],gg[MAXCOORD],*ggg;
REAL grad[MAXCOORD];
int ii = (i+1)%3;
int iii = (i+2)%3;
if ( web.symmetric_content )
cross_prod(x[ii],x[iii],g);
else
{ g[0] = zsum*(x[ii][1]-x[iii][1]);
g[1] = zsum*(x[iii][0]-x[ii][0]);
g[2] = ssum;
}
for ( j = 0 ; j < SDIM ; j++ )
grad[j] = -coe*g[j]/6;
fill_grad(S,v[i],grad,rhs);
if ( !hess_flag ) continue;
if ( v[i]->proj )
{ vec_mat_mul(g,v[i]->proj,gg,SDIM,v[i]->freedom);
ggg = gg;
}
else ggg = g;
if ( do_b )
{
currentrow = S->bodyrowstart + loc_ordinal(b_id);
for ( j = 0 ; j < v[i]->freedom ; j++ )
{ sp_hash_search(S,v[i]->rownum+j,currentrow,ggg[j]/6);
}
}
if ( do_bb )
{
currentrow = S->bodyrowstart + loc_ordinal(bb_id);
for ( j = 0 ; j < v[i]->freedom ; j++ )
{ sp_hash_search(S,v[i]->rownum+j,currentrow,-ggg[j]/6);
}
}
}
}
/* Now quadratic part */
otherD[0][0] = otherD[1][1] = otherD[2][2] = 0.0;
self[0][0] = self[1][1] = self[2][2] = 0.0;
self[0][1] = self[1][0] = 0.0;
/* now add constraint hessians to energy hessian */
if ( hess_flag )
FOR_ALL_FACETS(f_id)
{
facetedge_id fe_id;
struct hess_verlist *v[FACET_VERTS];
REAL *x[FACET_VERTS]; /* for volume calculation */
vertex_id v_id[FACET_VERTS];
if ( get_attr(f_id) & NONCONTENT ) continue;
coe = 0.0;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
coe += Z[loc_ordinal(b_id)];
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
coe -= Z[loc_ordinal(b_id)];
coe /= 6; /* tetrahedron factor */
if ( coe == 0.0 ) continue;
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ v_id[i] = get_fe_tailv(fe_id);
v[i] = get_vertex_vhead(v_id[i]);
x[i] = get_coord(v_id[i]);
fe_id = get_next_edge(fe_id);
}
zsum = x[0][2] + x[1][2] + x[2][2];
/* second derivatives */
if ( hess_flag )
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii,jj;
jj = (i+1)%FACET_EDGES; /* next vertex */
ii = (i+2)%FACET_EDGES; /* vertex previous vertex i */
if ( v[i]->freedom <= 0 ) continue;
if ( !web.symmetric_content )
{
self[0][2] = self[2][0] = coe*(x[jj][1]-x[ii][1]);
self[1][2] = self[2][1] = coe*(x[ii][0]-x[jj][0]);
fill_self_entry(S,v_id[i],self);
}
if ( v[jj]->freedom <= 0 ) continue;
/* for now, all degrees of freedom are coordinate */
if ( web.symmetric_content )
{ otherD[0][1] = -coe*x[ii][2];
otherD[1][0] = coe*x[ii][2];
otherD[0][2] = coe*x[ii][1];
otherD[2][0] = -coe*x[ii][1];
otherD[2][1] = coe*x[ii][0];
otherD[1][2] = -coe*x[ii][0];
}
else
{ otherD[0][1] = -coe*zsum;
otherD[1][0] = coe*zsum;
otherD[0][2] = -coe*(x[jj][1]-x[ii][1]);
otherD[2][0] = -coe*(x[ii][1]-x[i ][1]);
otherD[1][2] = -coe*(x[ii][0]-x[jj][0]);
otherD[2][1] = -coe*(x[i ][0]-x[ii][0]);
}
fill_mixed_entry(S,v_id[i],v_id[jj],otherD);
}
}
temp_free((char*)Z);
count = 0;
if ( !everything_quantities_flag )
FOR_ALL_BODIES(b_id)
{ if ( get_battr(b_id) & FIXEDVOL )
count++;
}
return count;
} /* end body_hessian() */
/*****************************************************************************/
#include "f2c.h"
/* C declarations of the YSMP routines */
int odrv_ ARGS(( integer *, integer *,integer *,REAL *, integer *,integer *,
integer *,integer *, integer *, integer *));
int sdrvmd_ ARGS(( integer *, integer *,integer *, integer *,integer *,REAL *,
REAL *,REAL *, integer *,integer *,REAL *,integer *,
integer *, integer *, REAL *));
void sdrv_flag_check ARGS((integer , integer , integer ));
void odrv_flag_check ARGS((integer , integer ));
/*************************************************************************
*
* function: ysmp_factor()
*
* purpose: Do YSMP factoring in linear system
*
*/
void ysmp_factor(S)
struct linsys *S;
{ int i,j;
int PATH,FLAG=0,ESP=0;
REAL *RSP,EMAX;
PROF_START(hessian_factor);
/* need just enough at first to do symbolic factorization */
if ( S->NSP == 0 )
{ S->NSP = (4 + (int)(log(S->N+1)))*(S->N + S->IA[S->N]);
S->ISP = (int *)temp_calloc(S->NSP,sizeof(REAL));
}
else memset((char*)S->ISP,0,S->NSP*sizeof(REAL));
if ( S->N == 0 ) return; /* empty hessian */
/* subtract lambda from diagonal */
if ( S->lambda != 0.0 )
for ( i = 0 ; i < S->A_rows ; i++ )
{ for ( j = S->IA[i]-A_OFF ; j < S->IA[i+1]-A_OFF ; j++ )
if ( S->JA[j]-A_OFF == i )
{ S->A[j] -= S->lambda; break; }
}
/* Call ODRV to perform the reordering on A, if not done yet */
if ( !(S->flags & S_ODRV_REORDERED) )
{ PATH = (S->flags & S_ORDERFOUND) ? 3 : 2;
if ( S->P == NULL ) S->P = (int *)temp_calloc(S->N,sizeof(int));
if ( S->IP == NULL ) S->IP = (int *)temp_calloc(S->N,sizeof(int));
odrv_( &S->N, S->IA,S->JA,S->A, S->P,S->IP, &S->NSP,S->ISP,&PATH,&FLAG );
odrv_flag_check(FLAG,S->N);
S->flags |= S_ODRV_REORDERED;
}
/* Call SDRVMD to factor symbolically and numerically */
PATH = 4; /* symbolic factor */
RSP = (REAL *) S->ISP;
sdrvmd_(&S->N,S->P,S->IP,S->IA,S->JA,S->A,NULL,NULL,&S->NSP,
S->ISP,RSP,&ESP, &PATH,&FLAG,&EMAX);
sdrv_flag_check(0,FLAG,S->N);
PATH = 6; /* numeric factor */
if ( !hessian_quiet_flag )
{ if ( ESP < 0 )
sprintf(msg,"YSMP allocation at %p of %d*8 short by %d*8. Expanding.\n",
S->ISP,S->NSP,-ESP);
else
sprintf(msg,"YSMP allocation at %p of %d*8 over by %d*8. Reducing.\n",
S->ISP,S->NSP,ESP);
outstring(msg);
}
S->ISP = (int*)temp_realloc((char*)(S->ISP),
(S->NSP-ESP+10)*sizeof(REAL));
if ( !hessian_quiet_flag )
{ sprintf(msg,"New allocation at %p.\n",S->ISP); outstring(msg); }
S->NSP += -ESP + 10;
RSP = (REAL *) S->ISP;
sdrvmd_(&S->N,S->P,S->IP,S->IA,S->JA,S->A,NULL,NULL,&S->NSP,
S->ISP,RSP,&ESP, &PATH,&FLAG,&EMAX);
sdrv_flag_check(ESP,FLAG,S->N);
S->neg = mat_index;
S->zero = mat_null;
S->pos = S->N - mat_index - mat_null;
/* add lambda back to diagonal */
if ( S->lambda != 0.0 )
for ( i = 0 ; i < S->A_rows ; i++ )
{ for ( j = S->IA[i]-A_OFF ; j < S->IA[i+1]-A_OFF ; j++ )
if ( S->JA[j]-A_OFF == i )
{ S->A[j] += S->lambda; break; }
}
PROF_FINISH(hessian_factor);
} /* end ysmp_factor() */
/*************************************************************************
*
* function: ysmp_solve()
*
* purpose: Do YSMP solve in linear system
*
*/
void ysmp_solve(S,b,x)
struct linsys *S;
REAL *b; /* rhs */
REAL *x; /* solution, may be B */
{ int PATH,FLAG=0,ESP;
REAL *RSP,EMAX;
PROF_START(hessian_factor);
if ( S->N == 0 ) return;
RSP = (REAL *) S->ISP;
PATH = 3; /* solution only */
sdrvmd_(&S->N,S->P,S->IP,S->IA,S->JA,S->A,b,x,&S->NSP,S->ISP,RSP,&ESP,
&PATH,&FLAG,&EMAX);
sdrv_flag_check(ESP,FLAG,S->N);
PROF_FINISH(hessian_factor);
}
/**********************************************************************
*
* function: ysmp_solve_multi()
*
* purpose: solve for multiple right hand sides.
*
*/
void ysmp_solve_multi(S,b,x,rk)
struct linsys *S;
REAL **b; /* rhs */
REAL **x; /* solution, may be B */
int rk; /* number of rhs */
{ int k;
for ( k = 0 ; k < rk ; k++ ) ysmp_solve(S,b[k],x[k]);
}
/**************************************************************************
*
* function: odrv_flag_check()
*
* purpose: check error return from odrv().
*/
void odrv_flag_check(FLAG, N)
integer FLAG,N;
{
if (!FLAG) return;
/* Fatal error */
sprintf(errmsg,"Internal error after ODRV: N = %d FLAG = %d -- ",N,FLAG);
if ( 9*N 1 ) { linear_metric_setup(S,M); return; }
if ( ysmp_flag != MINDEG_FACTORING )
{ ysmp_flag = MINDEG_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func = bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring("Using alternate minimal degree with area normalization.\n");
}
M->N = S->N;
M->flags &= ~ S_ODRV_REORDERED;
Total_entries = S->N; /* pure diagonal */
/* allocate storage for arrays */
M->IA = (int *)temp_calloc(M->N+1,sizeof(int));
M->JA = (int *)temp_calloc(Total_entries,sizeof(int));
M->A = (REAL *)temp_calloc(Total_entries,sizeof(REAL));
if ( M->P == NULL ) M->P = (int *)temp_calloc(M->N,sizeof(int));
if ( M->IP == NULL ) M->IP = (int *)temp_calloc(M->N,sizeof(int));
/* go through, vertex by vertex */
FOR_ALL_VERTICES(v_id)
{
REAL area;
vh = get_vertex_vhead(v_id);
if ( vh->freedom == 0 ) continue;
area = ((web.representation==STRING)?get_vertex_length_star(v_id):
get_vertex_area_star(v_id))/star_fraction;
for ( j = 0, k = vh->rownum ; j < vh->freedom ; j++,k++ )
{ M->IA[k] = M->JA[k] = k + A_OFF;
M->A[k] = area;
M->IP[k] = M->P[k] = k; /* unpermuted */
}
}
for ( i = S->optparamrowstart ; i < S->bodyrowstart ; i++ )
{ /* metric 1 for optimizing parameters */
M->IA[i] = M->JA[i] = i + A_OFF;
M->A[i] = 1.0;
M->IP[i] = M->P[i] = i; /* unpermuted */
}
for ( i = S->bodyrowstart ; i < S->N ; i++ )
{ /* make sure rest of diagonal exists, but no shift */
M->IA[i] = M->JA[i] = i + A_OFF;
M->A[i] = 0.0;
M->IP[i] = M->P[i] = i; /* unpermuted */
}
M->IA[M->N] = M->N + A_OFF;
M->apinv = (REAL *)temp_calloc(M->N,sizeof(REAL));
/* sums of rows */
for ( i = 0 ; i < M->N ; i++ )
{ int start = M->IA[i] - A_OFF;
int end = M->IA[i+1] - A_OFF;
M->apinv[i] = M->A[start];
for ( j = start+1 ; j < end ; j++ )
{ M->apinv[i] += M->A[j];
M->apinv[M->JA[j]] += M->A[j];
}
}
for ( i = 0 ; i < M->N ; i++ )
M->apinv[i] = (M->apinv[i]==0.0) ? 0.0 : 1/M->apinv[i];
} /* end star_metric_setup() */
/************************************************************************
*
* function: linear_metric_setup()
*
* purpose: set up vector-to-form metric sparse matrix for local
* linear interpolation metric.
*/
void linear_metric_setup(S,M)
struct linsys *S; /* hessian to build metric for */
struct linsys *M; /* pointer to empty structure */
{
int i,jj,k,kk,m;
size_t j;
int sum;
edge_id e_id;
vertex_id v_id;
int ti=0,hi=0;
REAL len;
MAT2D(weights,MAXCOORD+1,MAXCOORD+1);
MAT2D(temp_mat,MAXCOORD,MAXCOORD);
REAL **mat;
int col,end;
int ii[MAXCOORD+1];
int dim;
if ( optparamcount > 0 )
kb_error(2444,"Sorry; linear_metric not working with optimizing parameters.\n",RECOVERABLE);
if ( web.modeltype == QUADRATIC )
{ linear_metric_setup_quadratic(S,M); goto apinv_setup; }
if ( web.modeltype == LAGRANGE )
{ linear_metric_setup_lagrange(S,M); goto apinv_setup; }
if ( ysmp_flag != MINDEG_FACTORING )
{ ysmp_flag = MINDEG_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func = bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func = BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring(
"Using alternate minimal degree with linear interpolation metric.\n");
}
M->N = S->N;
M->flags &= ~ S_ODRV_REORDERED;
/* allocate storage for arrays */
M->IA = (int *)temp_calloc(M->N+1,sizeof(int));
if ( M->P == NULL ) M->P = (int *)temp_calloc(M->N,sizeof(int));
if ( M->IP == NULL ) M->IP = (int *)temp_calloc(M->N,sizeof(int));
/* have to count number of higher-ordinal neighbors of each vertex */
if ( web.representation == SIMPLEX )
{ vertex_id *nbrlist;
int nbralloc = 1000;
int nbrcount;
facet_id f_id,start_f;
vertex_id *v;
int m;
nbrlist = (vertex_id *)temp_calloc(nbralloc,sizeof(vertex_id));
FOR_ALL_VERTICES(v_id)
{ struct hess_verlist *vh = get_vertex_vhead(v_id);
i = loc_ordinal(v_id);
nbrcount = 1;
nbrlist[0] = v_id;
f_id = start_f = get_vertex_first_facet(v_id);
do
{ v = get_facet_vertices(f_id);
for ( k = 0 ; k <= web.dimension ; k++ )
if ( loc_ordinal(v[k]) > i )
{ for ( m = 0 ; m < nbrcount ; m++ )
if ( nbrlist[m] == v[k] ) break;
if ( m == nbrcount )
{ if ( nbrcount >= nbralloc )
kb_error(1849,"Too many neighbors in linear_metric_setup()\n",
RECOVERABLE);
nbrlist[nbrcount++] = v[k];
}
}
f_id = get_next_vertex_facet(v_id,f_id);
} while ( !equal_element(f_id,start_f));
/* now count total degrees of freedom */
for ( j = vh->rownum, jj = 0 ; jj < vh->freedom ; jj++,j++ )
M->IA[j] += vh->freedom-jj;
for ( m = 1 ; m < nbrcount ; m++ )
{ struct hess_verlist *vhi = get_vertex_vhead(nbrlist[m]);
for ( j = vh->rownum, jj = 0 ; jj < vh->freedom ; j++,jj++ )
M->IA[j] += vhi->freedom;
}
}
}
else
{ /* fe model */
FOR_ALL_VERTICES(v_id)
{ struct hess_verlist *vh = get_vertex_vhead(v_id);
for ( j = vh->rownum, jj = 0 ; jj < vh->freedom ; jj++,j++ )
M->IA[j] += vh->freedom-jj;
}
FOR_ALL_EDGES(e_id)
{ vertex_id tailv = get_edge_tailv(e_id);
vertex_id headv = get_edge_headv(e_id);
struct hess_verlist *vt = get_vertex_vhead(tailv),*vhtmp;
struct hess_verlist *vh = get_vertex_vhead(headv);
ti = loc_ordinal(tailv);
hi = loc_ordinal(headv);
if ( ti > hi )
{ int tt = ti; ti = hi ; hi = tt;
vhtmp = vh; vh = vt; vt = vhtmp;
}
if ( vh->freedom == 0 ) continue;
for ( j = vt->rownum, jj = 0 ; jj < vt->freedom ; j++,jj++ )
M->IA[j] += vh->freedom;
}
}
for ( i = S->optparamrowstart ; i < S->N ; i++ )
M->IA[i] = 1; /* diagonal elements */
for ( i = 0, sum = 0 ; i < M->N ; i++ ) /* add to running totals */
{ int tmp = sum;
sum += M->IA[i] + optparamcount;
M->IA[i] = tmp + A_OFF;
}
M->IA[M->N] = sum + A_OFF;
/* now can allocate space */
M->JA = (int *)temp_calloc(sum,sizeof(int));
M->A = (REAL *)temp_calloc(sum,sizeof(REAL));
for ( i = 0 ; i < sum ; i++ ) M->JA[i] = -1; /* vacant */
for ( i = 0 ; i < M->N ; i++ )
{ M->JA[M->IA[i]-A_OFF] = i + A_OFF; /* diagonal entry at start */
M->IP[i] = M->P[i] = i; /* unpermuted */
}
/* set up interpolation weight matrix */
for ( i = 0 ; i < optparamcount ; i++ )
M->A[M->IA[S->optparamrowstart+i]-A_OFF] = 1.0;
/* leave rest of diagonal zero in case of augmented hessian */
dim = web.dimension;
for ( i = 0 ; i <= dim ; i++ ) /* index for vertices of element */
for ( m = 0 ; m <= dim ; m++ )
{ if ( i == m )
weights[i][m] = linear_metric_mix*2.0/(dim+1.0)/(dim+2.0)
+ (1.0 - linear_metric_mix)/(dim+1.0);
else weights[i][m] = linear_metric_mix/(dim+1.0)/(dim+2.0);
}
if ( web.representation == STRING )
{ /* edge by edge */
FOR_ALL_EDGES(e_id)
{ struct hess_verlist *vh[2];
vertex_id tailv = get_edge_tailv(e_id);
vertex_id headv = get_edge_headv(e_id);
if ( loc_ordinal(tailv) > loc_ordinal(headv) )
{ vh[0] = get_vertex_vhead(headv);
vh[1] = get_vertex_vhead(tailv);
}
else
{ vh[0] = get_vertex_vhead(tailv);
vh[1] = get_vertex_vhead(headv);
}
len = get_edge_length(e_id);
for ( i = 0 ; i < 2 ; i++ )
{ struct hess_verlist *v = vh[i];
REAL fudge = v->slant*v->slant;
/* self */
if ( v->proj )
{
tr_mat_mul(v->proj,v->proj,temp_mat,SDIM,v->freedom,v->freedom);
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( k = jj ; k < v->freedom ; k++ )
{ col = v->rownum + k + A_OFF;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( m = M->IA[v->rownum+jj]-A_OFF ; m < end ; m++ )
if ( (M->JA[m] < A_OFF) || (M->JA[m] == col) )
{ M->JA[m] = col;
M->A[m] += fudge*(3-linear_metric_mix)*len/6*mat[jj][k];
break;
}
if ( m == end )
kb_error(1851,"Internal error in linear_metric_setup.\n",RECOVERABLE);
}
/* cross terms */
for ( k = i+1 ; k < 2 ; k++ )
{ struct hess_verlist *vv = vh[k];
REAL cfudge = v->slant*vv->slant;
if ( v->proj && vv->proj )
{ tr_mat_mul(v->proj,vv->proj,temp_mat,SDIM,v->freedom,
vv->freedom);
mat = temp_mat;
}
else if ( v->proj )
{ tr_mat_mul(v->proj,identmat,temp_mat,SDIM,v->freedom,
vv->freedom);
mat = temp_mat;
}
else if ( vv->proj ) mat = vv->proj;
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( kk = 0 ; kk < vv->freedom ; kk++ )
{ col = vv->rownum + kk + A_OFF ;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( j = M->IA[v->rownum+jj]+1-A_OFF ; (int)j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += cfudge*mat[jj][kk]*len/6*linear_metric_mix;
break;
}
if ( j == end )
kb_error(1852,"Internal error in linear_metric_setup.\n",RECOVERABLE);
}
}
}
}
}
else
{ facet_id f_id;
REAL area;
/* facet by facet */
FOR_ALL_FACETS(f_id)
{ vertex_id ix[FACET_VERTS];
facetedge_id fe;
REAL density = get_facet_density(f_id);
REAL normal[MAXCOORD];
struct hess_verlist *vh[MAXCOORD+1];
area = get_facet_area(f_id);
if ( density != 0.0 ) area *= density;
if ( hessian_normal_perp_flag )
{ REAL d;
get_facet_normal(f_id,normal);
d = sqrt(SDIM_dot(normal,normal));
for ( i = 0 ; i < SDIM ; i++ ) normal[i] /= d;
}
fe = get_facet_fe(f_id);
ix[0] = get_fe_tailv(fe);
ix[1] = get_fe_headv(fe);
fe = get_next_edge(fe);
ix[2] = get_fe_headv(fe);
for ( i = 0 ; i <= dim ; i++ ) /* bubble sort vertices */
{ j = loc_ordinal(ix[i]);
for ( k = i ; k > 0 ; k-- )
if ( ii[k-1] > (int)j )
{ ii[k] = ii[k-1];
vh[k] = vh[k-1];
}
else break;
ii[k] = (int)j;
vh[k] = get_vertex_vhead(ix[i]);
}
for ( i = 0 ; i <= dim ; i++ )
{ struct hess_verlist *v = vh[i];
REAL fudge = v->slant*v->slant;
/* self */
if ( v->proj )
{
if ( hessian_normal_perp_flag )
{ REAL w[MAXCOORD], *wp=w;
vec_mat_mul(normal,v->proj,w,SDIM,v->freedom);
tr_mat_mul(&wp,&wp,temp_mat,1,v->freedom,v->freedom);
fudge = 1.0;
}
else
{
tr_mat_mul(v->proj,v->proj,temp_mat,SDIM,v->freedom,v->freedom);
}
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( k = jj ; k < v->freedom ; k++ )
{ col = v->rownum + k + A_OFF;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( j = M->IA[v->rownum+jj]-A_OFF ; (int)j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += fudge*weights[i][i]*area*mat[jj][k];
break;
}
if ( j == end )
kb_error(1853,"Internal error in linear_metric_setup.\n",RECOVERABLE);
}
/* cross terms */
for ( k = i+1 ; k <= dim ; k++ )
{ struct hess_verlist *vv = vh[k];
REAL cfudge = v->slant*vv->slant;
if ( v->proj && vv->proj )
{
if ( hessian_normal_perp_flag )
{ REAL w[MAXCOORD],ww[MAXCOORD],*wp=w,*wwp=ww;
vec_mat_mul(normal,v->proj,w,SDIM,v->freedom);
vec_mat_mul(normal,vv->proj,ww,SDIM,vv->freedom);
tr_mat_mul(&wp,&wwp,temp_mat,1,v->freedom,vv->freedom);
cfudge = 1.0;
}
else
tr_mat_mul(v->proj,vv->proj,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( v->proj )
{
if ( hessian_normal_perp_flag )
{ REAL w[MAXCOORD],*wp=w,*np=normal;
vec_mat_mul(normal,v->proj,w,SDIM,v->freedom);
tr_mat_mul(&wp,&np,temp_mat,1,v->freedom,vv->freedom);
cfudge = 1.0;
}
else
tr_mat_mul(v->proj,identmat,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( vv->proj )
{
if ( hessian_normal_perp_flag )
{ REAL ww[MAXCOORD],*wwp=ww,*np=normal;
vec_mat_mul(normal,vv->proj,ww,SDIM,vv->freedom);
tr_mat_mul(&np,&wwp,temp_mat,1,v->freedom,vv->freedom);
cfudge = 1.0;
mat = temp_mat;
}
else
mat = vv->proj;
}
else
{
if ( hessian_normal_perp_flag )
{ REAL *np=normal;
tr_mat_mul(&np,&np,temp_mat,1,v->freedom,vv->freedom);
cfudge = 1.0;
mat = temp_mat;
}
else
mat = identmat;
}
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( kk = 0 ; kk < vv->freedom ; kk++ )
{ col = vv->rownum + kk + A_OFF ;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( j = M->IA[v->rownum+jj]+1-A_OFF ; (int)j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += cfudge*mat[jj][kk]*weights[i][k]*area;
break;
}
if ( j == end )
kb_error(1854,"Internal error: Bad j in linear_metric_setup().\n",RECOVERABLE);
}
}
}
}
}
/* compact matrix by looking for -1 in M->JA */
for ( i = 0 ; i < M->IA[M->N]-A_OFF ; i++ )
if ( M->JA[i] < A_OFF ) break;
if ( i < M->IA[M->N]-A_OFF )
{ int *ja_to_spot = M->JA,*ja_from_spot = M->JA;
REAL *a_to_spot= M->A,*a_from_spot= M->A;
for ( i = 0 ; i < M->N ; i++ )
{ end = M->IA[i+1]-A_OFF;
for ( j = ja_from_spot - M->JA ; (int)j < end ; j++,ja_from_spot++,a_from_spot++ )
{ if ( *ja_from_spot >= A_OFF )
{ *ja_to_spot = *ja_from_spot;
*a_to_spot = *a_from_spot;
a_to_spot++; ja_to_spot++;
}
}
M->IA[i+1] = (int)(ja_to_spot - M->JA + A_OFF);
}
}
apinv_setup:
/* approximate inverse, as diagonal inverse sum of row */
M->apinv = (REAL *)temp_calloc(M->N,sizeof(REAL));
/* sums of rows */
for ( i = 0 ; i < M->N ; i++ )
{ int start = M->IA[i] - A_OFF;
end = M->IA[i+1] - A_OFF;
M->apinv[i] += M->A[start];
for ( j = start+1 ; (int)j < end ; j++ )
{ M->apinv[i] += M->A[j];
M->apinv[M->JA[j]-A_OFF] += M->A[j];
}
}
for ( i = 0 ; i < M->N ; i++ )
M->apinv[i] = (M->apinv[i]==0.0) ? 0.0 : 1/M->apinv[i];
if ( hess_debug)
{ printf("Metric matrix:\n");
printf("IA: ");
for ( i = 0 ; i <= M->N ; i++ ) printf("%d ",M->IA[i]);
printf("\nJA: ");
for ( i = 0 ; i < M->IA[M->N]-A_OFF ; i++ ) printf("%d ",M->JA[i]);
printf("\nA: \n");
for ( i = 0 ; i < M->N ; i++ )
{ int k,m;
for ( m = 0 ; m < i ; m++ ) printf(" ");
for ( m = i, k = M->IA[i]-A_OFF ; m < M->N ; m++ )
if ( (m == M->JA[k]-A_OFF) && (k < M->IA[i+1]-A_OFF) )
{ printf(" %9.6f",(DOUBLE)M->A[k]); k++; }
else printf(" %9.6f",0.0);
printf("\n");
}
printf("\n");
}
} /* end linear_metric_setup() */
/************************************************************************
*
* function: linear_metric_setup_quadratic()
*
* purpose: set up vector-to-form metric sparse matrix for local
* linear interpolation metric. Quadratic mode.
*/
void linear_metric_setup_quadratic(S,M)
struct linsys *S; /* hessian to set up metric for */
struct linsys *M; /* pointer to empty structure */
{
int i,j,jj,k,kk,m,n;
int sum;
edge_id e_id;
vertex_id v_id;
facet_id f_id;
int hi;
REAL len;
MAT2D(weights,FACET_CTRL,FACET_CTRL);
MAT2D(temp_mat,MAXCOORD,MAXCOORD);
REAL **mat;
int col,end;
int ii[FACET_CTRL];
vertex_id vv[FACET_CTRL];
int lo;
if ( ysmp_flag != MINDEG_FACTORING )
{ ysmp_flag = MINDEG_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func = bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring(
"Using alternate minimal degree with linear interpolation metric.\n");
}
M->N = S->N;
M->flags &= ~ S_ODRV_REORDERED;
/* allocate storage for arrays */
M->IA = (int *)temp_calloc(M->N+1,sizeof(int));
if ( M->P == NULL ) M->P = (int *)temp_calloc(M->N,sizeof(int));
if ( M->IP == NULL ) M->IP = (int *)temp_calloc(M->N,sizeof(int));
for ( i = S->optparamrowstart ; i < S->N ; i++ )
{ /* make sure rest of diagonal exists, but no shift */
M->IA[i] = 1;
}
/* have to count number of higher-ordinal neighbors of each vertex */
FOR_ALL_VERTICES(v_id)
{ struct hess_verlist *vh = get_vertex_vhead(v_id);
for ( j = vh->rownum, jj = 0 ; jj < vh->freedom ; jj++,j++ )
M->IA[j] += vh->freedom-jj;
}
FOR_ALL_EDGES(e_id)
{ vertex_id v[3];
struct hess_verlist *vh[3];
v[0] = get_edge_tailv(e_id);
v[1] = get_edge_headv(e_id);
v[2] = get_edge_midv(e_id);
for ( i = 0 ; i < 3 ; i ++ )
vh[i] = get_vertex_vhead(v[i]);
for ( i = 0 ; i < 3 ; i ++ )
for ( k = 0 ; k < 3 ; k++ )
if ( loc_ordinal(v[i]) < loc_ordinal(v[k]) )
for ( j = vh[i]->rownum, jj = 0 ; jj < vh[i]->freedom ; j++,jj++ )
M->IA[j] += vh[k]->freedom;
}
if ( web.representation == SOAPFILM )
FOR_ALL_FACETS(f_id)
{ vertex_id vv[FACET_CTRL];
struct hess_verlist *vh[FACET_CTRL];
facetedge_id fe_id = get_facet_fe(f_id);
int v[FACET_CTRL];
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
vv[i] = get_fe_tailv(fe_id);
vv[i+3] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
for ( i = 0 ; i < FACET_CTRL ; i++ )
{ v[i] = loc_ordinal(vv[i]);
vh[i] = get_vertex_vhead(v[i]);
}
#define ADDON(a,b) \
if ( v[a] > v[b] ) {lo = b; hi = a; } else { lo= a; hi=b;}\
for ( j = vh[lo]->rownum, jj = 0 ; jj < vh[lo]->freedom ; j++,jj++ )\
M->IA[j] += vh[hi]->freedom;
ADDON(0,4); ADDON(1,5); ADDON(2,3); ADDON(4,5); ADDON(3,4); ADDON(3,5);
}
for ( i = 0, sum = 0 ; i < M->N ; i++ ) /* add to running totals */
{ int tmp = sum;
sum += M->IA[i];
M->IA[i] = tmp + A_OFF;
}
M->IA[M->N] = sum + A_OFF;
/* now can allocate space */
M->JA = (int *)temp_calloc(sum,sizeof(int));
M->A = (REAL *)temp_calloc(sum,sizeof(REAL));
for ( i = 0 ; i < sum ; i++ ) M->JA[i] = -1; /* vacant */
for ( i = 0 ; i < M->N ; i++ )
{ M->JA[M->IA[i]-A_OFF] = i + A_OFF; /* diagonal entry at start */
M->IP[i] = M->P[i] = i; /* unpermuted */
}
/* set up interpolation weight matrix */
for ( i = 0 ; i < optparamcount ; i++ )
M->A[M->IA[S->optparamrowstart+i]-A_OFF] = 1.0;
/* leave rest of diagonal zero in case of augmented hessian */
if ( web.representation == STRING )
{ MAT2D(x,EDGE_CTRL,MAXCOORD);
REAL tang[MAXCOORD];
/* edge by edge */
FOR_ALL_EDGES(e_id)
{
vv[0] = get_edge_tailv(e_id);
vv[1] = get_edge_midv(e_id);
vv[2] = get_edge_headv(e_id);
ii[0] = loc_ordinal(vv[0]);
ii[1] = loc_ordinal(vv[1]);
ii[2] = loc_ordinal(vv[2]);
get_edge_verts(e_id,x,NULL);
len = get_edge_length(e_id);
/* weight matrix */
for ( i = 0 ; i < edge_ctrl ; i++ )
for ( j = 0 ; j < edge_ctrl ; j++ ) weights[i][j] = 0.0;
for ( m = 0 ; m < gauss1D_num ; m++ )
{ REAL value;
for ( n = 0 ; n < SDIM ; n ++ )
{ tang[n] = 0.0;
for ( k = 0 ; k < edge_ctrl ; k++ )
tang[n] += gauss1polyd[k][m]*x[k][n];
}
value = gauss1Dwt[m]*sqrt(SDIM_dot(tang,tang));
for ( i = 0 ; i < edge_ctrl ; i++ )
{ for ( j = 0 ; j < edge_ctrl ; j++ )
weights[i][j] += quadratic_metric_mix*value
*gauss1poly[i][m]*gauss1poly[j][m];
}
}
/* simple vertex weighting part */
for ( i = 0 ; i < edge_ctrl ; i++ )
weights[i][i] += (1-quadratic_metric_mix)*((i==1) ? 0.5*len : 0.25*len);
/* fill in metric matrix */
for ( i = 0 ; i < 3 ; i++ )
{ struct hess_verlist *vh = get_vertex_vhead(vv[i]);
/* self */
if ( vh->proj )
{
tr_mat_mul(vh->proj,vh->proj,temp_mat,SDIM,vh->freedom,vh->freedom);
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < vh->freedom ; jj++ )
for ( k = jj ; k < vh->freedom ; k++ )
{ col = vh->rownum + k + A_OFF;
end = M->IA[vh->rownum+jj+1]-A_OFF;
for ( j = M->IA[vh->rownum+jj]-A_OFF ; j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += vh->slant*vh->slant*weights[i][i]*mat[jj][k];
break;
}
if ( j == end )
kb_error(1856,"Internal error in linear_metric_setup.\n",
RECOVERABLE);
}
/* cross terms */
for ( k = 0 ; k < 3 ; k++ )
{ struct hess_verlist *vvh = get_vertex_vhead(vv[k]);
if ( ii[k] <= ii[i] ) continue;
if ( vh->proj && vvh->proj )
{ tr_mat_mul(vh->proj,vvh->proj,temp_mat,SDIM,vh->freedom,
vvh->freedom);
mat = temp_mat;
}
else if ( vh->proj )
{ tr_mat_mul(vh->proj,identmat,temp_mat,SDIM,vh->freedom,vvh->freedom);
mat = temp_mat;
}
else if ( vvh->proj ) mat = vvh->proj;
else mat = identmat;
for ( jj = 0 ; jj < vh->freedom ; jj++ )
for ( kk = 0 ; kk < vvh->freedom ; kk++ )
{ col = vvh->rownum + kk + A_OFF ;
end = M->IA[vh->rownum+jj+1]-A_OFF;
for ( j = M->IA[vh->rownum+jj]+1-A_OFF ; ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += vh->slant*vvh->slant*mat[jj][kk]*weights[i][k];
break;
}
if ( j == end )
kb_error(1857,"Internal error in linear_metric_setup.\n",
RECOVERABLE);
}
}
}
}
}
else
{
REAL area;
MAT2D(tang,2,MAXCOORD);
MAT2D(x,FACET_CTRL,MAXCOORD);
/* facet by facet */
FOR_ALL_FACETS(f_id)
{ vertex_id ix[FACET_CTRL];
REAL density = get_facet_density(f_id);
facetedge_id fe_id = get_facet_fe(f_id);
if ( density == 0.0 ) density = 1.0;
for ( i = 0 ; i < FACET_EDGES ; i++ )
{
ix[2*i] = get_fe_tailv(fe_id);
ix[2*i+1] = get_fe_midv(fe_id);
fe_id = get_next_edge(fe_id);
}
area = get_facet_area(f_id);
for ( i = 0 ; i < FACET_CTRL ; i++ )
ii[i] = loc_ordinal(ix[i]);
/* weight matrix */
get_facet_verts(f_id,x,NULL);
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ ) weights[i][j] = 0.0;
/* simple vertex weighting part */
for ( i = 0 ; i < 3 ; i++ )
{ weights[2*i][2*i] = (1-quadratic_metric_mix)/12*area;
weights[2*i+1][2*i+1] = (1-quadratic_metric_mix)/4*area;
}
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL value,ss,st,tt,det;
mat_mult(gpolypartial[m],x,tang,web.dimension,FACET_CTRL,SDIM);
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt - st*st;
value = gauss2Dwt[m]*sqrt(det)/2; /* with triangle factor */
for ( i = 0 ; i < FACET_CTRL ; i++ )
{ for ( j = 0 ; j < FACET_CTRL ; j++ )
weights[i][j] += quadratic_metric_mix*value*gpoly[m][i]*gpoly[m][j];
}
}
for ( i = 0 ; i < FACET_CTRL ; i++ )
for ( j = 0 ; j < FACET_CTRL ; j++ )
weights[i][j] *= density;
for ( i = 0 ; i < FACET_CTRL ; i++ )
{ struct hess_verlist *v = get_vertex_vhead(ix[i]);
/* self */
if ( v->proj )
{
tr_mat_mul(v->proj,v->proj,temp_mat,SDIM,v->freedom,v->freedom);
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( k = jj ; k < v->freedom ; k++ )
{ col = v->rownum + k + A_OFF;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( j = M->IA[v->rownum+jj]-A_OFF ; j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += v->slant*v->slant*weights[i][i]*mat[jj][k];
break;
}
if ( j == end )
kb_error(1858,"Internal error in linear_metric_setup.\n",
RECOVERABLE);
}
/* cross terms */
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ struct hess_verlist *vv = get_vertex_vhead(ix[k]);
if ( ii[k] <= ii[i] ) continue;
if ( v->proj && vv->proj )
{ tr_mat_mul(v->proj,vv->proj,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( v->proj )
{ tr_mat_mul(v->proj,identmat,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( vv->proj ) mat = vv->proj;
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( kk = 0 ; kk < vv->freedom ; kk++ )
{ col = vv->rownum + kk + A_OFF ;
end = M->IA[v->rownum+jj+1]-A_OFF;
for ( j = M->IA[v->rownum+jj]+1-A_OFF ; j < end ; j++ )
if ( (M->JA[j] < A_OFF) || (M->JA[j] == col) )
{ M->JA[j] = col;
M->A[j] += v->slant*vv->slant*mat[jj][kk]*weights[i][k];
break;
}
if ( j == end )
kb_error(1859,
"Internal error: Bad j in linear_metric_setup_quadratic().\n",RECOVERABLE);
}
}
}
}
}
/* compact matrix by looking for -1 in M->JA */
for ( i = 0 ; i < M->IA[M->N]-A_OFF ; i++ )
if ( M->JA[i] < A_OFF )
{ kb_error(1860,"Internal error: Empty spot in Met.\n",WARNING);
break;
}
if ( i < M->IA[M->N]-A_OFF )
{ int *ja_to_spot = M->JA,*ja_from_spot = M->JA;
REAL *a_to_spot= M->A,*a_from_spot= M->A;
for ( i = 0 ; i < M->N ; i++ )
{ end = M->IA[i+1]-A_OFF;
for ( j = M->IA[i]-A_OFF ; j < end ; j++,ja_from_spot++,a_from_spot++ )
{ if ( M->JA[j] >= A_OFF )
{ *ja_to_spot = *ja_from_spot;
*a_to_spot = *a_from_spot;
a_to_spot++; ja_to_spot++;
}
}
}
}
} /* end linear_metric_setup_quadratic() */
/************************************************************************
*
* function: linear_metric_setup_lagrange()
*
* purpose: set up vector-to-form metric sparse matrix for local
* linear interpolation metric. Lagrange model.
*/
void linear_metric_setup_lagrange(S,M)
struct linsys *S; /* hessian to set up metric for */
struct linsys *M; /* pointer to empty structure */
{
int i,j,jj,k,kk,m,n;
edge_id e_id;
facet_id f_id;
MAT2D(temp_mat,MAXCOORD,MAXCOORD);
REAL **mat=NULL;
int col,row;
int *ii;
REAL **weights=NULL;
REAL **x = NULL;
struct mentry { int row; int col; REAL val; } *temp,*mlist;
int maxcount;
int count,total;
if ( ysmp_flag != MINDEG_FACTORING )
{ ysmp_flag = MINDEG_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring(
"Using alternate minimal degree with Lagrange linear interpolation metric.\n");
}
M->N = S->N;
M->flags &= ~ S_ODRV_REORDERED;
/* allocate storage for arrays */
M->IA = (int *)temp_calloc(M->N+1,sizeof(int));
if ( M->P == NULL ) M->P = (int *)temp_calloc(M->N,sizeof(int));
if ( M->IP == NULL ) M->IP = (int *)temp_calloc(M->N,sizeof(int));
for ( i = 0 ; i < M->N ; i++ )
M->IP[i] = M->P[i] = i; /* unpermuted */
if ( web.representation == STRING )
{ REAL tang[MAXCOORD];
int ctrl = web.skel[EDGE].ctrlpts;
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss1D_order];
ii = (int*)temp_calloc(ctrl,sizeof(int));
weights = dmatrix(0,ctrl,0,ctrl);
x = dmatrix(0,ctrl,0,SDIM);
maxcount = web.skel[EDGE].count*ctrl*(ctrl+1)/2*SDIM*SDIM;
maxcount += M->N - M->optparamrowstart + 10;
mlist = (struct mentry *)temp_calloc(maxcount,sizeof(struct mentry));
count = 0;
/* edge by edge */
FOR_ALL_EDGES(e_id)
{ vertex_id *v = get_edge_vertices(e_id);
for ( i = 0 ; i < ctrl ; i++ ) ii[i] = loc_ordinal(v[i]);
get_edge_verts(e_id,x,NULL);
/* weight matrix */
for ( i = 0 ; i < ctrl ; i++ )
for ( j = 0 ; j < ctrl ; j++ ) weights[i][j] = 0.0;
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL value;
for ( n = 0 ; n < SDIM ; n ++ )
{ tang[n] = 0.0;
for ( k = 0 ; k < ctrl ; k++ )
tang[n] += gl->gpolypart[m][0][k]*x[k][n];
}
value = gl->gausswt[m]*sqrt(SDIM_dot(tang,tang));
for ( i = 0 ; i < ctrl ; i++ )
{ for ( j = 0 ; j < ctrl ; j++ )
weights[i][j] += quadratic_metric_mix*value
*gl->gpoly[m][i]*gl->gpoly[m][j];
}
}
/* simple vertex weighting part */
weights[0][0] += (1-quadratic_metric_mix)*.5/(ctrl-1);
weights[ctrl][ctrl] = (1-quadratic_metric_mix)*.5/(ctrl-1);
for ( i = 1 ; i < edge_ctrl-1 ; i++ )
weights[i][i] += (1-quadratic_metric_mix)/(ctrl-1);
/* fill in metric matrix */
for ( i = 0 ; i < ctrl ; i++ )
{ struct hess_verlist *vh = get_vertex_vhead(v[i]);
/* self */
if ( vh->proj )
{
tr_mat_mul(vh->proj,vh->proj,temp_mat,SDIM,vh->freedom,vh->freedom);
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < vh->freedom ; jj++ )
for ( k = jj ; k < vh->freedom ; k++ )
{ col = vh->rownum + k;
row = vh->rownum + jj;
mlist[count].col = col;
mlist[count].row = row;
mlist[count++].val = vh->slant*vh->slant*weights[i][i]*mat[jj][k];
}
/* cross terms */
for ( k = 0 ; k < ctrl ; k++ )
{ struct hess_verlist *vv = get_vertex_vhead(v[k]);
if ( ii[k] <= ii[i] ) continue;
if ( vh->proj && vv->proj )
{ tr_mat_mul(vh->proj,vv->proj,temp_mat,SDIM,vh->freedom,vv->freedom);
mat = temp_mat;
}
else if ( vh->proj )
{ tr_mat_mul(vh->proj,identmat,temp_mat,SDIM,vh->freedom,vv->freedom);
mat = temp_mat;
}
else if ( vv->proj ) mat = vv->proj;
else mat = identmat;
for ( jj = 0 ; jj < vh->freedom ; jj++ )
for ( kk = 0 ; kk < vv->freedom ; kk++ )
{ col = vv->rownum + kk;
row = vh->rownum+jj;
mlist[count].col = col;
mlist[count].row = row;
mlist[count++].val = vh->slant*vv->slant*mat[jj][kk]*weights[i][k];
}
}
}
}
}
else /* facets */
{
MAT2D(tang,MAXCOORD,MAXCOORD);
int ctrl = web.skel[FACET].ctrlpts;
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
MAT2D(matt,MAXCOORD,MAXCOORD);
ii = (int*)temp_calloc(ctrl,sizeof(int));
weights = dmatrix(0,ctrl,0,ctrl);
x = dmatrix(0,ctrl,0,SDIM);
maxcount = web.skel[FACET].count*ctrl*(ctrl+1)/2*SDIM*SDIM;
maxcount += M->N - M->optparamrowstart + 10;
count = 0;
mlist = (struct mentry *)temp_calloc(maxcount,sizeof(struct mentry));
/* facet by facet */
FOR_ALL_FACETS(f_id)
{ vertex_id *ix = get_facet_vertices(f_id);
REAL density = get_facet_density(f_id);
for ( i = 0 ; i < ctrl ; i++ ) ii[i] = loc_ordinal(ix[i]);
/* weight matrix */
get_facet_verts(f_id,x,NULL);
for ( i = 0 ; i < ctrl ; i++ )
for ( j = 0 ; j < ctrl ; j++ ) weights[i][j] = 0.0;
/* simple vertex weighting part */
for ( i = 0 ; i < ctrl ; i++ ) /* not very precise */
{ int attr = get_vattr(ix[i]);
if ( attr & Q_MIDFACET )
weights[i][i] = (1-quadratic_metric_mix)/ctrl;
else if ( attr & Q_MIDEDGE )
weights[i][i] = (1-quadratic_metric_mix)/ctrl;
else
weights[i][i] = (1-quadratic_metric_mix)/ctrl;
}
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL value,det;
mat_mult(gl->gpolypart[m],x,tang,web.dimension,ctrl,SDIM);
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j <= i ; j++ )
matt[i][j] = matt[j][i] = SDIM_dot(tang[i],tang[j]);
det = det_adjoint(matt,web.dimension);
if ( det <= 0.0 ) value = 0.0;
else value = gl->gausswt[m]*sqrt(det)/factorial[web.dimension];
for ( i = 0 ; i < ctrl ; i++ )
{ for ( j = 0 ; j < ctrl ; j++ )
weights[i][j] += quadratic_metric_mix*value
*gl->gpoly[m][i]*gl->gpoly[m][j];
}
}
for ( i = 0 ; i < ctrl ; i++ )
for ( j = 0 ; j < ctrl ; j++ ) weights[i][j] *= density;
for ( i = 0 ; i < ctrl ; i++ )
{ struct hess_verlist *v = get_vertex_vhead(ix[i]);
/* self */
if ( v->proj )
{
tr_mat_mul(v->proj,v->proj,temp_mat,SDIM,v->freedom,v->freedom);
mat = temp_mat;
}
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( k = jj ; k < v->freedom ; k++ )
{ col = v->rownum + k;
row = v->rownum+jj;
mlist[count].col = col;
mlist[count].row = row;
mlist[count++].val = v->slant*v->slant*weights[i][i]*mat[jj][k];
}
/* cross terms */
for ( k = 0 ; k < ctrl ; k++ )
{ struct hess_verlist *vv = get_vertex_vhead(ix[k]);
if ( ii[k] <= ii[i] ) continue;
if ( v->proj && vv->proj )
{ tr_mat_mul(v->proj,vv->proj,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( v->proj )
{ tr_mat_mul(v->proj,identmat,temp_mat,SDIM,v->freedom,vv->freedom);
mat = temp_mat;
}
else if ( vv->proj ) mat = vv->proj;
else mat = identmat;
for ( jj = 0 ; jj < v->freedom ; jj++ )
for ( kk = 0 ; kk < vv->freedom ; kk++ )
{ col = vv->rownum + kk;
row = v->rownum+jj;
mlist[count].col = col;
mlist[count].row = row;
mlist[count++].val =
v->slant*vv->slant*mat[jj][kk]*weights[i][k];
}
}
}
}
}
if ( count > maxcount )
{kb_error(1869,
"Internal error in linear_metric setup Lagrange: count > maxcount",
RECOVERABLE);
}
/* non-element stuff */
for ( i = 0 ; i < optparamcount ; i++ )
{ mlist[count].row = S->optparamrowstart+i;
mlist[count].col = S->optparamrowstart+i;
mlist[count].val = 1.0;
count++;
}
/* leave rest of diagonal zero in case of augmented hessian */
for ( i = S->optparamrowstart ; i < S->N ; i++ )
{ /* make sure rest of diagonal exists, but no shift */
mlist[count].row = i;
mlist[count].col = i;
mlist[count].val = 0.0;
count++;
}
/* sort and combine entries */
temp = (struct mentry *)temp_calloc(count,sizeof(struct mentry));
/* radix sort, first on columns */
/* count columns */
for ( i = 0 ; i < count ; i++ ) M->IA[mlist[i].col]++;
for ( n = 0, total = 0 ; n < M->N ; n++ )
{ int tmp = M->IA[n];
M->IA[n] = total;
total += tmp;
}
M->IA[M->N] = total;
/* sort into temp */
for ( i = 0 ; i < count ; i++ )
temp[M->IA[mlist[i].col]++] = mlist[i];
/* now sort on rows */
for ( n = 0; n < M->N ; n++ )M->IA[n] = 0;
for ( i = 0 ; i < count ; i++ ) M->IA[temp[i].row]++;
for ( n = 0, total = 0 ; n < M->N ; n++ )
{ int tmp = M->IA[n];
M->IA[n] = total;
total += tmp;
}
M->IA[M->N] = total;
/* sort into mlist */
for ( i = 0 ; i < count ; i++ )
mlist[M->IA[temp[i].row]++] = temp[i];
/* compress */
for ( i = 1, j = 0 ; i < count ; i++ )
{ if ( (mlist[j].row == mlist[i].row) && (mlist[j].col == mlist[i].col) )
mlist[j].val += mlist[i].val;
else { mlist[++j] = mlist[i]; }
}
/* put into M structure */
count = j+1;
M->JA = (int*)temp_calloc(count,sizeof(int));
M->A = (REAL *)temp_calloc(count,sizeof(REAL));
M->IA[0] = A_OFF;
for ( j = 0 ; j < count ; j++ )
{ M->IA[mlist[j].row+1] = j + 1 + A_OFF;
M->JA[j] = mlist[j].col + A_OFF;
M->A[j] = mlist[j].val;
}
M->IA[M->N] = count + A_OFF;
/* free working space */
temp_free((char*)temp);
temp_free((char*)mlist);
if ( ii ) temp_free((char*)ii);
if ( weights ) free_matrix(weights);
if ( x ) free_matrix(x);
} /* linear_metric_setup_lagrange() */
evolver-2.30c.dfsg/src/registry.c 0000644 0001753 0001753 00000014001 11410765113 017225 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/**********************************************************
*
* File: registry.c
*
* Purpose: Declare lists of functions availiable for
* symmetry groups.
*/
/****************************************************************
*
* SYMMETRY GROUP FUNCTIONS
*
* Instructions to those who wish to add a new set of symmetry
* functions: Write a source file (like quotient.c) with
* the necessary symmetry functions. Be sure your functions
* have unique names. Then create an additional structure in
* the array sym_functions below. This array will be searched
* for a name matching the symmetry group name in the datafile.
* Add the name of your source file to the files in Makefile.
*
* Registry structure: (for documentation only; actual globally
* visible declaration is in extern.h)
*/
#ifdef DONT_COMPILE_THIS
struct sym_registry {
char *name; /* to be matched in datafile */
int flags; /* see bits below */
void (*wrapper)(REAL *in,REAL *out,int wrap); /* point wrapper */
int (*compose)(int wrap1,int wrap2); /* group composition */
int (*inverse)(int wrap); /* group inverse */
void (*pullback)(REAL *x,REAL *xform,REAL *yform,int wrap);
/* pullback of yform to xform at x */
} sym_register[];
/* flag bits */
/* for group with fixed points, which should be given attribute AXIAL_POINT */
#define HAS_FIXED_PTS 1
/* for group which has nontrivial form pullback */
#define NEED_FORM_UNWRAPPING 2
/* for group with period two points on rotation axis, which should be given attribute AXIAL_POINT */
#define DOUBLE_AXIAL 4
#endif
/****************************************************************/
/****************************************************************/
/* Prototypes: For this registry to work, your functions must */
/* be declared before the registry. So add your declarations */
/* to the list below. */
/****************************************************************/
#include "include.h"
/* Declarations, using appropriate typedefs */
/* Torus, from torus.c */
extern SYM_WRAP torus_wrap;
extern WRAPTYPE torus_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE torus_inverse ARGS((WRAPTYPE));
extern SYM_FORM torus_form_pullback;
/* XYZ Rotation, from quotient.c */
extern SYM_WRAP xyz_wrap;
extern WRAPTYPE xyz_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE xyz_inverse ARGS((WRAPTYPE));
extern SYM_FORM xyz_form_pullback;
/* Rotation, from quotient.c */
extern SYM_WRAP rot_wrap;
extern WRAPTYPE rot_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE rot_inverse ARGS((WRAPTYPE));
extern SYM_FORM rot_form_pullback;
/* Cube point group, from quotient.c */
extern SYM_WRAP pgcube_wrap;
extern WRAPTYPE pgcube_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE pgcube_inverse ARGS((WRAPTYPE));
extern SYM_FORM pgcube_form_pullback;
/* Full cube lattice group, from quotient.c */
extern SYM_WRAP cubel_wrap;
extern WRAPTYPE cubel_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE cubel_inverse ARGS((WRAPTYPE));
extern SYM_FORM cubel_form_pullback;
/* Flip-Rotation, from quotient.c */
extern SYM_WRAP frot_wrap;
extern SYM_FORM frot_form_pullback;
/* Central symmetry group, from quotient.c */
extern SYM_WRAP central_wrap;
extern WRAPTYPE central_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE central_inverse ARGS((WRAPTYPE));
extern SYM_FORM central_form_pullback;
/* Genus 2 hyperbolic space, Klein model, from khyp.c */
extern SYM_WRAP khyp_wrap;
extern WRAPTYPE khyp_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE khyp_inverse ARGS((WRAPTYPE));
extern SYM_FORM khyp_form_pullback;
/* hyperbolic space, Klein model, from dodecGroup.c (Ken Bromberg) */
extern SYM_WRAP dodec_wrap;
extern WRAPTYPE dodec_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE dodec_inverse ARGS((WRAPTYPE));
extern SYM_FORM dodec_form_pullback;
/* screw rotation, from quotient.c */
extern SYM_WRAP screw_wrap;
extern WRAPTYPE screw_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE screw_inverse ARGS((WRAPTYPE));
extern SYM_FORM screw_form_pullback;
/* quarter_turn torus, from quotient.c */
extern SYM_WRAP quarter_turn_wrap;
extern WRAPTYPE quarter_turn_compose ARGS((WRAPTYPE,WRAPTYPE));
extern WRAPTYPE quarter_turn_inverse ARGS((WRAPTYPE));
extern SYM_FORM quarter_turn_form_pullback;
/* symmetry function registry array */
struct sym_registry sym_register[] = {
{"torus",0,torus_wrap,torus_compose,torus_inverse,torus_form_pullback},
{"genus2",NEED_FORM_UNWRAPPING,
khyp_wrap,khyp_compose,khyp_inverse,khyp_form_pullback},
{"dodecahedron",NEED_FORM_UNWRAPPING,
dodec_wrap,dodec_compose,dodec_inverse,dodec_form_pullback},
{"xyz",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
xyz_wrap,xyz_compose,xyz_inverse,xyz_form_pullback},
{"rotate",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
rot_wrap,rot_compose,rot_inverse,rot_form_pullback},
{"cubocta",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
pgcube_wrap,pgcube_compose,pgcube_inverse,pgcube_form_pullback},
{"cubelat",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
cubel_wrap,cubel_compose,cubel_inverse,cubel_form_pullback},
{"flip_rotate",HAS_FIXED_PTS|DOUBLE_AXIAL|NEED_FORM_UNWRAPPING,
frot_wrap,rot_compose,rot_inverse,frot_form_pullback},
{"central_symmetry",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
central_wrap,central_compose,central_inverse,central_form_pullback},
{"screw_symmetry",HAS_FIXED_PTS|NEED_FORM_UNWRAPPING,
screw_wrap,screw_compose,screw_inverse,screw_form_pullback},
{"quarter_turn",NEED_FORM_UNWRAPPING,
quarter_turn_wrap,quarter_turn_compose,quarter_turn_inverse,
quarter_turn_form_pullback},
{NULL,0,NULL,NULL,NULL,NULL} /* NULL name ends search */
};
evolver-2.30c.dfsg/src/hessian.c 0000644 0001753 0001753 00000227662 11410765113 017032 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* File: hessian.c
*
* Purpose: Main file for hessian commands.
*
*/
#define GDEBUG
int hess_debug; /* debugging flag */
/* use ysmp */
#include "include.h"
#include "f2c.h"
int hmode; /* mode of motion */
struct hess_verlist *vhead = NULL; /* main vertex list */
int vhead_count; /* total number of vertices */
#ifdef XXX
REAL *rhs = NULL; /* right side of augmented matrix */
REAL *X = NULL; /* solution to augmented matrix */
#endif
REAL *conrhs = NULL; /* right side of augmented matrix for constraints */
int vertex_rows; /* number of rows for vertex degrees of freedom */
REAL **vproj_base; /* vertex projection matrix row pointers */
REAL *vproj_space; /* vertex projection matrix arena */
REAL ***conhess_base; /* vertex constraint hessian arena */
REAL rhs_norm;
static int ritz_done_flag;
REAL **ritzvecs;
static int ritzdim;
void optparamhess ARGS((struct linsys *,REAL *)); /* right side */
#ifdef OLDHASH
/********************************************************************
*
* function: hess_hash_search()
*
* purpose: Finds existing entry or allocates entry.
* Installs key values, and adds hessian value.
* return: Pointer to entry.
*/
void hess_hash_search(col,row,value)
int row,col; /* meant to do upper triangle */
REAL value; /* value to add */
{
struct hess_entry *e;
int spot;
if ( row > col ) return;
if ( (value == 0.0) && (row != col) ) return;
if ( col >= S->A_rows ) /* a constraint grad */
{ if ( col == goner ) return;
if ( !array[col].u.congrad )
array[col].u.congrad = (REAL *)mycalloc(S->A_rows,sizeof(REAL));
e = (struct hess_entry *)(array[col].u.congrad+row);
e->value += value;
if ( !sparse_constraints_flag )
return;
}
if ( hashcount >= max_fill )
hess_hash_expand();
/* search hash table */
spot = hash(row,col) % table_size;
e = hashtable + spot;
while ( e->row != HASHEMPTY )
{ if ( (e->row == row) && (e->col == col) )
{ e->value += value; return;
}
spot++;
if ( spot >= table_size ) spot -= table_size;
e = hashtable + spot;
hash_extraprobes++;
}
/* if here, then have empty slot and need to insert */
e->col = col; e->row = row; hashcount++;
e->value = value;
}
#endif
/***********************************************************************
*
* function: fill_grad()
*
* purpose: process gradient of function at constraint
*/
void fill_grad(S,v,grad,rhs)
struct linsys *S;
struct hess_verlist *v;
REAL *grad;
REAL *rhs;
{ REAL g[MAXCOORD];
int k,a,b;
if ( rhs_flag )
{ if ( v->proj )
{ vec_mat_mul(grad,v->proj,g,SDIM,v->freedom);
for ( k = 0 ; k < v->freedom ; k++ )
rhs[v->rownum+k] -= g[k];
}
else
for ( k = 0 ; k < v->freedom ; k++ )
rhs[v->rownum+k] -= grad[k];
}
if ( hess_flag && v->conhess )
{
for ( a = 0 ; a < v->freedom ; a++ )
for ( b = 0 ; b <= a ; b++ )
sp_hash_search(S,v->rownum+b,v->rownum+a,
SDIM_dot(grad,v->conhess[a][b]));
}
}
/*************************************************************************
*
* function: fill_self_entry()
*
* purpose: fill proper hessian matrix spot for single vertex second derivs
*/
void fill_self_entry(S,v_id,self)
struct linsys *S;
vertex_id v_id;
REAL **self; /* full dim values */
{ int j,k;
struct hess_verlist *v;
v = get_vertex_vhead(v_id);
if ( v->proj )
{ MAT2D(temp_mat,MAXCOORD,MAXCOORD);
MAT2D(temp_mat2,MAXCOORD,MAXCOORD);
tr_mat_mul(v->proj,self,temp_mat,SDIM,v->freedom,SDIM);
mat_mult(temp_mat,v->proj,temp_mat2,v->freedom,SDIM,v->freedom);
for ( j = 0 ; j < v->freedom ; j++ )
for ( k = 0 ; k <= j ; k++ )
sp_hash_search(S,v->rownum+k,v->rownum+j, temp_mat2[j][k]);
}
else
{ for ( j = 0 ; j < v->freedom ; j++ )
for ( k = 0 ; k <= j ; k++ )
sp_hash_search(S,v->rownum+k,v->rownum+j,self[j][k]);
}
}
/*************************************************************************
*
* function: fill_mixed_entry()
*
* purpose: fill proper hessian matrix spot for mixed vertex second derivs
*/
void fill_mixed_entry(S,v_id1,v_id2,mixed)
struct linsys *S;
vertex_id v_id1,v_id2;
REAL **mixed; /* full dim values */
{ int k,j;
REAL **oo;
MAT2D(temp_mat,MAXCOORD,MAXCOORD);
MAT2D(temp_mat2,MAXCOORD,MAXCOORD);
struct hess_verlist *v1,*v2;
if ( equal_id(v_id1,v_id2) )
{ fill_self_entry(S,v_id1,mixed);
return;
}
v1 = get_vertex_vhead(v_id1);
v2 = get_vertex_vhead(v_id2);
if ( v1->proj )
{ tr_mat_mul(v1->proj,mixed,temp_mat,SDIM,v1->freedom,SDIM);
oo = temp_mat;
}
else oo = mixed;
if ( v2->proj )
{ mat_mult(oo,v2->proj,temp_mat2,v1->freedom,SDIM,v2->freedom);
oo = temp_mat2;
}
if ( v1->rownum < v2->rownum )
for ( j = 0 ; j < v1->freedom ; j++ )
for ( k = 0 ; k < v2->freedom ; k++ )
sp_hash_search(S,v1->rownum+j,v2->rownum+k,oo[j][k]);
else
for ( j = 0 ; j < v1->freedom ; j++ )
for ( k = 0 ; k < v2->freedom ; k++ )
sp_hash_search(S,v2->rownum+k,v1->rownum+j,oo[j][k]);
}
#ifdef OLDHASH
/********************************************************************
*
* function: hess_hash_sort()
*
* purpose: Create sorted list of hessian entries, row major order
* Does 2-digit radix sort on row,col with count sort on each.
* input: total_rows - upper bound for row,col.
* output: *nptr - number of entries
* **listptr - allocated list (temp_calloc)
*/
void hess_hash_sort(hessian_rows,nptr,listptr)
int hessian_rows; /* rows in hessian */
int *nptr; /* for return of total entries */
struct hess_entry **listptr; /* list in, for return of sorted list */
{ int i;
struct hess_entry *e;
int *counts;
int *starts;
int sum,oldsum;
counts = (int *)temp_calloc(2*hessian_rows+1,sizeof(int));
starts = counts + hessian_rows;
/* count entries in row */
for ( i = 0, e = hashtable ; i < table_size ; i++, e++ )
if ( e->row != HASHEMPTY ) counts[e->row]++;
for ( i = 0 ; i < hessian_rows ; i++ )
array[i].count = counts[i];
/* get starting points of each row */
for ( i = 0, sum = 0 ; i < hessian_rows ; i++ )
{ oldsum = sum;
sum += counts[i];
counts[i] = starts[i] = oldsum;
}
starts[hessian_rows] = sum;
/* sort into row bins */
for ( i = 0, e = hashtable ; i < table_size ; i++,e++ )
{
struct hess_entry eorig;
struct hess_entry etmp;
if ( e->row == HASHEMPTY ) continue;
if ( i < counts[e->row] ) continue;
eorig = *e;
e->row = HASHEMPTY;
do
{ /* follow chain of replacements */
int spot;
int k;
spot = counts[eorig.row];
etmp = hashtable[spot];
/* insertion sort into row */
for ( k = spot ; k > starts[eorig.row] ; k-- )
{ if ( hashtable[k-1].col > eorig.col )
hashtable[k] = hashtable[k-1];
else break;
}
hashtable[k] = eorig;
counts[eorig.row]++;
eorig = etmp;
}
while ( eorig.row != HASHEMPTY ); /* stop when get back to empty */
}
*listptr = hashtable;
*nptr = hashcount;
temp_free((char*)counts);
hash_per_row = 1 + (5*hashcount)/(4*S->A_rows+1); /* for next time */
if ( !hessian_quiet_flag )
{ sprintf(msg,"Hessian entries: %d Final hashtable size: %d next hash_per_row: %d.\n",hashcount, table_size,hash_per_row);
outstring(msg);
sprintf(msg,"Hash extra probes: %d\n",hash_extraprobes);
outstring(msg);
}
}
/********************************************************************
*
* function: hess_hash_end()
*
* purpose: Deallocate hessian hash table.
*/
void hess_hash_end()
{
if ( hashtable ) myfree((char*)hashtable);
hashtable = NULL;
}
#endif
/********************************************************************
End Hessian hash routines.
********************************************************************/
/**************************************************************
*
* Function: hessian_auto()
*
* Purpose: Global minimization of energy by finding
* critical point of quadratic approximation
* to total energy function.
* Using only lower left triangle of symmetric matrix.
* Uses whatever sparse matrix solver is in effect at the moment.
*
*/
void hessian_auto() /* automatic hessian */
{ REAL old_energy = web.total_energy;
REAL *rhs = NULL;
REAL *X = NULL;
struct linsys S;
hmode = hessian_normal_flag;
hessian_cleanup(); /* cleanup from previous round */
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 1;
hessian_fill(&S,&rhs);
sp_Hessian_solver(&S,rhs,&X);
hessian_move((REAL)1.0,ACTUAL_MOVE,X);
if ( check_increase_flag &&
(web.total_energy > (1+100*machine_eps)*old_energy) )
{ kb_error(1596,"Hessian move would have raised energy. Restoring coords.\n",
WARNING);
restore_coords(&saved,SAVE_IN_ATTR);
}
hessian_exit(X);
free_system(&S);
temp_free((char*)rhs);
temp_free((char*)X);
}
/**************************************************************
*
* Function: hessian_seek()
*
* Purpose: Same as hessian_auto(), but uses direction of minimum
* as seek direction, and moves down it.
*
* Return: best stepsize
*/
REAL hessian_seek(maxscale) /* automatic hessian */
REAL maxscale;
{ REAL best_scale;
REAL *rhs=NULL,*X=NULL;
struct linsys S;
hmode = hessian_normal_flag;
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 1;
hessian_fill(&S,&rhs);
if ( hessian_linear_metric_flag )
linear_metric_setup(&S,&Met);
else if ( web.area_norm_flag )
star_metric_setup(&S,&Met);
sp_Hessian_solver(&S,rhs,&X);
best_scale = hessian_line_seek(&S,maxscale,X);
hessian_exit(X);
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
temp_free((char*)rhs);
temp_free((char*)X);
return best_scale;
}
/*****************************************************************************
*
* function: square_grad()
*
* purpose: calculates gradients for rhs and returns square of gradient
*
*/
REAL square_grad()
{ REAL sum;
vertex_id v_id;
REAL *f;
int i;
int oldflag = min_square_grad_flag;
calc_all_grads(CALC_VOLGRADS);
volume_restore(1.,ACTUAL_MOVE);
min_square_grad_flag = 0; /* so calc_force does regular forces */
calc_force();
min_square_grad_flag = oldflag;
pressure_forces();
fix_vertices(); /* project forces to constraints, etc */
calc_lagrange();
lagrange_adjust();
vgrad_end();
sum = 0.0;
FOR_ALL_VERTICES(v_id)
{ REAL star;
f = get_force(v_id);
if ( hessian_linear_metric_flag )
star = Met.apinv[get_vertex_vhead(v_id)->rownum];
else star = 1.0;
if ( hessian_normal_flag )
{ struct hess_verlist *v; /* current vertex */
REAL r[MAXCOORD];
REAL *rr = r;
v = get_vertex_vhead(v_id);
vec_mat_mul(f,v->proj,rr,SDIM,v->freedom);
sum += dot(r,r,v->freedom)*star;
}
else sum += SDIM_dot(f,f)*star;
}
for ( i = 0 ; i < optparamcount ; i++ )
sum += optparam[i].grad*optparam[i].grad;
return sum;
}
/*****************************************************************************
*
* function: square_grad_forces()
*
* purpose: calculates gradients for rhs and returns square of gradient
* and calculates forces as hessian times rhs.
*
*/
void square_grad_forces()
{ REAL *rhs=NULL,*X=NULL;
struct linsys S;
hmode = hessian_normal_flag;
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 1;
hessian_fill(&S,&rhs);
/* ?
if ( hessian_linear_metric_flag )
linear_metric_setup(&S,&Met);
else if ( web.area_norm_flag )
star_metric_setup(&S,&Met);
*/
X = (REAL*)temp_calloc(S.N,sizeof(REAL));
sp_hessian_mult(&S,rhs,X);
hessian_move(0,SET_VELOCITY,X);
hessian_exit(X);
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
temp_free((char*)rhs);
temp_free((char*)X);
}
/*****************************************************************************
*
* function: hessian_line_seek()
*
* purpose: seek optimum motion in downhill direction, after downhill
* found.
* save_coords() assumed to have been done in hessian_init();
* step size bounded by web.max_scale.
* If input parameter maxscale is nonzero, will obey.
*
* return: optimal stepsize
*/
REAL hessian_line_seek(S,maxscale,X)
struct linsys *S;
REAL maxscale;
REAL *X;
{ REAL scale0=0.0,scale1,scale2=0.0;
REAL energy0,energy1,energy2=0.0;
int seekcount = 0;
int dirflag = 1; /* for positive or negative direction */
REAL stepsize;
REAL typescale;
if ( maxscale <= 0.0 ) return 0.0;
typescale = maxscale/100;
ENTER_GRAPH_MUTEX;
/* base energy; may be volume adjustments, so can't just take current values */
hessian_move(0.0,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy0 = min_square_grad_flag ? square_grad(): web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize 0 energy0 %18.15g\n",energy0);
outstring(msg);
}
hessian_move(typescale*1e-3,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy1 = min_square_grad_flag ? square_grad(): web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize %f energy1 %18.15g\n",typescale*1e-3,energy1);
outstring(msg);
}
hessian_move(-typescale*1e-3,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy2 = min_square_grad_flag ? square_grad(): web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize %f energy2 %18.15g\n",-typescale*1e-3,energy2);
outstring(msg);
}
LEAVE_GRAPH_MUTEX;
if ( (energy1 >= energy0) && (energy2 >= energy0) )
return 0.0;
if ( energy1 > energy2 ) dirflag = -1;
else dirflag = 1;
ENTER_GRAPH_MUTEX;
stepsize = scale1 = 0.499999999*typescale;
hessian_move(dirflag*stepsize,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy1 = min_square_grad_flag ? square_grad(): web.total_energy;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize %f energy1 %18.15g\n",dirflag*stepsize,energy1);
outstring(msg);
}
if ( energy1 < energy0 )
{ do
{ stepsize *= 2;
if ( stepsize > maxscale ) { stepsize = maxscale; /*break;*/ }
hessian_move(dirflag*stepsize,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy2 = min_square_grad_flag ? square_grad(): web.total_energy;
scale2 = stepsize;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize %f energy2 %18.15g\n",dirflag*stepsize,energy2);
outstring(msg);
}
if ( energy2 > energy1 )
{ stepsize /= 2; break; }
else
{ energy0 = energy1; scale0 = scale1;
energy1 = energy2; scale1 = scale2;
}
} while ( stepsize < maxscale );
}
else /* energy1 >= energy0 */
{ seekcount = 0;
do
{ if ( seekcount++ > 20 ) { stepsize = 0.0; break; }
energy2 = energy1; scale2 = scale1;
stepsize = scale2/2;
hessian_move(dirflag*stepsize,ACTUAL_MOVE/*TEST_MOVE*/,X);
energy1 = min_square_grad_flag ? square_grad(): web.total_energy;
scale1 = stepsize;
restore_coords(&saved,SAVE_IN_ATTR);
if ( itdebug )
{ sprintf(msg,"stepsize %f energy1 %18.15g\n",dirflag*stepsize,energy1);
outstring(msg);
}
} while ( energy1 > energy0 );
}
if ( (stepsize > 0.0) && (energy2 > energy1) /*(stepsize < maxscale)*/ )
{ REAL denom;
/* now quadratic interpolation for minimum energy */
denom = energy0*(scale1-scale2)+energy1*(scale2-scale0)
+ energy2*(scale0 - scale1);
if ( denom == 0.0 ) stepsize = 0.0;
else
{ stepsize = ((energy0-energy2)*scale1*scale1
+(energy1-energy0)*scale2*scale2
+(energy2-energy1)*scale0*scale0)/2/denom;
}
if ( stepsize < scale0 ) stepsize = scale0;
if ( stepsize > scale2 ) stepsize = scale2;
}
else if ( stepsize < 0.0 ) stepsize = 0.0;
else if ( stepsize > maxscale ) stepsize = maxscale;
hessian_move(dirflag*stepsize,ACTUAL_MOVE,X);
LEAVE_GRAPH_MUTEX;
if ( min_square_grad_flag )
{ energy1 = square_grad();
#ifdef LONGDOUBLE
sprintf(msg,"square gradient: %3.*Lg\n",DPREC,energy1);
#else
sprintf(msg,"square gradient: %3.15g\n",energy1);
#endif
outstring(msg);
}
return dirflag*stepsize;
} /* end hessian_line_seek() */
/***************************************************************************
*
* function: hessian_saddle()
*
* purpose: move downhill optimally if at saddle point
*/
void hessian_saddle(maxscale)
REAL maxscale;
{ REAL low;
REAL stepsize;
REAL *rhs=NULL,*X=NULL;
struct linsys S;
hmode = hessian_normal_flag;
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 1;
hessian_fill(&S,&rhs);
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func)
(web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
if ( hessian_linear_metric_flag )
{
linear_metric_setup(&S,&Met);
}
else if ( web.area_norm_flag )
{
star_metric_setup(&S,&Met);
}
X = (REAL*)temp_calloc(S.N+S.concount,sizeof(REAL));
low = lowest_eigenpair(&S,X);
if ( low >= 0.0 )
{
#ifdef LONGDOUBLE
sprintf(msg,"Lowest eigenvalue %2.*Lg. Not a saddle point.\n",DPREC,low);
#else
sprintf(msg,"Lowest eigenvalue %2.15g. Not a saddle point.\n",low);
#endif
outstring(msg);
goto saddle_exit;
}
#ifdef LONGDOUBLE
sprintf(msg,"Lowest eigenvalue %2.*Lg\n",DPREC,low);
#else
sprintf(msg,"Lowest eigenvalue %2.15g\n",low);
#endif
outstring(msg);
stepsize = hessian_line_seek(&S,maxscale,X);
sprintf(msg,"stepsize %g\n",(DOUBLE)stepsize);
outstring(msg);
#ifdef LONGDOUBLE
sprintf(msg,"1. energy: %17.*Lg \n", DPREC,web.total_energy);
#else
sprintf(msg,"1. %s: %17.15g energy: %17.15g \n",
areaname,web.total_area,web.total_energy);
#endif
outstring(msg);
update_display();
reset_conj_grad();
saddle_exit:
hessian_exit(X); /* cleanup */
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag ) free_system(&Met);
temp_free((char*)rhs);
temp_free((char*)X);
} /* end hessian_saddle() */
/***************************************************************************
*
* function: print_hessian_menu()
*
* purpose: Prints full menu in hessian_menu command.
*/
void print_hessian_menu()
{
outstring("\n");
outstring("1. Fill in hessian matrix.\n");
outstring("2. Fill in right side. (Do 1 first)\n");
outstring("3. Solve. (Do 2 first)\n");
outstring("4. Move. (Do 3,V,E,F,C,B or X first)\n");
outstring("7. Restore original coordinates.\n");
outstring("9. Toggle debugging. (Don't do this!)\n");
outstring("B. Chebychev (For Hessian solution ).\n");
outstring("C. Chebychev (For most negative eigenvalue eigenvector).\n");
outstring("E. Lowest eigenvalue. (By factoring. Do 1 first)\n");
outstring("F. Lowest eigenvalue. (By conjugate gradient. Do 1 first)\n");
outstring("L. Lanczos. (Finds eigenvalues near probe value. )\n");
outstring("R. Lanczos with selective reorthogonalization.\n");
outstring("Z. Ritz subspace iteration for eigenvalues. (Do 1 first)\n");
outstring("X. Pick Ritz vector for motion. (Do Z first)\n");
outstring("P. Eigenvalue probe. (By factoring. Do 1 first)\n");
outstring("V. Eigenvalue probe with eigenvector. (By factoring. Do 1 first)\n");
outstring("S. Seek along direction. (Do 3,V,E,F,C,B or X first)\n");
outstring("Y. Toggle YSMP/alternate minimal degree factoring.\n");
outstring("U. Toggle Bunch-Kaufman version of min deg.\n");
outstring("M. Toggle projecting to global constraints in move. (Leave this alone!)\n");
outstring("G. Toggle minimizing square gradient in seek.\n");
outstring("D. Dump Hessian to text file.\n");
outstring("=. Execute Evolver commands in subprompt.\n");
#ifdef MPI_EVOLVER
outstring("A. Build corona (MPI version only).\n");
outstring("J. Dissolve corona (MPI version only).\n");
outstring("I. Free discard lists (MPI version only).\n");
#endif
outstring("0. Exit hessian.\n");
}
/***********************************************************************
*
* function: hessian_menu()
*
* purpose: give user more interactive control over Hessian move
* and debugging.
*/
void hessian_menu()
{ char response[30];
int left_flag = 0; /* whether hessian filled */
int right_flag = 0; /* whether rhs filled in */
int dir_flag = 0 ; /* whether direction filled in */
REAL stepsize;
REAL *rhs = NULL,*X = NULL;
struct linsys S;
hessian_legal();
save_coords(&saved,SAVE_IN_ATTR);
memset(&S,0,sizeof(struct linsys));
hess_debug = 0;
hmode = hessian_normal_flag;
for(;;)
{
#ifdef MPI_EVOLVER
prompt("Choice(?,1,2,3,4,7,9,B,C,E,F,L,R,Z,X,P,V,S,Y,U,M,G,D,A,=,0,q): ",
response,sizeof(response));
#else
prompt("Choice(?,1,2,3,4,7,9,B,C,E,F,L,R,Z,X,P,V,S,Y,U,M,G,D,=,0,q): ",
response,sizeof(response));
#endif
switch ( toupper(response[0]) )
{ case '?': print_hessian_menu(); break;
case '1':
hessian_cleanup(); /* cleanup from previous round */
hessian_init(&S,&rhs);
hess_flag = 1; rhs_flag = 1;
hessian_fill(&S,&rhs);
X = (REAL*)temp_calloc(S.N,sizeof(REAL));
(*sp_AIJ_setup_func)(S.A_rows,&S);
(*sp_constraint_setup_func) (
web.skel[BODY].max_ord+1 + gen_quant_count,&S);
if ( sp_ordering_func ) (*sp_ordering_func)(&S);
if ( hessian_linear_metric_flag )
{
linear_metric_setup(&S,&Met);
}
else if ( web.area_norm_flag )
{
star_metric_setup(&S,&Met);
}
left_flag = 1;
break;
case '2':
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
if ( hess_debug )
{ int i;
for ( i = 0 ; i < S.N ; i++ )
printf("B[%d] %20.15f\n",i,(DOUBLE)(rhs[i]));
}
rhs_norm = dot(rhs,rhs,S.N);
#ifdef LONGDOUBLE
sprintf(msg,"RHS norm: %20.*Lg\n",DPREC, rhs_norm);
#else
sprintf(msg,"RHS norm: %20.15g\n", rhs_norm);
#endif
outstring(msg);
right_flag = 1;
break;
case '3':
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
if ( right_flag == 0 )
{ outstring("Error: Must do step 2 first.\n"); break; }
if ( !(S.flags & S_FACTORED) ) sp_factor(&S);
if ( !(S.flags & S_PROJECTED)) (*sp_hess_project_setup_func)(&S);
sp_hessian_solve(&S,rhs,X,SET_PRESSURE);
outstring("Motion found. Pressures adjusted.\n");
dir_flag = 1;
break;
case '4':
if ( dir_flag == 0 )
{ outstring("Error: Must do step 3,V,E,F,C,B or X first.\n");
break;
}
prompt("Step size: ",response,sizeof(response));
stepsize = atof(response);
hessian_move(stepsize,ACTUAL_MOVE,X);
#ifdef LONGDOUBLE
sprintf(msg,"1. energy: %*.*Lg \n",DWIDTH,DPREC,web.total_energy);
#else
sprintf(msg,"1. %s: %17.15f energy: %17.15f \n",
areaname,web.total_area,web.total_energy);
#endif
outstring(msg);
update_display();
break;
case '7': restore_coords(&saved,SAVE_IN_ATTR); update_display(); break;
case '8':
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
write_hessian(&S); break;
case '=':
hessian_subshell_flag = 1;
subshell_depth++;
setjmp(jumpbuf[subshell_depth]);
/* command read and execute loop */
exec_commands(NULL,"hessian_menu subcommand: ");
subshell_depth-- ;
hessian_subshell_flag = 0;
break;
case 'Q': case '0': case 0:
hessian_exit(X);
free_system(&S);
if ( hessian_linear_metric_flag || web.area_norm_flag )
free_system(&Met);
if ( rhs ) temp_free((char*)rhs);
if ( X ) temp_free((char*)X);
return;
case '9': hess_debug = !hess_debug;
if ( hess_debug )
outstring("Hessian debug ON.\n");
else outstring("Hessian debug OFF.\n");
break;
case 'K': /* experimdntal multigrid */
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
if ( right_flag == 0 )
{ outstring("Error: Must do step 2 first.\n"); break; }
do_multigrid(&S);
break;
case 'Z': /* ritz */
{
REAL probe;
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
prompt("Ritz probe value: ",response,sizeof(response));
probe = atof(response);
prompt("Number of eigenvalues: ",response,sizeof(response));
ritzdim = atoi(response);
if ( ritzvecs ) free_matrix(ritzvecs);
ritzvecs = dmatrix(0,ritzdim-1,0,S.N+S.concount);
do_ritz(&S,probe,ritzdim,ritzvecs);
ritz_done_flag = 1;
break;
}
case 'X': /* pick ritz vector for motion */
{ int ritznum;
char *spot;
int i;
if ( ritz_done_flag == 0 )
{ outstring("Error: Must do step Z first.\n"); break; }
sprintf(msg,"Eigenvector number (1 to %d): ",ritzdim);
prompt(msg,response,sizeof(response));
/* parse response for possible linear combo of vectors */
for ( spot = response ; *spot ; spot++ )
*spot = tolower(*spot);
if ( strchr(response,'v') )
{ spot = response;
memset((char*)X,0,S.N*sizeof(REAL));
while ( strchr(spot,'v') )
{ REAL coeff;
int sign = 1;
while ( *spot==' ' || *spot=='+' || *spot=='-' )
{ if ( *spot=='-' ) sign = -sign;
spot++;
}
coeff = sign*atof(spot);
spot = strchr(spot,'v')+1;
ritznum = atoi(spot);
while ( isdigit(*spot) ) spot++;
if ( (ritznum < 0) || (ritznum > ritzdim) )
{ outstring("Error: Invalid eigenvector number.\n");
break;
}
ritznum--;
for ( i = 0 ; i < S.N ; i++ )
X[i] += coeff*ritzvecs[ritznum][i];
}
}
else
{ ritznum = atoi(response);
if ( (ritznum < 0) || (ritznum > ritzdim) )
{ outstring("Error: Invalid eigenvector number.\n"); break; }
ritznum--;
for ( i = 0 ; i < S.N ; i++ ) X[i] = ritzvecs[ritznum][i];
}
dir_flag = 1;
break;
}
case 'L':
{ int nprint,i;
REAL evalues[NPRINT];
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
if ( !(S.flags & S_FACTORED) ) sp_factor(&S);
if ( !(S.flags & S_PROJECTED)) (*sp_hess_project_setup_func)(&S);
nprint = lanczos(&S,KRYLOVDIM,evalues,NPRINT);
/* list, ones near probe value */
for ( i = 0 ; i < nprint ; i++ )
{
#ifdef LONGDOUBLE
sprintf(msg,"%d %*.*Lf\n",i+1,DWIDTH,DPREC,evalues[i]);
#else
sprintf(msg,"%d %20.15f\n",i+1,evalues[i]);
#endif
outstring(msg);
}
}
break;
case 'R':
{ int nprint,i;
REAL evalues[NPRINT];
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
if ( !(S.flags & S_FACTORED) ) sp_factor(&S);
if ( !(S.flags & S_PROJECTED)) (*sp_hess_project_setup_func)(&S);
nprint = selective_lanczos(&S,KRYLOVDIM,evalues,NPRINT);
/* list, ones near probe value */
for ( i = 0 ; i < nprint ; i++ )
{
#ifdef LONGDOUBLE
sprintf(msg,"%d %*.*Lf\n",i+1,DWIDTH,DPREC,evalues[i]);
#else
sprintf(msg,"%d %20.15f\n",i+1,evalues[i]);
#endif
outstring(msg);
}
}
break;
case 'C':
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
chebychev_ev(&S);
dir_flag = 1;
break;
case 'B':
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
chebychev_hess(&S);
dir_flag = 1;
break;
case 'P': /* probe for eigenvalues */
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
bk_eigenprobe(&S);
break;
case 'V': /* probe for eigenvalues, with eigenvector */
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
bk_inverse_it(&S,X);
dir_flag = 1;
break;
case 'E': /* lowest eigenvalue */
{ REAL low;
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
low = lowest_eigenpair(&S,X);
#ifdef LONGDOUBLE
sprintf(msg,"Lowest eigenvalue %2.*Lg\n",DPREC,low);
#else
sprintf(msg,"Lowest eigenvalue %2.15g\n",low);
#endif
outstring(msg);
dir_flag = 1;
break;
}
case 'd': /* lowest eigenvalue, by old conjugate gradient */
{ REAL low;
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
low = old_cg_lowest_eigenpair(&S,X);
#ifdef LONGDOUBLE
sprintf(msg,"Lowest eigenvalue %2.*Lg\n",DPREC,low);
#else
sprintf(msg,"Lowest eigenvalue %2.15g\n",low);
#endif
outstring(msg);
dir_flag = 1;
break;
}
case 'F': /* lowest eigenvalue, by conjugate gradient */
{ REAL low;
if ( left_flag == 0 )
{ outstring("Error: Must do step 1 first.\n"); break; }
low = cg_lowest_eigenpair(&S,X);
#ifdef LONGDOUBLE
sprintf(msg,"Lowest eigenvalue %2.*Lg\n",DPREC,low);
#else
sprintf(msg,"Lowest eigenvalue %2.15g\n",low);
#endif
outstring(msg);
dir_flag = 1;
break;
}
case 'S':
if ( dir_flag == 0 )
{ outstring("Error: Must get direction first.\n"); break; }
stepsize = hessian_line_seek(&S,10.0,X);
sprintf(msg,"stepsize %g\n",(DOUBLE)stepsize);
outstring(msg);
#ifdef LONGDOUBLE
sprintf(msg,"1. energy: %*.*Lg \n",DWIDTH,DPREC,web.total_energy);
#else
sprintf(msg,"1. %s: %17.15g energy: %17.15g \n",
areaname,web.total_area,web.total_energy);
#endif
outstring(msg);
update_display();
break;
case 'Y': /* toggle YSMP */
if ( ysmp_flag != MINDEG_FACTORING )
{ ysmp_flag = MINDEG_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring("Using alternate minimal degree factoring.\n");
if ( left_flag ) outstring("Must do step 1 again.\n");
dir_flag = left_flag = right_flag = 0;
}
else
{ ysmp_flag = YSMP_FACTORING;
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = ysmp_factor;
sp_CHinvC_func = NULL;
sp_solve_func = ysmp_solve;
sp_solve_multi_func = ysmp_solve_multi;
sp_ordering_func = NULL;
outstring("Using YSMP.\n");
}
break;
case 'U': /* toggle BK version of min degree */
BK_flag = !BK_flag;
if ( BK_flag )
outstring("Using Bunch-Kaufman version of minimal degree.\n");
else
outstring("Using non-Bunch-Kaufman version of minimal degree.\n");
break;
case 'M':
hess_move_con_flag = !hess_move_con_flag;
if ( hess_move_con_flag )
outstring("Projecting global constraints in move.\n");
else
outstring("Not projecting global constraints in move.\n");
break;
case 'G':
min_square_grad_flag = !min_square_grad_flag;
if ( min_square_grad_flag )
outstring("Minimizing square gradient in seek.\n");
else
outstring("Minimizing regular energy in seek.\n");
break;
case 'D': /* dump Hessian, 1-based indexing */
{ FILE *fd;
char hname[200];
size_t baselength;
int i,j,k;
gethname:
outstring("Hessian dump. Note indexing is 1-based.\n");
prompt("Enter path and base name of Hessian dump files: ",
hname,200);
if ( hname[0] == 0 ) break;
baselength = strlen(hname);
strcat(hname,"_H.dat");
fd = fopen(hname,"w");
if ( fd == NULL )
{ perror(hname); goto gethname; }
sprintf(msg,
"Dumping Hessian upper triangle in row col value format to %s.\n",
hname);
outstring(msg);
for ( i = 0 ; i < S.N ; i++ )
for ( j = S.IA[i]-A_OFF ; j < S.IA[i+1]-A_OFF ; j++ )
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,S.JA[j]-A_OFF+1,S.A[j]);
}
fclose(fd);
if ( ysmp_flag != MINDEG_FACTORING )
{ outstring("Further dumping of factors in minimal degree mode (ysmp off) only.\n");
break;
}
if ( !S.LA )
{ outstring("Need to do step 3, P, V, or Z before dumping factors.\n");
break;
}
strcpy(hname+baselength,"_L.dat");
sprintf(msg,
"Dumping L factor in row col value format to %s.\n",hname);
outstring(msg);
if ( hname[0] == 0 ) break;
fd = fopen(hname,"w");
if ( fd == NULL )
{ perror(hname); break; }
for ( i = 0 ; i < S.N ; i++ )
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,i+1,1.0);
for ( j = S.LIA[i]+S.psize[i], k = S.LIJA[i]+S.psize[i] ;
j < S.LIA[i+1] ; j++,k++ )
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,S.LJA[k]+1,S.LA[j]);
}
}
fclose(fd);
strcpy(hname+baselength,"_D.dat");
sprintf(msg,
"Dumping diagonal factor in row col value format to %s.\n",hname);
outstring(msg);
if ( hname[0] == 0 ) break;
fd = fopen(hname,"w");
if ( fd == NULL )
{ perror(hname); break; }
for ( i = 0 ; i < S.N ; i++ )
{ j = S.LIA[i]; k = S.LIJA[i];
if ( S.psize[i] == 1 )
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,S.LJA[k]+1,S.LA[j]);
}
else
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,S.LJA[k]+1,S.LA[j]);
fprintf(fd,"%6d %6d %20.15f\n",i+1,S.LJA[k+1]+1,S.LA[j+1]);
fprintf(fd,"%6d %6d %20.15f\n",S.LJA[k+1]+1,i+1,S.LA[j+1]);
i++;
j = S.LIA[i]; k = S.LIJA[i];
fprintf(fd,"%6d %6d %20.15f\n",i+1,S.LJA[k]+1,S.LA[j]);
}
}
fclose(fd);
if ( !augmented_hessian_mode )
{ strcpy(hname+baselength,"_C.dat");
sprintf(msg,
"Dumping constraint matrix in row col value format to %s.\n",hname);
outstring(msg);
fd = fopen(hname,"w");
if ( fd == NULL )
{ perror(hname); break; }
for ( i = 0 ; i < S.CN ; i++ )
{ if ( S.CIA )
for ( j = S.CIA[i] ; j < S.CIA[i+1] ; j++ )
{ fprintf(fd,"%6d %6d %20.15f\n",i+1,S.CJA[j]+1,S.CA[j]);
}
else /* dense */
for ( j = 0 ; j < S.N ; j++ )
if ( S.C[i][j] )
fprintf(fd,"%6d %6d %20.15f\n",i+1,j+1,S.C[i][j]);
}
fclose(fd);
}
strcpy(hname+baselength,"_P.dat");
sprintf(msg,
"Dumping permutation in one line format to %s.\n",hname);
outstring(msg);
fd = fopen(hname,"w");
if ( fd == NULL )
{ perror(hname); break; }
for ( i = 0 ; i < S.N ; i++ )
{ fprintf(fd,"%6d",S.P[i]+1);
}
fprintf(fd,"\n");
fclose(fd);
}
break;
#ifdef MPI_EVOLVER
case 'A' :
mpi_hessian_fill_distrib(Mpi_RHS_MOVE);
printf("Done fill. Enter shift: ");
scanf("%lf",&S.lambda);
mpi_hessian_factor_distrib(&S);
printf("Done factoring. Inertia: pos %d, neg %d, zero %d\n",
S.pos,S.neg,S.zero);
mpi_solve_distrib(Mpi_LINSYS_HESSIAN, Mpi_RHS_MOVE, Mpi_SOLUTION_MOVE);
mpi_hessian_distrib_move(1.0,ACTUAL_MOVE);
#ifdef RANDOMRHS
mpi_create_random_rhs();
printf("Created random rhs\n");
mpi_solve_distrib(Mpi_LINSYS_HESSIAN, Mpi_RHS_RANDOM, Mpi_SOLUTION_RANDOM);
printf("Solved random rhs\n");
if ( S.lambda == 0.0 )
{ mpi_mult_hess_distrib(); /* check */
printf("Multiplied solution by original\n");
}
#endif
break;
#endif
default : outstring("Illegal choice.\n");
}
}
} /* end hessian_menu() */
/**************************************************************************
*
* function: hessian_legal()
*
* purpose: see if Hessian is legal for this surface.
*/
void hessian_legal()
{ int i;
body_id b_id;
if ( !quantities_only_flag )
{
if ( square_curvature_flag )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(2077,"The type of squared mean curvature in effect does not permit Hessian.\n", RECOVERABLE);
}
if ( optparamcount > 0 )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(2078,
"Hessian for optimizing parameters requires convert_to_quantities.\n",
RECOVERABLE);
}
if ( web.representation == SIMPLEX )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1597,"Hessian for simplex model requires convert_to_quantities.\n", RECOVERABLE);
}
for ( i = 0 ; i < web.maxcon ; i++ )
if ( get_constraint(i)->attr & CON_CONTENT )
{ if ( auto_convert_flag ) { convert_to_quantities(); break; }
else kb_error(1843,"Hessian for constraint content requires convert_to_quantities.\n",RECOVERABLE);
}
if ( web.symmetry_flag )
FOR_ALL_BODIES(b_id)
{ if ( get_battr(b_id) & FIXEDVOL )
{ if ( auto_convert_flag ) { convert_to_quantities(); break; }
else
kb_error(1844,"Cannot do torus body volumes with hessian. Do convert_to_quantities.\n",RECOVERABLE);
}
}
if ( web.modeltype != LINEAR )
{
if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1598,"Hessian for non-LINEAR models requires convert_to_quantities.\n",
RECOVERABLE);
}
if ( web.representation == STRING )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1599,
"Hessian for string model requires convert_to_quantities.\n",
RECOVERABLE);
}
if ( web.gravflag && (web.grav_const != 0.0))
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1601,
"Hessian method for gravity requires convert_to_quantities.\n",
RECOVERABLE);
}
if ( web.pressflag || web.pressure_flag )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1602,"Hessian with pressure in energy requires convert_to_quantities.\n", RECOVERABLE);
}
if ( web.wulff_flag )
kb_error(1603,"Cannot do Hessian method with crystalline integrand.\n", RECOVERABLE);
if ( web.convex_flag )
kb_error(1604,"Cannot do gap energy Hessian, since it would need third derivatives.\n", RECOVERABLE);
if ( web.metric_flag )
{ if ( auto_convert_flag ) convert_to_quantities(); else
kb_error(1605,"Hessian with Riemannian metric requires convert_to_quantities.\n", RECOVERABLE);
}
}
if ( count_fixed_vol() && !pressure_set_flag && !web.pressure_flag )
kb_error(1606,"Pressures invalid. Do regular iteration before Hessian to set pressures.\n",
RECOVERABLE);
}
/*****************************************************************************
*
* function: hessian_init()
*
* purpose: Allocate Hessian
*/
void hessian_init(S,rhs)
struct linsys *S;
REAL **rhs; /* right side, allocated by hessian_init */
{
vertex_id v_id;
int j,i,gam,a,b,m,n;
struct hess_verlist *v; /* current vertex */
int currow = 0;
MAT2D(grad,MAXCOORD,MAXCOORD);
MAT2D(gradcopy,MAXCOORD,MAXCOORD);
MAT2D(cc,MAXCOORD,MAXCOORD);
MAT2D(pp,MAXCOORD,MAXCOORD);
MAT2D(qq,MAXCOORD,MAXCOORD);
MAT2D(gg,MAXCOORD,MAXCOORD);
MAT3D(second,MAXCOORD,MAXCOORD,MAXCOORD);
REAL dummy;
int total_proj,vproj_count,total_conhess,vproj_alloc,conhess_alloc;
int vproj_spot,vcount;
REAL ***v_normal = NULL;
memset(S,0,sizeof(struct linsys));
hessian_legal();
/* in case this doesn't work */
if ( saved.coord == NULL )
local_save_coords(&saved,SAVE_IN_ATTR);
/* vertex attribute to hold vhead index */
vhead_attr = find_attribute(VERTEX,VHEAD_ATTR_NAME);
if ( vhead_attr < 0 )
{ int one = 1;
vhead_attr = add_attribute(VERTEX,VHEAD_ATTR_NAME,INTEGER_TYPE,
0,&one,0,NULL);
}
vhead_count = web.skel[VERTEX].max_ord+1;
vhead_count += optparamcount;
vhead_count += gen_quant_count;
if ( !everything_quantities_flag )
{ vhead_count += web.skel[BODY].max_ord+1;
bhead_attr = find_attribute(BODY,BHEAD_ATTR_NAME);
if ( bhead_attr < 0 )
{ int one = 1;
bhead_attr = add_attribute(BODY,BHEAD_ATTR_NAME,INTEGER_TYPE,
0,&one,0,NULL);
}
}
vhead = (struct hess_verlist*)temp_calloc(vhead_count,
sizeof(struct hess_verlist));
if ( hmode == NORMAL_MOTION ) v_normal = dmatrix3(vhead_count,SDIM,SDIM);
/* v_normal will use vhead_attr as index */
/* populate vertex list and count degrees of freedom */
total_proj = 0; /* count columns needed */
vproj_count = 0; /* number of vertices needing projection */
total_conhess = 0; /* count rows needed */
vcount = 0;
MFOR_ALL_VERTICES(v_id)
{ conmap_t * conmap;
int oncount;
int kk;
set_vertex_vhead(v_id,vcount); /* new way */
vcount++;
if ( get_vattr(v_id) & FIXED ) continue;
v = get_vertex_vhead(v_id); /* old way */
v->v_id = v_id;
if ( hmode == SINGLE_DEGREE )
v->freedom = 1;
else if ( get_vattr(v_id) & BOUNDARY )
{ struct boundary *bdry = get_boundary(v_id);
v->freedom = bdry->pcount;
total_proj += v->freedom;
vproj_count++;
total_conhess += v->freedom;
}
else /* possible level set constraints */
{
if ( hmode == NORMAL_MOTION )
{ REAL **norm = get_vertex_v_normal(v_id);
kk = new_calc_vertex_normal(v_id,norm);
kk = project_vertex_normals(v_id,norm,kk);
if ( kk < SDIM )
{ v->freedom = kk;
total_proj += kk;
vproj_count++;
}
else v->freedom = SDIM;
}
else /* v-proj still identity */
v->freedom = SDIM;
conmap = get_v_constraint_map(v_id);
if ( conmap[0] )
{ /* calculate size of projection matrix to fewer degrees of freedom */
for ( j = 1, oncount = 0; j <= (int)conmap[0] ; j++ )
{ if ( !(conmap[j] & CON_HIT_BIT) ) continue;
oncount++;
}
if ( v->freedom + oncount > SDIM )
{
total_proj += v->freedom;
vproj_count++;
}
/* now constraint hessian */
if ( oncount ) total_conhess += v->freedom;
}
}
} /* end FOR_ALL_VERTICES first time through */
vproj_base = (REAL**)mycalloc(vproj_count*SDIM,sizeof(REAL*));
vproj_space = (REAL*)mycalloc(total_proj*SDIM,sizeof(REAL));;
conhess_base = dmatrix3(total_conhess,SDIM-1,SDIM);
vproj_spot = vproj_alloc = conhess_alloc = 0;
/* populate vertex list vproj and conhess */
MFOR_ALL_VERTICES(v_id)
{ conmap_t * conmap;
int oncount;
v = get_vertex_vhead(v_id);
/* v->rownum = currow; */
v->slant = 1.0;
if ( v->freedom == 0 ) continue;
if ( hmode == SINGLE_DEGREE )
{}
else if ( get_vattr(v_id) & BOUNDARY )
{ struct boundary *bdry = get_boundary(v_id);
v->proj = vproj_base + vproj_alloc; vproj_alloc += SDIM;
for ( j = 0 ; j < SDIM ; j++ )
{ v->proj[j] = vproj_space + vproj_spot;
vproj_spot+= v->freedom;
}
v->conhess = conhess_base + conhess_alloc;
conhess_alloc += v->freedom;
for ( j = 0 ; j < SDIM ; j++ )
{ eval_second(bdry->coordf[j],get_param(v_id),bdry->pcount,&dummy,
v->proj[j],second[j],v_id);
for ( m = 0 ; m < bdry->pcount ; m++ )
for ( n = 0 ; n < bdry->pcount ; n++ )
v->conhess[m][n][j] = second[j][m][n];
}
}
else /* possible level set constraints */
{
if (v->freedom < SDIM) /* copy over normal basis */
{ REAL **vn = get_vertex_v_normal(v_id);
v->proj = vproj_base + vproj_alloc; vproj_alloc += SDIM;
for ( j = 0 ; j < SDIM ; j++ )
{ v->proj[j] = vproj_space + vproj_spot;
vproj_spot += v->freedom;
}
for ( j = 0 ; j < SDIM ; j++ )
for ( i = 0 ; i < v->freedom ; i++ )
v->proj[j][i] = vn[i][j];
}
conmap = get_v_constraint_map(v_id);
oncount = 0;
if ( conmap[0] )
{ /* calculate projection matrix to fewer degrees of freedom */
for ( j = 1; j <= (int)conmap[0] ; j++ )
{ struct constraint *constr;
if ( !(conmap[j] & CON_HIT_BIT) ) continue;
constr = get_constraint(conmap[j]);
eval_second(constr->formula,get_coord(v_id),SDIM,
&dummy, grad[oncount],second[oncount],v_id);
/* constraint value and derivs and hessian */
oncount++;
}
oncount = gram_schmidt(grad,oncount,SDIM);
if ( (v->freedom < SDIM) && (oncount > 0) ) /* normal or something */
{
/* project basis to constraints */
mat_mul_tr(grad,grad,gg,oncount,SDIM,oncount);
mat_inv(gg,oncount);
mat_mult(grad,v->proj,pp,oncount,SDIM,v->freedom);
mat_mult(gg,pp,qq,oncount,oncount,v->freedom);
tr_mat_mul(grad,qq,pp,oncount,SDIM,v->freedom);
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < v->freedom ; j++ )
v->proj[i][j] -= pp[i][j];
}
else if ( oncount > 0 )
{ v->freedom = SDIM - oncount;
if ( v->freedom <= 0 ) continue;
v->proj = vproj_base + vproj_alloc; vproj_alloc += SDIM;
for ( j = 0 ; j < SDIM ; j++ )
{ v->proj[j] = vproj_space + vproj_spot;
vproj_spot += v->freedom;
}
for ( m = 0 ; m < oncount ; m++ )
for ( n = 0 ; n < SDIM ; n++ ) gradcopy[m][n] = grad[m][n];
kernel_basis(gradcopy,v->proj,oncount,SDIM);
}
}
/* orthonormalize proj */
if ( v->proj )
{ for ( i = 0 ; i < v->freedom ; i++ )
{ /* subtract previous components */
REAL sum;
for ( j = 0 ; j < i ; j++ )
{ for ( n = 0, sum = 0.0 ; n < SDIM ; n++ )
sum += v->proj[n][j]*v->proj[n][i];
for ( n = 0 ; n < SDIM ; n++ )
v->proj[n][i] -= sum*v->proj[n][j];
}
/* normalize */
for ( n = 0, sum = 0.0 ; n < SDIM ; n++ )
sum += v->proj[n][i]*v->proj[n][i];
sum = sqrt(sum);
if ( sum > hessian_epsilon )
for ( n = 0 ; n < SDIM ; n++ ) v->proj[n][i] /= sum;
else /* have to skip this direction */
{ for ( n = 0 ; n < SDIM ; n++ )
v->proj[n][i] = v->proj[n][v->freedom-1];
v->freedom--;
i--;
}
}
if ( (hessian_normal_flag && (v->freedom == 1)) || hessian_double_normal_flag)
{ /* get cosine of normal and degree of freedom */
REAL *nor = get_vertex_v_normal(v_id)[0];
v->slant = 0.0;
for ( i = 0 ; i < SDIM ; i++ )
v->slant += v->proj[i][0]*nor[i];
v->slant /= sqrt(SDIM_dot(nor,nor));
if ( v->slant < hessian_slant_cutoff )
v->freedom = 0;
}
}
/* now constraint hessian */
if ( oncount )
{ v->conhess = conhess_base + conhess_alloc;
conhess_alloc += v->freedom;
mat_tsquare(grad,cc,oncount,SDIM);
mat_inv(cc,oncount);
for ( gam = 0 ; gam < SDIM ; gam++ )
for ( a = 0 ; a < v->freedom ; a++ )
for ( b = 0 ; b < v->freedom ; b++ )
{ REAL sum;
for ( sum = 0.0, i = 0 ; i < oncount ; i++ )
for ( j = 0 ; j < oncount ; j++ )
for ( m = 0 ; m < SDIM ; m++ )
for ( n = 0 ; n < SDIM ; n++ )
sum += grad[j][gam]*cc[j][i]*v->proj[m][a]*second[i][m][n]
*v->proj[n][b];
v->conhess[a][b][gam] = -sum;
}
}
} /* end level set constraints */
if ( hessian_double_normal_flag && v->proj )
{ REAL sum;
int k;
/* special kludge to give double-dimension perturbations the
same normal space as regular dimensions. See spin4d.fe
for example of use. */
for ( i = 0 ; i < v->freedom ; i++ )
{ /* assume low dim normals are first */
for ( j = 0, sum = 0.0 ; j < SDIM/2 ; j++ )
sum += v->proj[j][i]*v->proj[j][i];
if ( sum < 1e-6 ) break;
}
/* copy over low dim basis to high dim, with transform */
for ( k = 0 ; k < i ; k++ )
for ( j = 0 ; j < SDIM/2 ; j++ )
{ v->proj[j][i+k] = v->proj[j+SDIM/2][k];
v->proj[j+SDIM/2][i+k] = v->proj[j][k];
}
v->freedom = 2*i;
}
if ( hess_debug && v->proj )
{ printf("v_id %s proj\n",ELNAME(v_id));
for ( j = 0 ; j < v->freedom ; j++ )
{ for ( m = 0 ; m < SDIM ; m++ ) printf("%f ",(DOUBLE)v->proj[m][j]);
printf("\n");
}
}
} /* end FOR_ALL_VERTICES second time through */
if ( v_normal ) free_matrix3(v_normal);
/* assign row numbers */
for ( i = 0, v = vhead, currow = 0 ; i < vhead_count ; i++,v++ )
{ v->rownum = currow;
currow += v->freedom;
}
/* check */
if ( (vproj_alloc > vproj_count*SDIM) || (vproj_spot > total_proj*SDIM) ||
(conhess_alloc > total_conhess) )
kb_error(1608,"Internal error, hessian_init(): Overflow of vproj or conhess arena.\n",RECOVERABLE);
/* low_rank update stuff */
if ( quantity_function_sparse_flag )
{
for ( i = LOW_INST ; i < meth_inst_count ; i++ )
{ struct method_instance *mi = METH_INSTANCE(i);
if ( mi->flags & Q_COMPOUND )
if ( GEN_QUANT(mi->quant)->flags & (Q_ENERGY|Q_FIXED|Q_CONSERVED) )
{
mi->global_low_rank = S->low_rank;
S->low_rank++;
}
}
S->low_rank_vecsize = currow;
S->low_rank_vectors = dmatrix(0,S->low_rank,0,currow);
S->low_rank_form = dmatrix(0,S->low_rank,0,S->low_rank);
S->low_rank_inverse_form = dmatrix(0,S->low_rank,0,S->low_rank);
}
/* rows for optimizing parameters */
S->optparamrowstart = vertex_rows = currow;
for ( i = 0 ; i < optparamcount ; i++)
{
optparam[i].vhead_index = i + web.skel[VERTEX].max_ord+1;
v = vhead + optparam[i].vhead_index;
v->rownum = currow;
v->freedom = 1;
optparam[i].rownum = currow++;
}
/* allocate matrix */
S->A_rows = S->bodyrowstart = currow;
/* S->A_rows is variables, before constraints */
if ( everything_quantities_flag )
S->quanrowstart = currow;
else
S->quanrowstart = currow + web.skel[BODY].max_ord+1;
S->total_rows = S->quanrowstart + gen_quant_count;
/* take care of torus_filled */
if ( web.full_flag ) /* pretend one body info only */
{ body_id b_id;
int found = 0;
FOR_ALL_BODIES(b_id)
{ if ( (get_battr(b_id) & FIXEDVOL) && !found )
{ if ( everything_quantities_flag )
GEN_QUANT(get_body_volquant(b_id))->flags |= Q_REDUNDANT;
else set_attr(b_id,REDUNDANT_BIT);
found = 1;
}
else
{ if ( everything_quantities_flag )
GEN_QUANT(get_body_volquant(b_id))->flags &= ~Q_REDUNDANT;
else unset_attr(b_id,REDUNDANT_BIT);
}
}
}
/* figure out which bodies and quantities are constraints */
S->concount = web.skel[BODY].max_ord+1 + gen_quant_count;
S->coninx = (int*)temp_calloc(S->concount,sizeof(int));
S->coninxinv = (int*)temp_calloc(S->concount,sizeof(int));
S->CN = 0;
{ if ( !everything_quantities_flag )
{ body_id b_id;
FOR_ALL_BODIES(b_id)
{ int a = get_battr(b_id);
set_body_vhead(b_id,web.skel[VERTEX].max_ord+1 + loc_ordinal(b_id));
v = get_body_vhead(b_id);
if ( (a & (FIXEDVOL|PRESSURE)) && !(a & REDUNDANT_BIT) )
{
v->v_id = b_id;
v->freedom = 1;
S->coninx[loc_ordinal(b_id)] = S->CN;
S->coninxinv[S->CN] = loc_ordinal(b_id);
S->CN++;
}
else S->coninx[loc_ordinal(b_id)] = -1;
}
FOR_ALL_BODIES(b_id)
{ v = get_body_vhead(b_id);
v->rownum = currow;
currow += v->freedom;
}
}
else S->concount = gen_quant_count;
for ( n = 0 ; n < gen_quant_count ; n++,v++ )
{ int nn = everything_quantities_flag ? n : web.skel[BODY].max_ord+1 + n ;
GEN_QUANT(n)->vhead_index = web.skel[VERTEX].max_ord+1+optparamcount+nn;
v = vhead + GEN_QUANT(n)->vhead_index;
v->rownum = currow;
v->v_id = n;
if ( (GEN_QUANT(n)->flags & (Q_FIXED|Q_CONSERVED) ) &&
!(GEN_QUANT(n)->flags & Q_REDUNDANT) )
{
v->freedom = 1;
currow++;
S->coninx[nn] = S->CN;
S->coninxinv[S->CN] = nn;
S->CN++;
}
else S->coninx[nn] = -1;
}
}
/* figure whether to do constraints as augmentation or separately */
if ( augmented_hessian_flag < 0 )
{ augmented_hessian_mode = (sparse_constraints_flag && (S->CN >= 50)) ? 1 : 0;
}
else augmented_hessian_mode = augmented_hessian_flag;
pressures = (REAL*)temp_calloc(web.skel[BODY].max_ord+1+gen_quant_count,
sizeof(REAL));
conrhs = (REAL*)temp_calloc(web.skel[BODY].max_ord+1+gen_quant_count,
sizeof(REAL));
/* allocate right hand side and solution of augmented matrix */
if ( rhs ) *rhs = (REAL *)temp_calloc(S->total_rows,sizeof(REAL));
S->P = (int *)temp_calloc(S->total_rows,sizeof(int));
S->IP = (int *)temp_calloc(S->total_rows,sizeof(int));
/* initialize hash table */
sp_hash_init(S,0);
/* tell solvers element data is appropriate */
S->flags |= S_USE_ELEMENTS;
} /* end hessian_init */
/*************************************************************************
*
* function: hessian_fill()
*
* purpose: call routines that calculate hessian.
*/
void hessian_fill(S,rhsptr)
struct linsys *S;
REAL **rhsptr;
{ int k;
body_id b_id;
REAL *rhs = rhsptr ? *rhsptr : NULL;
#ifdef MPI_EVOLVER
if ( this_task == 0 )
{ mpi_hessian_fill(S,rhsptr);
temp_free((char*)S->hashtable); /* since not calling hash_end() */
rhs = rhsptr ? *rhsptr : NULL; /* mpi_hessian_fill reallocates it */
goto rhs_constraints;
}
#endif
/* clear entries */
if ( rhs_flag ) memset((char*)rhs,0,S->total_rows*sizeof(REAL));
/* fill in hessian */
if ( hessian_by_diff_flag )
{ /* hessian by crude numeric difference formulas */
difference_hessian(S,vhead,rhs);
if ( optparamcount ) optparamhess(S,rhs);
}
else /* hessian by explicit formulas */
{
if ( !quantities_only_flag )
{
if ( web.symmetry_flag && !web.torus_flag )
{ if ( auto_convert_flag ) {convert_to_quantities(); goto quantplace;}
else
kb_error(2079,
"Must do convert_to_quantities to do Hessian with symmetry group.\n",
RECOVERABLE);
}
if ( web.representation == SIMPLEX )
simplex_hessian(S,rhs);
else
{ if ( web.representation == SOAPFILM )
area_hessian(S,rhs);
edge_energy_hessian(S,rhs);
}
}
quantplace:
if ( gen_quant_count )
calc_quant_hess(S,rhs_flag,hess_flag,rhs);
if ( !quantities_only_flag )
if ( web.bodycount > web.full_flag )
body_hessian(S,rhs);
if ( optparamcount ) optparamhess(S,rhs);
}
if ( hess_flag )
{
/* extract stuff from hash table */
if ( sparse_constraints_flag )
sp_hash_end(S,S->total_rows,S->total_rows,A_OFF);
else
sp_hash_end(S,S->A_rows,S->total_rows,A_OFF);
}
#ifdef MPI_EVOLVER
rhs_constraints:
#endif
/* rhs for body constraint rows */
if ( rhs && !everything_quantities_flag )
FOR_ALL_BODIES(b_id)
{ REAL *current = rhs + S->bodyrowstart + loc_ordinal(b_id);
if ( get_battr(b_id) & FIXEDVOL )
*current = -(get_body_fixvol(b_id) - get_body_volume(b_id));
}
/* rhs for quantity constraint rows */
if ( rhs )
for ( k = 0 ; k < gen_quant_count ; k++ )
{ struct gen_quant *q = GEN_QUANT(k);
if ( q->flags & Q_FIXED )
rhs[S->quanrowstart + k] = -(q->target - q->value);
}
} /* end hessian_fill() */
/***********************************************************************
*
* function: hessian_move()
*
* purpose: move vertices by given stepsize times current vector
*/
void hessian_move(stepsize,mode,X)
REAL stepsize;
int mode; /* ACTUAL_MOVE or TEST_MOVE or SET_VELOCITY */
REAL *X; /* direction */
{
int i,j;
struct hess_verlist *vc; /* current vertex */
vertex_id v_id;
last_hessian_scale = stepsize;
/* change optimizing parameters */
for ( i = 0 ; i < optparamcount ; i++ )
{ optparam[i].velocity = X[optparam[i].rownum];
if ( mode != SET_VELOCITY )
globals(optparam[i].pnum)->value.real += stepsize*X[optparam[i].rownum];
}
/* move vertices */
#ifdef MPI_EVOLVER
if ( this_task == 0 )
mpi_hessian_move(stepsize,mode,X);
else
#endif
FOR_ALL_VERTICES(v_id)
{
REAL *coord;
REAL *velocity;
vc = get_vertex_vhead(v_id);
if ( vc->freedom <= 0 ) continue;
coord = get_coord(v_id);
velocity = get_velocity(v_id);
if ( get_vattr(v_id) & BOUNDARY )
{ struct boundary *boundary = get_boundary(v_id);
int pcount = boundary->pcount;
REAL *param = get_param(v_id);
for ( i = 0 ; i < pcount ; i++ )
{ velocity[i] = X[vc->rownum + i];
if ( mode != SET_VELOCITY )
param[i] += stepsize*X[vc->rownum + i];
}
if ( mode != SET_VELOCITY )
for ( i = 0 ; i < SDIM ; i++ )
coord[i] = eval(boundary->coordf[i],param,v_id,NULL);
}
else
{ for ( j = 0 ; j < SDIM ; j++ )
if ( vc->proj )
{ velocity[j] = dot(vc->proj[j],X+vc->rownum,vc->freedom);
if ( mode != SET_VELOCITY )
coord[j] += stepsize*dot(vc->proj[j],X+vc->rownum,vc->freedom);
}
else
{ velocity[j] = X[vc->rownum + j];
if ( mode != SET_VELOCITY )
coord[j] += stepsize*X[vc->rownum + j];
}
}
}
#ifdef MPI_EVOLVER
if ( this_task != 0 ) return;
#endif
if ( mode == SET_VELOCITY ) return;
if ( hess_move_con_flag )
{
calc_all_grads(CALC_VOLGRADS);
project_all(hess_move_con_flag /* all constraints */,mode);
vgrad_end();
}
else
project_all(hess_move_con_flag /* all constraints ? */,mode);
global_timestamp++;
calc_energy(); /* energy after motion */
} /* end hessian_move() */
/**************************************************************************
*
* function: hessian_exit()
*
* purpose: clean up after hessian stuff.
*/
void hessian_exit(X)
REAL *X; /* direction, if any */
{ int j;
struct hess_verlist *vc; /* current vertex */
vertex_id v_id;
hess_debug = 0;
/* store move in vertex force */
if ( X && vhead )
FOR_ALL_VERTICES(v_id)
{
REAL *f;
vc = get_vertex_vhead(v_id);
if ( vc->freedom <= 0 ) continue;
f = get_force(v_id);
if ( get_vattr(v_id) & BOUNDARY )
{ struct boundary *boundary = get_boundary(v_id);
int pcount = boundary->pcount;
for ( j = 0 ; j < pcount ; j++ )
f[j] = X[vc->rownum + j];
}
else
{ for ( j = 0 ; j < SDIM ; j++ )
if ( vc->proj )
f[j] = dot(vc->proj[j],X+vc->rownum,vc->freedom);
else
f[j] = X[vc->rownum + j];
}
}
hessian_cleanup();
}
/************************************************************************
*
* function: sp_hessian_mult
*
* purpose: multiply Hessian times vector
*/
void sp_hessian_mult(S,B,C)
struct linsys *S;
REAL *B; /* incoming vector */
REAL *C; /* product */
{ int i,j;
if ( S->lambda != 0.0 )
{
if ( hessian_linear_metric_flag )
{ for ( j = 0 ; j < Met.N ; j++ ) C[j] = 0.0;
for ( i = 0 ; i < Met.N ; i++ )
{ for ( j = Met.IA[i] ; j < Met.IA[i+1] ; j++ )
{ int jj = Met.JA[j-A_OFF] - A_OFF;
C[i] -= S->lambda*Met.A[j-A_OFF]*B[jj];
if ( i != jj )
C[jj] -= S->lambda*Met.A[j-A_OFF]*B[i];
}
}
}
else if ( augmented_hessian_mode )
{ for ( i = 0 ; i < S->A_rows ; i++ )
C[i] = -S->lambda*B[i];
for ( ; i < S->N ; i++ )
C[i] = 0.0;
}
else
for ( i = 0 ; i < S->N ; i++ )
C[i] = -S->lambda*B[i];
}
for ( i = 0 ; i < S->N ; i++ )
{ for ( j = S->IA[i] ; j < S->IA[i+1] ; j++ )
{ int jj = S->JA[j-A_OFF] - A_OFF;
C[i] += S->A[j-A_OFF]*B[jj];
if ( i != jj )
C[jj] += S->A[j-A_OFF]*B[i];
}
}
/* Add low-rank stuff */
if ( S->low_rank )
{ REAL *Y = (REAL*)temp_calloc(S->low_rank,sizeof(REAL));
REAL *W = (REAL*)temp_calloc(S->low_rank,sizeof(REAL));
REAL *Z = (REAL*)temp_calloc(S->N,sizeof(REAL));
matvec_mul(S->low_rank_vectors,B,Y,S->low_rank,S->low_rank_vecsize);
matvec_mul(S->low_rank_form,Y,W,S->low_rank,S->low_rank);
vec_mat_mul(W,S->low_rank_vectors,Z,S->low_rank,S->low_rank_vecsize);
for ( i = 0 ; i < S->low_rank_vecsize ; i++ )
C[i] += Z[i];
temp_free((char*)Y);
temp_free((char*)W);
temp_free((char*)Z);
}
}
/*********************************************************************
*
* function: hessian_cleanup()
*
* purpose: free memory allocated for hessian stuff.
*
*/
void hessian_cleanup()
{
#ifdef MPI_EVOLVER
if ( this_task == 0 )
{ mpi_hessian_cleanup();
}
#endif
if ( vhead ) temp_free((char *)vhead); vhead = NULL;
if ( vproj_base ) myfree((char*)vproj_base); vproj_base = NULL;
if ( vproj_space ) myfree((char*)vproj_space); vproj_space = NULL;
if ( conhess_base ) free_matrix3(conhess_base); conhess_base = NULL;
local_unsave_coords(&saved,SAVE_IN_ATTR);
if ( pressures ) temp_free((char*)pressures); pressures = NULL;
if ( conrhs ) temp_free((char*)conrhs); conrhs = NULL;
if ( ritzvecs ) free_matrix(ritzvecs); ritz_done_flag = 0; ritzvecs = NULL;
return;
}
/********************************************************************
*
* function: write_hessian()
*
* purpose: Write hessian to file in format suitable for
* wet cone investigations.
*/
void write_hessian(S)
struct linsys *S;
{
FILE *fd;
char name[100];
int i,j,n,row;
struct hess_verlist *v;
vertex_id v_id;
prompt("Enter hessian file name: ",name,sizeof(name));
fd = fopen(name,"w");
if ( fd == NULL )
{ perror(name); return; }
/* size info */
fprintf(fd,"%d space dimension\n",SDIM);
fprintf(fd,"%d rows\n",S->N);
fprintf(fd,"%d entries\n",S->IA[S->N]-A_OFF);
if ( hessian_linear_metric_flag )
{ fprintf(fd,"%d metric rows\n",Met.N);
fprintf(fd,"%d metric entries\n",Met.IA[S->N]-A_OFF);
}
else
{ fprintf(fd,"%d metric rows\n",0);
fprintf(fd,"%d metric entries\n",0);
}
fprintf(fd,"%d constraints\n",S->CN);
/* per row info:
point coords, basis vectors for each degree of freedom,
*/
FOR_ALL_VERTICES(v_id)
{ REAL *x = get_coord(v_id);
v = get_vertex_vhead(v_id);
for ( j = 0 ; j < v->freedom ; j++ )
{ fprintf(fd,"%d ",v->rownum+j);
for ( n = 0 ; n < SDIM ; n++ ) fprintf(fd," %21.15e",(DOUBLE)x[n]);
if ( v->proj )
for ( n = 0 ; n < SDIM ; n++ )
fprintf(fd," %21.15e",(DOUBLE)v->proj[n][j]);
else
for ( n = 0 ; n < SDIM ; n++ ) fprintf(fd," %d",n==j);
fprintf(fd,"\n");
}
}
/* the Hessian */
FOR_ALL_VERTICES(v_id)
{
v = get_vertex_vhead(v_id);
if ( v->freedom == 0 ) continue;
for ( row = v->rownum ; row < v->rownum + v->freedom ; row++ )
{ int start = S->IA[row]-A_OFF;
int end = S->IA[row+1] - A_OFF;
for ( j = start ; j < end ; j++ )
fprintf(fd,"%d %d %21.15e\n",row,S->JA[j]-A_OFF,(DOUBLE)S->A[j]);
}
}
/* the metric */
if (hessian_linear_metric_flag)
FOR_ALL_VERTICES(v_id)
{
v = get_vertex_vhead(v_id);
if ( v->freedom == 0 ) continue;
for ( row = v->rownum ; row < v->rownum + v->freedom ; row++ )
{ int start = Met.IA[row]-A_OFF;
int end = Met.IA[row+1] - A_OFF;
for ( j = start ; j < end ; j++ )
fprintf(fd,"%d %d %21.15e\n",row,Met.JA[j]-A_OFF,(DOUBLE)Met.A[j]);
}
}
/* constraints */
for ( i = 0 ; i < S->CN ; i++ )
for ( j = 0 ; j < S->N ; j++ )
fprintf(fd,"%d %d %21.15e\n",i,j,(DOUBLE)S->C[i][j]);
fclose(fd);
}
/**********************************************************************
*
* function: optparamhess()
*
* purpose: fill in hessian and right side for optimizing parameter rows.
*
* method: finite differences
*/
void optparamhess(S,rhs)
struct linsys *S;
REAL *rhs; /* right side */
{ int i,j,m;
struct oldcoord csaved;
REAL *fake_rhs; /* for grad differences */
REAL *temprow; /* for accumulating row values */
struct gen_quant *q;
if ( optparamcount <= 0 ) return;
if ( !everything_quantities_flag )
kb_error(2080,"Hessian for optimizing parameters requires convert_to_quantities.\n",
RECOVERABLE);
fake_rhs = (REAL*)temp_calloc(S->total_rows,sizeof(REAL));
temprow = (REAL*)temp_calloc(S->total_rows,sizeof(REAL));
csaved.coord = NULL;
save_coords(&csaved,SAVE_SEPARATE);
for ( i = 0 ; i < optparamcount ; i++ )
{ REAL dp;
REAL emid = web.total_energy;
REAL eleft,eright;
restore_coords(&csaved,SAVE_SEPARATE);
calc_energy(); calc_content(Q_FIXED);
emid = web.total_energy;
dp = globals(optparam[i].pnum)->attr.varstuff.delta;
memset((char*)fake_rhs,0,S->total_rows*sizeof(REAL));
memset((char*)temprow ,0,S->total_rows*sizeof(REAL));
/* for optimizing parameter self hessian */
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
{ sp_hash_search(S,optparam[i].rownum,optparam[i].rownum,
-q->pressure*( - 2*q->value )/dp/dp);
}
}
/* right difference */
globals(optparam[i].pnum)->value.real += dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
calc_quant_hess(S,1,0,temprow);
eright = web.total_energy;
calc_volgrads(NO_OPTS); /* global constraint hessians */
/* for global constraints */
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
{ sp_hash_search(S,optparam[i].rownum,optparam[i].rownum,
-q->pressure*( q->value )/dp/dp);
sp_hash_search(S,optparam[i].rownum,S->quanrowstart+m,
q->value/dp/2);
if ( rhs ) rhs[optparam[i].rownum] += q->pressure*q->value/dp/2;
}
}
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
/* left difference */
globals(optparam[i].pnum)->value.real -= dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
calc_quant_hess(S,1,0,fake_rhs);
eleft = web.total_energy;
calc_volgrads(NO_OPTS); /* global constraint hessians */
/* for global constraints */
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
{ sp_hash_search(S,optparam[i].rownum,optparam[i].rownum,
-q->pressure*( q->value )/dp/dp);
sp_hash_search(S,optparam[i].rownum,S->quanrowstart+m,
-q->value/dp/2);
if ( rhs ) rhs[optparam[i].rownum] -= q->pressure*q->value/dp/2;
}
}
vgrad_end();
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
web.total_energy = emid; /* restore */
if ( rhs )
rhs[optparam[i].rownum] += -(eright - eleft)/2/dp; /* rhs is neg grad */
/* vertex-param cross terms */
for ( j = 0 ; j < vertex_rows ; j++ )
sp_hash_search(S,j,optparam[i].rownum,(fake_rhs[j]-temprow[j])/2/dp);
sp_hash_search(S,optparam[i].rownum,optparam[i].rownum,
(eright - 2*emid + eleft)/dp/dp);
}
temp_free((char*)fake_rhs);
temp_free((char*)temprow);
/* optimizing parameter mixed terms */
for ( i = 0 ; i < optparamcount ; i++ )
for ( j = 0 ; j < i ; j++ )
{ REAL dp;
REAL vmid = globals(optparam[i].pnum)->value.real;
REAL emid = web.total_energy;
REAL ehihi,ehilo,elohi,elolo;
if ( fabs(vmid) > 1. ) dp = fabs(vmid)*1e-3;
else dp = 1e-3;
/* + + difference */
globals(optparam[i].pnum)->value.real += dp;
globals(optparam[j].pnum)->value.real += dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
ehihi = web.total_energy;
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
sp_hash_search(S,optparam[j].rownum,optparam[i].rownum,
-q->pressure*( q->value )/dp/dp/4);
}
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
/* + - difference */
globals(optparam[i].pnum)->value.real += dp;
globals(optparam[j].pnum)->value.real -= dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
ehilo = web.total_energy;
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
sp_hash_search(S,optparam[j].rownum,optparam[i].rownum,
-q->pressure*(-q->value )/dp/dp/4);
}
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
/* - + difference */
globals(optparam[i].pnum)->value.real -= dp;
globals(optparam[j].pnum)->value.real += dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
elohi = web.total_energy;
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
sp_hash_search(S,optparam[j].rownum,optparam[i].rownum,
-q->pressure*(-q->value )/dp/dp/4);
}
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
/* - - difference */
globals(optparam[i].pnum)->value.real -= dp;
globals(optparam[j].pnum)->value.real -= dp;
project_all(0, TEST_MOVE);
if ( fixed_constraint_flag || web.pressure_flag || web.pressflag )
calc_content(Q_FIXED);
calc_energy(); /* energy after motion */
elolo = web.total_energy;
for ( m = 0 ; m < gen_quant_count ; m++ )
{ q = GEN_QUANT(m);
if ( q->flags & Q_FIXED )
sp_hash_search(S,optparam[j].rownum,optparam[i].rownum,
-q->pressure*( q->value )/dp/dp/4);
}
restore_coords(&csaved,SAVE_SEPARATE); /* also restores opt params */
web.total_energy = emid; /* restore */
sp_hash_search(S,optparam[j].rownum,optparam[i].rownum,
(ehihi-ehilo-elohi+elolo)/dp/dp/4);
}
unsave_coords(&csaved,SAVE_SEPARATE);
} /* end optparamhess() */
evolver-2.30c.dfsg/src/torus.c 0000644 0001753 0001753 00000013147 11410765113 016543 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: torus.c
*
* Purpose: Functions dealing with symmetries of surface.
* Has the three functions for torus.
* If user wants to define his/her own symmetry
* group, write a file like this and put function
* names in registry.c.
*
*/
#include "include.h"
/*
Group elements are encoded in two-bit fields in "wrap",
one for each dimension, with "000001b" for positive wrap
and "011111b" for negative wrap. You are free to encode
any way you want, but use wrap = 0 for the identity.
*/
/* specific case of torus symmetry representation */
/* these also defined in extern.h since torus built-in */
#ifndef TWRAPBITS
#define TWRAPBITS 6
#define POSWRAP 1
#define WRAPMASK 037
#define ALLWRAPMASK 03737373737
#define NEGWRAP WRAPMASK
#define WRAPNUM(x) ( (x)>(1<<(TWRAPBITS-2)) ? (x)-(1<<(TWRAPBITS-1)) : (x))
#endif
#define TERRDETECT 06060606060
/*******************************************************************
*
* function: torus_wrap
*
* purpose: Provide adjusted coordinates for vertices that get
* wrapped around torus. Serves as example for user-written
* symmetry function.
*
* This function uses the values of the torus periods read
* in from the data file.
*/
void torus_wrap(x,y,wrap)
REAL *x; /* original coordinates */
REAL *y; /* wrapped coordinates */
WRAPTYPE wrap; /* encoded symmetry group element, TWRAPBITS bits per dimension */
{
int i,j;
int wrapnum;
if ( x != y )
for ( i = 0 ; i < SDIM ; i++ ) y[i] = x[i];
for ( i = 0 ; wrap != 0 ; i++, wrap >>= TWRAPBITS )
{ wrapnum = WRAPNUM(wrap & WRAPMASK);
if ( wrapnum )
for ( j = 0 ; j < SDIM ; j++ )
y[j] += wrapnum*web.torus_period[i][j];
}
}
/*******************************************************************
*
* function: torus_form_pullback
*
* purpose: Pull back differentail forms at vertices that get
* wrapped around torus. Serves as example for user-written
* symmetry function.
*
* Torus is flat, so implementation is trivial copy.
*/
void torus_form_pullback(x,xform,yform,wrap)
REAL *x; /* original coordinates */
REAL *xform; /* pulled back form */
REAL *yform; /* wrapped form, input */
WRAPTYPE wrap; /* encoded symmetry group element, 3 bits per dimension */
{
memcpy((char*)xform,(char*)yform,SDIM*sizeof(REAL));
}
/********************************************************************
*
* function: torus_compose()
*
* purpose: do composition of two group elements
*
*/
WRAPTYPE torus_compose(wrap1,wrap2)
WRAPTYPE wrap1,wrap2; /* the elements to compose */
{ int w = (wrap1 + wrap2) & ALLWRAPMASK;
#ifdef _DEBUG
int i;
int ww = w;
if ( verbose_flag )
for ( i = 0, ww=w ; i < SDIM ; i++ )
{ switch(ww&WRAPMASK)
{ case 0: case POSWRAP: case NEGWRAP: break;
default: kb_error(3917,"Bad wrap as result of torus_compose.\n",
WARNING);
}
ww >>= TWRAPBITS;
}
#endif
if ( ~(wrap1|wrap2) & TERRDETECT & w )
kb_error(4553,"Wrap out of bounds as result of torus_compose.\n",
WARNING);
return w;
}
/********************************************************************
*
* function: torus_inverse()
*
* purpose: return inverse of group element.
*
*/
WRAPTYPE torus_inverse(wrap)
WRAPTYPE wrap; /* the element invert */
{
return ((~ALLWRAPMASK)-wrap) & ALLWRAPMASK;
}
/*********************************************************************
*
* function: torus_edge_unwrap()
*
* purpose: get wrap of edge to 0 (preliminary to deletion or other
* topology change) so endpoints near as possible in
* a fundamental region.
*/
void torus_unwrap_edge(e_id)
edge_id e_id;
{ edge_id pos_e = positive_id(e_id);
vertex_id tailv,headv;
REAL *x;
WRAPTYPE wrap = get_edge_wrap(pos_e);
WRAPTYPE tailwrap,headwrap;
REAL u[MAXCOORD]; /* tail unit cell coords */
int i;
if ( wrap == 0 ) return;
tailv = get_edge_tailv(pos_e);
headv = get_edge_headv(pos_e);
x = get_coord(tailv);
matvec_mul(web.inverse_periods,x,u,SDIM,SDIM);
tailwrap = 0;
for ( i = SDIM-1 ; i >= 0 ; i-- )
{ tailwrap <<= TWRAPBITS;
tailwrap |= ((int)(floor(u[i]))) & WRAPMASK;
}
tailwrap = torus_inverse(tailwrap);
headwrap = torus_compose(tailwrap,wrap);
wrap_vertex(tailv,tailwrap);
wrap_vertex(headv,headwrap);
}
/*************************************************************
*
* Functions: Identity symmetry functions.
*/
void identity_wrap(x,y,wrap)
REAL *x; /* original coordinates */
REAL *y; /* wrapped coordinates */
WRAPTYPE wrap; /* encoded symmetry group element, TWRAPBITS bits per dimension */
{
int i;
if ( x != y )
for ( i = 0 ; i < SDIM ; i++ )
y[i] = x[i];
}
void identity_form_pullback(x,xform,yform,wrap)
REAL *x; /* original coordinates */
REAL *xform; /* pulled back form */
REAL *yform; /* wrapped form, input */
WRAPTYPE wrap; /* encoded symmetry group element, 3 bits per dimension */
{
memcpy((char*)xform,(char*)yform,SDIM*sizeof(REAL));
}
WRAPTYPE identity_compose(wrap1,wrap2)
WRAPTYPE wrap1,wrap2; /* the elements to compose */
{ return 0;
}
WRAPTYPE identity_inverse(wrap)
WRAPTYPE wrap; /* the element invert */
{
return 0;
}
void identity_unwrap_edge(e_id)
edge_id e_id;
{} evolver-2.30c.dfsg/src/method2.c 0000644 0001753 0001753 00000125450 11410765113 016732 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* file: method2.c
*
* contents: quantities for facets
*/
#include "include.h"
/*********************************************************************
Facet area quantity
Linear simplex volume:
Let S[i][j] be side i vector.
Let U[i][j] = L[i][k]*S[k][j] be orthogonalized version.
Let diag[i] = U[i]*U[i].
Let det = det(diag).
Let D = diag^-1.
Then area = sqrt(det)/n!
d(area)/dS[i][j] = area*(L^T D U)[i][j]
dd(area)/dS[i][j]dS[k][l] = area*( (L^T D L)[i][k]*I[j][l]
- (L^T D L)[i][k]*(U^T D U)[j][l] + (L^T D U)[i][j]*(L^T D U)[k][l]
- (L^T D U)[k][j]*(L^T D U)[i][l])
*********************************************************************/
/*********************************************************************
*
* function: q_facet_tension_init()
*
* purpose: initialize web.total_area to 0.
*/
void q_facet_tension_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
/* if ( everything_quantities_flag && (mode==METHOD_VALUE) ) web.total_area = 0.0; */
}
/*********************************************************************
*
* function: q_facet_tension_value()
*
* purpose: General quantity value of facet tension.
*/
REAL q_facet_tension_value(f_info)
struct qinfo *f_info;
{ REAL area;
int i,j,k;
REAL diag[MAXCOORD];
REAL D[MAXCOORD]; /* diag^-1 */
REAL U[MAXCOORD][MAXCOORD];
if ( web.modeltype == QUADRATIC ) return q_facet_tension_q(f_info);
if ( web.modeltype == LAGRANGE )
return lagrange_facet_tension_value(f_info);
/* new way, using Gram-Schmidt */
area = 1.0;
for ( i = 0 ; i < web.dimension ; i++ )
{ for ( j = 0 ; j < SDIM ; j++ ) U[i][j] = f_info->sides[0][i][j];
for ( j = 0 ; j < i ; j++ )
{ REAL su = SDIM_dot(f_info->sides[0][i],U[j])*D[j];
for ( k = 0 ; k < SDIM ; k++ ) U[i][k] -= su*U[j][k];
}
diag[i] = SDIM_dot(U[i],U[i]);
if ( diag[i] > 0.0 ) D[i] = 1/diag[i];
else D[i] = 1.0;
area *= diag[i];
}
if ( area > 0.0 )
area = sqrt(area)/web.simplex_factorial;
else area = 0.0;
if ( METH_INSTANCE(f_info->method)->flags & DEFAULT_INSTANCE )
{ set_facet_area(f_info->id,area);
#ifdef SHARED_MEMORY
if ( nprocs > 1 )
proc_total_area[GET_THREAD_ID] += area;
else
#endif
binary_tree_add(web.total_area_addends,area);
}
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
area *= get_facet_density(f_info->id);
return area;
}
/*********************************************************************
*
* function: q_facet_tension_gradient()
*
* purpose: General quantity value of facet tension.
*/
REAL q_facet_tension_gradient(f_info)
struct qinfo *f_info;
{ REAL area;
int i,j;
REAL fudge;
if ( web.modeltype == QUADRATIC ) return q_facet_tension_q_grad(f_info);
if ( web.modeltype == LAGRANGE )
return lagrange_facet_tension_grad(f_info);
#define OLDWAY
#ifdef OLDWAY
mat_tsquare(f_info->sides[0],f_info->ss,web.dimension,SDIM);
area = det_adjoint(f_info->ss,web.dimension);
if ( area > 0.0 )
{ area = sqrt(area);
fudge = 1/(area*web.simplex_factorial);
area /= web.simplex_factorial;
}
else fudge = area = 0.0;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
{ REAL density = get_facet_density(f_info->id);
area *= density; fudge *= density;
}
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < web.dimension ; j++ )
f_info->ss[i][j] *= fudge;
mat_mult(f_info->ss,f_info->sides[0],f_info->grad+1,web.dimension,
web.dimension, SDIM); /* head forces */
memset((char*)f_info->grad[0],0,SDIM*sizeof(REAL));
for ( i = 0 ; i < web.dimension ; i++ ) /* tail forces */
vector_sub(f_info->grad[0],f_info->grad[i+1],SDIM);
#else
/* new way, using Gram-Schmidt */
{
REAL diag[MAXCOORD];
REAL D[MAXCOORD];
REAL U[MAXCOORD][MAXCOORD];
REAL L[MAXCOORD][MAXCOORD];
REAL DL[MAXCOORD][MAXCOORD];
REAL LDU[MAXCOORD][MAXCOORD];
REAL det;
int k;
det = 1.0;
for ( i = 0 ; i < web.dimension ; i++ )
{ REAL invd;
for ( j = 0 ; j < SDIM ; j++ ) U[i][j] = f_info->sides[0][i][j];
for ( j = 0 ; j < i ; j++ )
{ REAL su = SDIM_dot(f_info->sides[0][i],U[j])*D[j];
for ( k = 0 ; k < SDIM ; k++ ) U[i][k] -= su*U[j][k];
L[i][j] = -su;
}
diag[i] = SDIM_dot(U[i],U[i]);
if ( diag[i] <= 0.0 ) invd = 1.0;
else invd = 1/diag[i];
D[i] = invd;
DL[i][i] = invd;
for ( k = 0 ; k < i ; k++ )
DL[i][k] = invd*L[i][k];
det *= diag[i];
}
area = sqrt(det)/web.simplex_factorial;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
area *= get_facet_density(f_info->id);
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL sum = DL[i][i]*U[i][j];
for ( k = i+1 ; k < web.dimension ; k++ )
sum += DL[k][i]*U[k][j];
LDU[i][j] = sum;
}
for ( j = 0 ; j < SDIM ; j++ ) f_info->grad[0][j] = 0.0;
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL gr = area*LDU[i][j];
f_info->grad[i+1][j] = gr;
f_info->grad[0][j] -= gr;
}
}
#endif
return area;
}
/*********************************************************************
*
* function: q_facet_tension_hessian()
*
* purpose: General quantity value, gradient and hessian of facet area.
*/
REAL q_facet_tension_hessian(f_info)
struct qinfo *f_info;
{ int i,j,k,m;
REAL val;
REAL area;
REAL ssdet,fudge,energy;
if ( dirichlet_flag )
{ if ( web.modeltype != LINEAR )
kb_error(2144,"Dirichlet_mode requires linear model.\n",RECOVERABLE);
return dirichlet_area_hess(f_info);
}
if ( sobolev_flag )
{ if ( web.modeltype != LINEAR )
kb_error(2145,"Sobolev_mode requires linear model.\n",RECOVERABLE);
return sobolev_area_hess(f_info);
}
if ( web.modeltype == QUADRATIC ) return q_facet_tension_q_hess(f_info);
if ( web.modeltype == LAGRANGE ) return lagrange_facet_tension_hess(f_info);
#ifdef OLDWAY
{
MAT2D(AS,MAXCOORD,MAXCOORD);
MAT2D(SAS,MAXCOORD,MAXCOORD);
#define S (f_info->sides[0])
#define A (f_info->ss)
/* area derivatives */
mat_tsquare(S,A,web.dimension,SDIM);
ssdet = det_adjoint(A,web.dimension);
if ( ssdet <= 0.0 ) { return 0.0; }
energy = area = sqrt(ssdet)/web.simplex_factorial;
fudge = 1/ssdet;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
{ REAL density = get_facet_density(f_info->id);
energy *= density; area *= density;
}
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < web.dimension ; j++ )
A[i][j] *= fudge; /* now inverse of ss, times density */
mat_mult(A,S,AS,web.dimension,web.dimension, SDIM);
/* head forces */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[i+1][j] = area*AS[i][j];
/* tail forces */
memset((char*)f_info->grad[0],0,SDIM*sizeof(REAL));
for ( i = 0 ; i < web.dimension ; i++ )
vector_sub(f_info->grad[0],f_info->grad[i+1],SDIM);
/* hessian */
tr_mat_mul(S,AS,SAS,web.dimension,SDIM,SDIM);
for ( m = 0 ; m < web.dimension ; m++ )
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
{ val = area*(AS[m][j]*AS[i][k] + (j==k?A[i][m]:0.0)
- A[i][m]*SAS[j][k] - AS[i][j]*AS[m][k]);
f_info->hess[m+1][i+1][j][k] = val;
f_info->hess[0][0][j][k] += val;
f_info->hess[0][i+1][j][k] -= val;
f_info->hess[m+1][0][j][k] -= val;
}
return energy;
#undef S
#undef A
}
#else
/* new way, using Gram-Schmidt */
{
REAL diag[MAXCOORD];
REAL U[MAXCOORD][MAXCOORD];
REAL D[MAXCOORD];
REAL L[MAXCOORD][MAXCOORD]; /* only subdiagonal explicit */
REAL DL[MAXCOORD][MAXCOORD];
REAL LDU[MAXCOORD][MAXCOORD];
REAL LDL[MAXCOORD][MAXCOORD];
REAL UDU[MAXCOORD][MAXCOORD];
REAL det;
det = 1.0;
for ( i = 0 ; i < web.dimension ; i++ )
{ REAL invd;
for ( j = 0 ; j < SDIM ; j++ ) U[i][j] = f_info->sides[0][i][j];
for ( j = 0 ; j < i ; j++ )
{ REAL su = SDIM_dot(f_info->sides[0][i],U[j])*D[j];
for ( k = 0 ; k < SDIM ; k++ ) U[i][k] -= su*U[j][k];
L[i][j] = -su;
}
diag[i] = SDIM_dot(U[i],U[i]);
if ( diag[i] <= 0.0 ) invd = 0.0;
else invd = 1/diag[i];
D[i] = invd;
DL[i][i] = invd;
for ( k = 0 ; k < i ; k++ )
DL[i][k] = invd*L[i][k];
det *= diag[i];
}
area = sqrt(det)/web.simplex_factorial;
if ( METH_INSTANCE(f_info->method)->flags & USE_DENSITY )
area *= get_facet_density(f_info->id);
/* form LDL, LDU, UDU */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j <= i ; j++ )
{ REAL sum = DL[i][j];
for ( k = i+1 ; k < web.dimension ; k++ )
sum += L[k][i]*DL[k][j];
LDL[i][j] = LDL[j][i] = sum;
}
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL sum = DL[i][i]*U[i][j];
for ( k = i+1 ; k < web.dimension ; k++ )
sum += DL[k][i]*U[k][j];
LDU[i][j] = sum;
}
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j <= i ; j++ )
{ REAL sum = 0.0;
for ( k = 0 ; k < web.dimension ; k++ )
sum += U[k][i]*D[k]*U[k][j];
UDU[i][j] = UDU[j][i] = sum;
}
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL gr = area*LDU[i][j];
f_info->grad[i+1][j] = gr;
f_info->grad[0][j] -= gr;
}
for ( m = 0 ; m < web.dimension ; m++ )
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
{ val = area*(LDU[m][j]*LDU[i][k] + (j==k?LDL[i][m]:0.0)
- LDL[i][m]*UDU[j][k] - LDU[i][j]*LDU[m][k]) ;
f_info->hess[m+1][i+1][j][k] = val;
f_info->hess[0][0][j][k] += val;
f_info->hess[0][i+1][j][k] -= val;
f_info->hess[m+1][0][j][k] -= val;
}
return area;
}
#endif
}
/*********************************************************************
facet_scalar_integral method
2D facets only, in any space dimension
*********************************************************************/
/*********************************************************************
*
* function: facet_scalar_integral_init()
*
* purpose: check illegalities
*
*/
void facet_scalar_integral_init(mode,mi)
int mode;
struct method_instance *mi;
{ if ( web.dimension != 2 )
kb_error(1768,"facet_scalar_integral method only for SOAPFILM model.\n",
RECOVERABLE);
}
/*********************************************************************
*
* function: facet_scalar_integral()
*
* purpose: method value
*
*/
REAL facet_scalar_integral(f_info)
struct qinfo *f_info;
{ int m;
REAL value = 0.0;
REAL area;
REAL ss,st,tt;
if ( web.modeltype == QUADRATIC ) return facet_scalar_integral_q(f_info);
if ( web.modeltype == LAGRANGE ) return facet_scalar_integral_lagr(f_info);
ss = SDIM_dot(f_info->sides[0][0],f_info->sides[0][0]);
st = SDIM_dot(f_info->sides[0][0],f_info->sides[0][1]);
tt = SDIM_dot(f_info->sides[0][1],f_info->sides[0][1]);
area = ss*tt-st*st;
if ( area <= 0.0 ) return 0.0;
area = sqrt(area)/2;
for ( m = 0 ; m < gauss2D_num ; m++ )
{ f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
value += gauss2Dwt[m]*
eval(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],f_info->id,NULL);
}
value *= area;
return value;
}
/*********************************************************************
*
* function: facet_scalar_integral_grad()
*
* purpose: method gradient
*
*/
REAL facet_scalar_integral_grad(f_info)
struct qinfo *f_info;
{ int m,i,j;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL area;
REAL ss,st,tt;
if ( web.modeltype == QUADRATIC ) return facet_scalar_integral_q_grad(f_info);
if ( web.modeltype == LAGRANGE ) return facet_scalar_integral_lagr_grad(f_info);
for ( m = 0 ; m < FACET_VERTS ; m++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[m][j] = 0.0;
ss = SDIM_dot(f_info->sides[0][0],f_info->sides[0][0]);
st = SDIM_dot(f_info->sides[0][0],f_info->sides[0][1]);
tt = SDIM_dot(f_info->sides[0][1],f_info->sides[0][1]);
area = ss*tt-st*st;
if ( area <= 0.0 ) return 0.0;
area = sqrt(area)/2;
for ( m = 0 ; m < gauss2D_num ; m++ )
{
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_all(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,f_info->id);
value += gauss2Dwt[m]*val;
for ( i = 0 ; i < FACET_VERTS ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[i][j] += gauss2Dwt[m]*gauss2Dpt[m][i]*derivs[j]*area;
}
for ( j = 0 ; j < SDIM ; j++ )
{ REAL tmp1,tmp2;
tmp1 = tt*f_info->sides[0][0][j] - st*f_info->sides[0][1][j];
tmp2 = ss*f_info->sides[0][1][j] - st*f_info->sides[0][0][j];
f_info->grad[0][j] -= value*(tmp1+tmp2)/4/area;
f_info->grad[1][j] += value*tmp1/4/area;
f_info->grad[2][j] += value*tmp2/4/area;
}
return area*value;
}
/*********************************************************************
*
* function: facet_scalar_integral_hess()
*
* purpose: method gradient and hessian
*
*/
REAL facet_scalar_integral_hess(f_info)
struct qinfo *f_info;
{ int n,m,j,k,i;
REAL value = 0.0;
REAL sum,val;
REAL derivs[MAXCOORD];
REAL areagrad[MAXCOORD][MAXCOORD],sumgrad[MAXCOORD][MAXCOORD];
REAL areahess[MAXCOORD][MAXCOORD][MAXCOORD][MAXCOORD],
sumhess[MAXCOORD][MAXCOORD][MAXCOORD][MAXCOORD];
REAL area;
REAL ssdet;
MAT2D(AS,MAXCOORD,MAXCOORD);
MAT2D(SAS,MAXCOORD,MAXCOORD);
MAT2D(second,MAXCOORD,MAXCOORD);
#define S (f_info->sides[0])
#define A (f_info->ss)
if ( web.modeltype == QUADRATIC ) return facet_scalar_integral_q_hess(f_info);
if ( web.modeltype == LAGRANGE ) return facet_scalar_integral_lagr_hess(f_info);
/* first, area derivatives */
mat_tsquare(S,A,web.dimension,SDIM);
ssdet = det_adjoint(A,web.dimension);
if ( ssdet <= 0.0 ) { return 0.0; }
area = sqrt(ssdet)/web.simplex_factorial;
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < web.dimension ; j++ )
A[i][j] /= ssdet; /* now inverse of ss */
mat_mult(A,S,AS,web.dimension,web.dimension, SDIM);
/* head forces */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
areagrad[i+1][j] = area*AS[i][j];
/* tail forces */
memset((char*)areagrad[0],0,SDIM*sizeof(REAL));
for ( i = 0 ; i < web.dimension ; i++ )
vector_sub(areagrad[0],areagrad[i+1],SDIM);
/* hessian */
tr_mat_mul(S,AS,SAS,web.dimension,SDIM,SDIM);
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
for ( m = 0 ; m <= web.dimension ; m++ )
{ areahess[m][0][j][k] = 0.0;
areahess[0][m][j][k] = 0.0;
}
for ( m = 0 ; m < web.dimension ; m++ )
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
{ val = area*(AS[m][j]*AS[i][k] + (j==k?A[i][m]:0.0)
- A[i][m]*SAS[j][k] - AS[i][j]*AS[m][k]);
areahess[m+1][i+1][j][k] = val;
areahess[0][0][j][k] += val;
areahess[0][i+1][j][k] -= val;
areahess[m+1][0][j][k] -= val;
}
/* gaussian sum derivatives */
memset((char*)sumgrad,0,sizeof(sumgrad));
memset((char*)sumhess,0,sizeof(sumhess));
for ( m = 0, sum = 0.0 ; m < gauss2D_num ; m++ )
{
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_second(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,second,f_info->id);
sum += gauss2Dwt[m]*val;
for ( i = 0 ; i <= web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
sumgrad[i][j] += gauss2Dwt[m]*gauss2Dpt[m][i]*derivs[j];
for ( i = 0 ; i <= web.dimension ; i++ )
for ( n = 0 ; n <= web.dimension ; n++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
sumhess[i][n][j][k] += gauss2Dwt[m]*gauss2Dpt[m][i]*gauss2Dpt[m][n]
*second[j][k];
}
/* final values */
value = area*sum;
for ( m = 0 ; m <= web.dimension ; m++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[m][j] = areagrad[m][j]*sum + area*sumgrad[m][j];
for ( m = 0 ; m <= web.dimension ; m++ )
for ( i = 0 ; i <= web.dimension ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
f_info->hess[m][i][j][k] = areahess[m][i][j][k]*sum
+ areagrad[m][j]*sumgrad[i][k] + sumgrad[m][j]*areagrad[i][k]
+ area*sumhess[m][i][j][k];
return value;
}
/*********************************************************************
quadratic facet_scalar_integral method
2D facets only, in any space dimension
*********************************************************************/
/*********************************************************************
*
* function: facet_scalar_integral_q()
*
* purpose: method value
*
*/
REAL facet_scalar_integral_q(f_info)
struct qinfo *f_info;
{ int m;
REAL value = 0.0;
REAL area;
REAL ss,st,tt;
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
area = ss*tt-st*st;
if ( area <= 0.0 ) continue;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
value += gauss2Dwt[m]*sqrt(area)*
eval(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],f_info->id,NULL);
}
return value/2; /* triangle factor */
}
/*********************************************************************
*
* function: facet_scalar_integral_q_grad()
*
* purpose: method gradient
*
*/
REAL facet_scalar_integral_q_grad(f_info)
struct qinfo *f_info;
{ int m,j,k;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL detgrad[FACET_CTRL][MAXCOORD];
REAL area,det;
REAL ss,st,tt;
for ( m = 0 ; m < FACET_CTRL ; m++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[m][j] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt-st*st;
if ( det <= 0.0 ) continue;
area = sqrt(det)/2;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_all(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,f_info->id);
value += gauss2Dwt[m]*area*val;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
detgrad[k][j] = 2*gpolypartial[m][0][k]*tang[0][j]*tt
+ ss*2*gpolypartial[m][1][k]*tang[1][j]
- 2*st*(gpolypartial[m][0][k]*tang[1][j]
+ gpolypartial[m][1][k]*tang[0][j]);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] += gauss2Dwt[m]*
(val/sqrt(det)/4*detgrad[k][j] + area*derivs[j]*gpoly[m][k]);
}
return value;
}
/*********************************************************************
*
* function: facet_scalar_integral_q_hess()
*
* purpose: method gradient and hessian
*
*/
REAL facet_scalar_integral_q_hess(f_info)
struct qinfo *f_info;
{ int m,j,k,kk,jj;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL detgrad[FACET_CTRL][MAXCOORD];
REAL dethess[FACET_CTRL][FACET_CTRL][MAXCOORD][MAXCOORD];
REAL area,det,ss,st,tt;
MAT2D(second,MAXCOORD,MAXCOORD);
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL **gpp = gpolypartial[m];
REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt-st*st;
if ( det <= 0.0 ) continue;
area = sqrt(det)/2;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_second(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,second,f_info->id);
value += gauss2Dwt[m]*area*val;
/* gradients */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
detgrad[k][j] = 2*gpp[0][k]*tang[0][j]*tt + ss*2*gpp[1][k]*tang[1][j]
- 2*st*(gpp[0][k]*tang[1][j] + gpp[1][k]*tang[0][j]);
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] += gauss2Dwt[m]*
(val/sqrt(det)/4*detgrad[k][j] + area*derivs[j]*gpoly[m][k]);
/* hessian */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ dethess[k][kk][j][jj] =
2*gpp[0][k]*tang[0][j]*2*gpp[1][kk]*tang[1][jj]
+ 2*gpp[0][kk]*tang[0][jj]*2*gpp[1][k]*tang[1][j]
- 2*(gpp[0][kk]*tang[1][jj] + gpp[1][kk]*tang[0][jj])
*(gpp[0][k]*tang[1][j] + gpp[1][k]*tang[0][j]);
if (j==jj)
dethess[k][kk][j][jj] += 2*gpp[0][k]*gpp[0][kk]*tt
+ ss*2*gpp[1][k]*gpp[1][kk]
- 2*st*(gpp[0][k]*gpp[1][kk] + gpp[1][k]*gpp[0][kk]);
}
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
f_info->hess[k][kk][j][jj] += gauss2Dwt[m]*
(derivs[jj]*gpoly[m][kk]/sqrt(det)/4*detgrad[k][j]
-0.5*val/sqrt(det)/det/4*detgrad[kk][jj]*detgrad[k][j]
+ val/sqrt(det)/4*dethess[k][kk][j][jj]
+ 1/sqrt(det)/4*detgrad[kk][jj]*derivs[j]*gpoly[m][k]
+ area*second[j][jj]*gpoly[m][k]*gpoly[m][kk]);
}
return value;
}
/*********************************************************************
Lagrange facet_scalar_integral method
2 D facets only, in any space dimension
*********************************************************************/
/*********************************************************************
*
* function: facet_scalar_integral_lagr()
*
* purpose: method value
*
*/
REAL facet_scalar_integral_lagr(f_info)
struct qinfo *f_info;
{ int m;
REAL value = 0.0;
REAL area;
REAL ss,st,tt;
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
area = ss*tt-st*st;
if ( area <= 0.0 ) continue;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
value += gl->gausswt[m]*sqrt(area)*
eval(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],f_info->id,NULL);
}
return value/2; /* triangle factor */
}
/*********************************************************************
*
* function: facet_scalar_integral_lagr_grad()
*
* purpose: method gradient
*
*/
REAL facet_scalar_integral_lagr_grad(f_info)
struct qinfo *f_info;
{ int m,j,k;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL detgrad;
REAL area,det;
REAL ss,st,tt;
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt-st*st;
if ( det <= 0.0 ) continue;
area = sqrt(det)/2;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_all(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,f_info->id);
value += gl->gausswt[m]*area*val;
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
{ detgrad = 2*gl->gpolypart[m][0][k]*tang[0][j]*tt
+ ss*2*gl->gpolypart[m][1][k]*tang[1][j]
- 2*st*(gl->gpolypart[m][0][k]*tang[1][j]
+ gl->gpolypart[m][1][k]*tang[0][j]);
f_info->grad[k][j] += gl->gausswt[m]*
(val/sqrt(det)/4*detgrad + area*derivs[j]*gl->gpoly[m][k]);
}
}
return value;
}
/*********************************************************************
*
* function: facet_scalar_integral_lagr_hess()
*
* purpose: method gradient and hessian
*
*/
REAL facet_scalar_integral_lagr_hess(f_info)
struct qinfo *f_info;
{ int m,j,k,kk,jj;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL detgrad[MAXVCOUNT][MAXCOORD];
REAL dethess;
REAL area,det,ss,st,tt;
MAT2D(second,MAXCOORD,MAXCOORD);
struct gauss_lag *gl = &gauss_lagrange[web.dimension][web.gauss2D_order];
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL **gpp = gl->gpolypart[m];
REAL **tang = f_info->sides[m];
ss = SDIM_dot(tang[0],tang[0]);
st = SDIM_dot(tang[0],tang[1]);
tt = SDIM_dot(tang[1],tang[1]);
det = ss*tt-st*st;
if ( det <= 0.0 ) continue;
area = sqrt(det)/2;
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
eval_second(METH_INSTANCE(f_info->method)->expr[0],f_info->gauss_pt[m],SDIM,&val,
derivs,second,f_info->id);
value += gl->gausswt[m]*area*val;
/* gradients */
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
{ detgrad[k][j] = 2*gpp[0][k]*tang[0][j]*tt + ss*2*gpp[1][k]*tang[1][j]
- 2*st*(gpp[0][k]*tang[1][j] + gpp[1][k]*tang[0][j]);
f_info->grad[k][j] += gl->gausswt[m]*
(val/sqrt(det)/4*detgrad[k][j] + area*derivs[j]*gl->gpoly[m][k]);
}
/* hessian */
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( kk = 0 ; kk < gl->lagpts ; kk++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( jj = 0 ; jj < SDIM ; jj++ )
{ dethess =
2*gpp[0][k]*tang[0][j]*2*gpp[1][kk]*tang[1][jj]
+ 2*gpp[0][kk]*tang[0][jj]*2*gpp[1][k]*tang[1][j]
- 2*(gpp[0][kk]*tang[1][jj] + gpp[1][kk]*tang[0][jj])
*(gpp[0][k]*tang[1][j] + gpp[1][k]*tang[0][j]);
if (j==jj)
dethess += 2*gpp[0][k]*gpp[0][kk]*tt
+ ss*2*gpp[1][k]*gpp[1][kk]
- 2*st*(gpp[0][k]*gpp[1][kk] + gpp[1][k]*gpp[0][kk]);
f_info->hess[k][kk][j][jj] += gl->gausswt[m]*
(derivs[jj]*gl->gpoly[m][kk]/sqrt(det)/4*detgrad[k][j]
-0.5*val/sqrt(det)/det/4*detgrad[kk][jj]*detgrad[k][j]
+ val/sqrt(det)/4*dethess
+ 1/sqrt(det)/4*detgrad[kk][jj]*derivs[j]*gl->gpoly[m][k]
+ area*second[j][jj]*gl->gpoly[m][k]*gl->gpoly[m][kk]);
}
}
return value;
}
/*********************************************************************
facet_vector_integral method
Integral of vectorfield over facet. 2D facet in 3D only.
*********************************************************************/
/*********************************************************************
*
* function: facet_vector_integral_init()
*
* purpose: Check illegalities
*
*/
void facet_vector_integral_init(mode,mi)
int mode;
struct method_instance *mi;
{
if ( web.dimension != 2 )
kb_error(1772,"facet_vector_integral method only for 2D facets.\n",RECOVERABLE);
if ( SDIM != 3 )
kb_error(1773,"facet_vector_integral method only for 3D space.\n",RECOVERABLE);
}
/*********************************************************************
*
* function: facet_vector_integral()
*
* purpose: method value
*
*/
REAL facet_vector_integral(f_info)
struct qinfo *f_info;
{ int m,j;
REAL value=0.0;
if ( web.modeltype == QUADRATIC ) return facet_vector_integral_q(f_info);
if ( web.modeltype == LAGRANGE ) return lagrange_vector_integral(f_info);
for ( m = 0 ; m < gauss2D_num ; m++ )
{
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
{ REAL green = gauss2Dwt[m]*
eval(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],f_info->id,NULL);
value += f_info->normal[j]*green;
}
}
return value/2; /* 2 is triangle factor for normal */
}
/*********************************************************************
*
* function: facet_vector_integral_grad()
*
* purpose: method gradient
*
*/
REAL facet_vector_integral_grad(f_info)
struct qinfo *f_info;
{ int m,j,k;
REAL value = 0.0;
REAL val[MAXCOORD];
REAL derivs[MAXCOORD][MAXCOORD];
REAL sum;
REAL cross0[MAXCOORD],cross1[MAXCOORD];
REAL sign = (get_fattr(f_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
if ( web.modeltype == QUADRATIC ) return facet_vector_integral_q_grad(f_info);
if ( web.modeltype == LAGRANGE ) return lagrange_vector_integral_grad(f_info);
for ( j = 0 ; j < SDIM ; j++ )
for ( m = 0 ; m < FACET_VERTS ; m++ )
f_info->grad[m][j] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL weight = sign*gauss2Dwt[m];
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
eval_all(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],SDIM,val+j,
derivs[j],f_info->id);
value += weight*SDIM_dot(val,f_info->normal);
cross_prod(val,f_info->sides[0][0],cross0);
cross_prod(val,f_info->sides[0][1],cross1);
for ( k = 0 ; k < SDIM ; k++ )
{ for ( sum = 0.0, j = 0 ; j < SDIM ; j++ )
sum += derivs[j][k]*f_info->normal[j];
f_info->grad[0][k] += weight*(gauss2Dpt[m][0]*sum
+ cross1[k] - cross0[k])/2;
f_info->grad[1][k] += weight*(gauss2Dpt[m][1]*sum
- cross1[k])/2;
f_info->grad[2][k] += weight*(gauss2Dpt[m][2]*sum
+ cross0[k])/2;
}
}
return value/2;
}
/*********************************************************************
*
* function: facet_vector_integral_hess()
*
* purpose: method gradient and hessian
*
*/
REAL facet_vector_integral_hess(f_info)
struct qinfo *f_info;
{ int m,i,j,k;
REAL value = 0.0;
REAL val[MAXCOORD];
REAL derivs[MAXCOORD][MAXCOORD];
REAL sum;
REAL cross0[MAXCOORD],cross1[MAXCOORD];
MAT3D(second,MAXCOORD,MAXCOORD,MAXCOORD);
REAL *s1 = f_info->sides[0][0];
REAL *s2 = f_info->sides[0][1];
int p,q,r,s;
REAL sign = (get_fattr(f_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
if ( web.modeltype == QUADRATIC ) return facet_vector_integral_q_hess(f_info);
if ( web.modeltype == LAGRANGE ) return lagrange_vector_integral_hess(f_info);
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL weight = sign*gauss2Dwt[m];
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
eval_second(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],SDIM,val+j,
derivs[j],second[j],f_info->id);
value += weight*SDIM_dot(val,f_info->normal);
cross_prod(val,f_info->sides[0][0],cross0);
cross_prod(val,f_info->sides[0][1],cross1);
for ( k = 0 ; k < SDIM ; k++ )
{ for ( sum = 0.0, j = 0 ; j < SDIM ; j++ )
sum += derivs[j][k]*f_info->normal[j];
f_info->grad[0][k] += weight*(gauss2Dpt[m][0]*sum
+ cross1[k] - cross0[k])/2;
f_info->grad[1][k] += weight*(gauss2Dpt[m][1]*sum
- cross1[k])/2;
f_info->grad[2][k] += weight*(gauss2Dpt[m][2]*sum
+ cross0[k])/2;
}
for ( r = 0 ; r < FACET_VERTS ; r++ )
for ( s = 0 ; s < FACET_VERTS ; s++ )
for ( p = 0 ; p < SDIM ; p++ )
for ( q = 0 ; q < SDIM ; q++ )
{ sum = 0.0;
for ( i = 0 ; i < 3 ; i++ )
{ REAL tmp;
j = (i+1)%3;
k = (j+1)%3;
if ( (r==1) && (p==i) )
{ sum += s2[j]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==2) && (q==j) ) sum += val[k];
if ( (s==0) && (q==j) ) sum -= val[k];
}
if ( (r==0) && (p==i) )
{ sum -= s2[j]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==2) && (q==j) ) sum -= val[k];
if ( (s==0) && (q==j) ) sum += val[k];
}
if ( (r==2) && (p==j) )
{ sum += s1[i]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==1) && (q==i) ) sum += val[k];
if ( (s==0) && (q==i) ) sum -= val[k];
}
if ( (r==0) && (p==j) )
{ sum -= s1[i]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==1) && (q==i) ) sum -= val[k];
if ( (s==0) && (q==i) ) sum += val[k];
}
if ( (s==1) && (q==i) ) sum += s2[j]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==0) && (q==i) ) sum -= s2[j]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==2) && (q==j) ) sum += s1[i]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==0) && (q==j) ) sum -= s1[i]*gauss2Dpt[m][r]*derivs[k][p];
tmp = s1[i]*s2[j]*gauss2Dpt[m][r]*gauss2Dpt[m][s];
sum += tmp*second[k][p][q];
}
f_info->hess[r][s][p][q] += weight * sum/2;
sum = 0.0;
for ( i = 0 ; i < 3 ; i++ )
{ REAL tmp;
j = (i+2)%3;
k = (j+2)%3;
if ( (r==1) && (p==i) )
{ sum += s2[j]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==2) && (q==j) ) sum += val[k];
if ( (s==0) && (q==j) ) sum -= val[k];
}
if ( (r==0) && (p==i) )
{ sum -= s2[j]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==2) && (q==j) ) sum -= val[k];
if ( (s==0) && (q==j) ) sum += val[k];
}
if ( (r==2) && (p==j) )
{ sum += s1[i]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==1) && (q==i) ) sum += val[k];
if ( (s==0) && (q==i) ) sum -= val[k];
}
if ( (r==0) && (p==j) )
{ sum -= s1[i]*gauss2Dpt[m][s]*derivs[k][q];
if ( (s==1) && (q==i) ) sum -= val[k];
if ( (s==0) && (q==i) ) sum += val[k];
}
if ( (s==1) && (q==i) ) sum += s2[j]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==0) && (q==i) ) sum -= s2[j]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==2) && (q==j) ) sum += s1[i]*gauss2Dpt[m][r]*derivs[k][p];
if ( (s==0) && (q==j) ) sum -= s1[i]*gauss2Dpt[m][r]*derivs[k][p];
tmp = s1[i]*s2[j]*gauss2Dpt[m][r]*gauss2Dpt[m][s];
sum += tmp*second[k][p][q];
}
f_info->hess[r][s][p][q] -= weight * sum/2;
}
}
return value/2;
}
/*********************************************************************
quadratic facet_vector_integral method
Integral of vectorfield over facet. 2D facet in 3D only.
*********************************************************************/
/*********************************************************************
*
* function: facet_vector_integral_q()
*
* purpose: method value
*
*/
REAL facet_vector_integral_q(f_info)
struct qinfo *f_info;
{ int m,j;
REAL value=0.0,val[MAXCOORD];
REAL sign = (get_fattr(f_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
for ( m = 0 ; m < gauss2D_num ; m++ )
{
REAL **tang = f_info->sides[m];
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
{ int jj = (j+1)%SDIM;
int jjj = (j+2)%SDIM;
val[j] = gauss2Dwt[m]*
eval(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],f_info->id,NULL);
value += val[j]*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
}
}
return sign*value/2; /* 2 is triangle factor */
}
/*********************************************************************
*
* function: facet_vector_integral_q_grad()
*
* purpose: method gradient
*
*/
REAL facet_vector_integral_q_grad(f_info)
struct qinfo *f_info;
{ int m,i,j,k;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
REAL sign = (get_fattr(f_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( j = 0 ; j < SDIM ; j++ )
f_info->grad[k][j] = 0.0;
for ( m = 0 ; m < gauss2D_num ; m++ )
{
REAL **gpp = gpolypartial[m];
REAL wt = sign*0.5*gauss2Dwt[m]; /* include triangle factor */
REAL **tang = f_info->sides[m];
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
{ int jj = (j+1)%SDIM;
int jjj = (j+2)%SDIM;
eval_all(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],SDIM,&val,
derivs,f_info->id);
value += wt*val*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
for ( k = 0 ; k < FACET_CTRL ; k++ )
{
f_info->grad[k][jj] += wt*val
*(gpp[0][k]*tang[1][jjj] - tang[0][jjj]*gpp[1][k]);
f_info->grad[k][jjj] += wt*val
*(tang[0][jj]*gpp[1][k] - gpp[0][k]*tang[1][jj]);
for ( i = 0 ; i < SDIM ; i++ )
f_info->grad[k][i] += wt*derivs[i]*gpoly[m][k]
*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
}
}
}
return value;
}
/*********************************************************************
*
* function: facet_vector_integral_q_hess()
*
* purpose: method gradient and hessian
*
*/
REAL facet_vector_integral_q_hess(f_info)
struct qinfo *f_info;
{ int m,i,j,k,ii,kk;
REAL value = 0.0;
REAL val;
REAL derivs[MAXCOORD];
MAT2D(second,MAXCOORD,MAXCOORD);
REAL sign = (get_fattr(f_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
for ( m = 0 ; m < gauss2D_num ; m++ )
{ REAL **gpp = gpolypartial[m];
REAL wt = sign*0.5*gauss2Dwt[m]; /* include triangle factor */
REAL **tang = f_info->sides[m];
f_info->gauss_pt[m][2*SDIM] = m; /* kludge for attr interpolation. */
for ( j = 0 ; j < SDIM ; j++ )
{ int jj = (j+1)%SDIM;
int jjj = (j+2)%SDIM;
eval_second(METH_INSTANCE(f_info->method)->expr[j],f_info->gauss_pt[m],SDIM,
&val, derivs,second,f_info->id);
value += wt*val*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
for ( k = 0 ; k < FACET_CTRL ; k++ )
{ f_info->grad[k][jj] += wt*val
*(gpp[0][k]*tang[1][jjj] - tang[0][jjj]*gpp[1][k]);
f_info->grad[k][jjj] += wt*val
*(tang[0][jj]*gpp[1][k] - gpp[0][k]*tang[1][jj]);
for ( i = 0 ; i < SDIM ; i++ )
f_info->grad[k][i] += wt*derivs[i]*gpoly[m][k]
*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
}
/* hessian */
for ( k = 0 ; k < FACET_CTRL ; k++ )
for ( kk = 0 ; kk < FACET_CTRL ; kk++ )
{ f_info->hess[k][kk][jj][jjj] += wt*val
*(gpp[0][k]*gpp[1][kk] - gpp[0][kk]*gpp[1][k]);
f_info->hess[k][kk][jjj][jj] += wt*val
*(gpp[0][kk]*gpp[1][k] - gpp[0][k]*gpp[1][kk]);
for ( ii = 0 ; ii < SDIM ; ii++ )
{ f_info->hess[k][kk][jj][ii] += wt*derivs[ii]*gpoly[m][kk]
*(gpp[0][k]*tang[1][jjj] - tang[0][jjj]*gpp[1][k]);
f_info->hess[k][kk][jjj][ii] += wt*derivs[ii]*gpoly[m][kk]
*(tang[0][jj]*gpp[1][k] - gpp[0][k]*tang[1][jj]);
}
for ( i = 0 ; i < SDIM ; i++ )
{
for ( ii = 0 ; ii < SDIM ; ii++ )
f_info->hess[k][kk][i][ii] +=
wt*second[i][ii]*gpoly[m][k]*gpoly[m][kk]
*(tang[0][jj]*tang[1][jjj] - tang[0][jjj]*tang[1][jj]);
f_info->hess[k][kk][i][jj] += wt*derivs[i]*gpoly[m][k]
*(gpp[0][kk]*tang[1][jjj] - tang[0][jjj]*gpp[1][kk]);
f_info->hess[k][kk][i][jjj] += wt*derivs[i]*gpoly[m][k]
*(tang[0][jj]*gpp[1][kk] - gpp[0][kk]*tang[1][jj]);
}
}
}
}
return value;
}
/***********************************************************************
Named Method spherical_area
Assumes vertices of a facet are on a unit sphere (in any dimension).
Value is the area of the spherical triangle.
***********************************************************************/
REAL spherical_area_value(f_info)
struct qinfo *f_info;
{ int i;
REAL area;
REAL a[FACET_EDGES+2]; /* squares of side lengths */
REAL *b;
/* Value done by angle excess */
a[0] = SDIM_dot(f_info->sides[0][0],f_info->sides[0][0]);
a[2] = SDIM_dot(f_info->sides[0][1],f_info->sides[0][1]);
a[1] = a[0] + a[2] - 2*SDIM_dot(f_info->sides[0][0],f_info->sides[0][1]);
a[FACET_EDGES] = a[0];
a[FACET_EDGES+1] = a[1];
for ( area = -M_PI, i = 0, b = a ; i < FACET_VERTS ; i++,b++ )
{ REAL v = sqrt(b[1]*b[2]*(1-b[1]/4)*(1-b[2]/4));
REAL w = (b[1]+b[2]-b[0]-b[1]*b[2]/2);
REAL u = w/2/v;
area += acos(u);
}
return area;
}
REAL spherical_area_grad(f_info)
struct qinfo *f_info;
{ int i,j;
REAL area;
REAL a[FACET_EDGES+2]; /* squares of side lengths */
REAL *b;
REAL *x[FACET_VERTS+2];
/* Value done by angle excess */
a[0] = SDIM_dot(f_info->sides[0][0],f_info->sides[0][0]);
a[2] = SDIM_dot(f_info->sides[0][1],f_info->sides[0][1]);
a[1] = a[0] + a[2] - 2*SDIM_dot(f_info->sides[0][0],f_info->sides[0][1]);
a[FACET_EDGES] = a[0];
a[FACET_EDGES+1] = a[1];
for ( i = 0 ; i < FACET_VERTS ; i++ ) x[i] = f_info->x[i];
x[FACET_VERTS] = x[0];
x[FACET_VERTS+1] = x[1];
for ( area = -M_PI, i = 0, b = a ; i < FACET_VERTS ; i++,b++ )
{ REAL v = sqrt(b[1]*b[2]*(1-b[1]/4)*(1-b[2]/4));
REAL w = (b[1]+b[2]-b[0]-b[1]*b[2]/2);
REAL u = w/2/v;
REAL dudb0 = -1/2./v;
REAL dudb1 = (1-b[2]/2)/2./v - w/4/v/v/v*(b[2]*(1-b[1]/4)*(1-b[2]/4)-b[1]*b[2]*(1./4)*(1-b[2]/4));
REAL dudb2 = (1-b[1]/2)/2./v - w/4/v/v/v*(b[1]*(1-b[1]/4)*(1-b[2]/4)-b[1]*b[2]*(1./4)*(1-b[1]/4));
area += acos(u);
for ( j = 0 ; j < SDIM ; j++ )
{ f_info->grad[i][j] += -1/sqrt(1-u*u)*2*(dudb2*(x[i][j]-x[i+2][j])+dudb0*(x[i][j]-x[i+1][j]));
f_info->grad[(i+1)%3][j] += -1/sqrt(1-u*u)*2*(dudb1*(x[i+1][j]-x[i+2][j])+dudb0*(x[i+1][j]-x[i][j]));
f_info->grad[(i+2)%3][j] += -1/sqrt(1-u*u)*2*(dudb1*(x[i+2][j]-x[i+1][j])+dudb2*(x[i+2][j]-x[i][j]));
}
}
return area;
}
evolver-2.30c.dfsg/src/zoom.c 0000644 0001753 0001753 00000007646 11410765113 016362 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/******************************************************************
*
* File: zoom.c
*
* Contents: Routines to zoom in on vertex.
*
*/
#include "include.h"
/******************************************************************
*
* Function: zoom_vertex()
*
* Purpose: Zoom in on a vertex by chopping off everything beyond
* a given distance and fixing in place the jagged edges.
*/
void zoom_vertex(v_id,radius)
vertex_id v_id; /* vertex to zoom on */
REAL radius; /* cutoff distance from v_id */
{
vertex_id vv_id;
edge_id e_id;
facet_id f_id;
facetedge_id fe_id,next,prev;
int i;
if ( (web.bodycount != 0) && (web.representation == SOAPFILM) )
kb_error(1540,"Zoom is not implemented for bodies.\n",RECOVERABLE);
if ( radius <= 0.0 )
kb_error(1541,"Must have positive cut-off radius.\n",RECOVERABLE);
if ( !valid_id(v_id) || !valid_element(v_id) )
{ sprintf(errmsg,"Vertex %s is not valid.\n",ELNAME(v_id));
kb_error(1542,errmsg,RECOVERABLE);
}
/* eliminate all vertices beyond cutoff */
FOR_ALL_VERTICES(vv_id)
{
if ( distance(v_id,vv_id) > radius )
set_attr(vv_id,DISSOLVED);
}
/* eliminate all edges connected to gone vertices */
FOR_ALL_EDGES(e_id)
{ int val_head,val_tail;
val_tail = !(get_vattr(get_edge_tailv(e_id)) & DISSOLVED);
val_head = !(get_vattr(get_edge_headv(e_id)) & DISSOLVED);
if ( !val_head || !val_tail )
{ if (val_head)
{ set_attr(get_edge_headv(e_id),FIXED);
}
if (val_tail)
{ set_attr(get_edge_tailv(e_id),FIXED);
}
set_attr(e_id,DISSOLVED);
}
}
/* eliminate all facets verging on gone edges */
FOR_ALL_FACETS(f_id)
{
fe_id = get_facet_fe(f_id);
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ if ( get_eattr(get_fe_edge(fe_id)) & DISSOLVED )
{ set_attr(f_id,DISSOLVED);
break;
}
fe_id = get_next_edge(fe_id);
}
}
/* eliminate all facet-edges on gone facets */
FOR_ALL_FACETEDGES(fe_id)
{
e_id = get_fe_edge(fe_id);
if ( get_eattr(e_id) & DISSOLVED )
{ set_attr(fe_id,DISSOLVED); continue; }
f_id = get_fe_facet(fe_id);
if ( valid_id(f_id) && (get_fattr(f_id) & DISSOLVED) )
{ /* have kept edge on removed facet */
/* patch up ragged edges */
next = get_next_facet(fe_id);
prev = get_prev_facet(fe_id);
if ( equal_id(next,fe_id) )
{ /* was only facet on edge */
set_edge_fe(e_id,NULLFACETEDGE);
}
else
{ /* close ranks */
set_next_facet(prev,next);
set_prev_facet(next,prev);
set_edge_fe(e_id,next);
}
if ( web.representation == SOAPFILM)
{
/* fix edge in place */
set_attr(e_id,FIXED);
set_attr(get_edge_tailv(e_id),FIXED);
set_attr(get_edge_headv(e_id),FIXED);
}
set_attr(fe_id,DISSOLVED);
}
}
FOR_ALL_VERTICES(v_id)
if ( get_vattr(v_id) & DISSOLVED ) free_element(v_id);
FOR_ALL_EDGES(e_id)
if ( get_eattr(e_id) & DISSOLVED ) free_element(e_id);
FOR_ALL_FACETS(f_id)
if ( get_fattr(f_id) & DISSOLVED ) free_element(f_id);
FOR_ALL_FACETEDGES(fe_id)
if ( get_attr(fe_id) & DISSOLVED ) free_element(fe_id);
}
evolver-2.30c.dfsg/src/lexyy.c 0000644 0001753 0001753 00000412535 11410765113 016545 0 ustar hazelsct hazelsct /* A lexical scanner generated by flex */
/* Scanner skeleton version:
* $Header: /home/daffy/u0/vern/flex/RCS/flex.skl,v 2.85 95/04/24 10:48:47 vern Exp $
*/
#define FLEX_SCANNER
#define YY_FLEX_MAJOR_VERSION 2
#define YY_FLEX_MINOR_VERSION 5
#include
/* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */
#ifdef c_plusplus
#ifndef __cplusplus
#define __cplusplus
#endif
#endif
#ifdef __cplusplus
#include
#include
/* Use prototypes in function declarations. */
#define YY_USE_PROTOS
/* The "const" storage-class-modifier is valid. */
#define YY_USE_CONST
#else /* ! __cplusplus */
#if __STDC__
#define YY_USE_PROTOS
#define YY_USE_CONST
#endif /* __STDC__ */
#endif /* ! __cplusplus */
#ifdef __TURBOC__
#pragma warn -rch
#pragma warn -use
#include
#include
#define YY_USE_CONST
#define YY_USE_PROTOS
#endif
#ifdef YY_USE_CONST
#define yyconst const
#else
#define yyconst
#endif
#ifdef YY_USE_PROTOS
#define YY_PROTO(proto) proto
#else
#define YY_PROTO(proto) ()
#endif
/* Returned upon end-of-file. */
#define YY_NULL 0
/* Promotes a possibly negative, possibly signed char to an unsigned
* integer for use as an array index. If the signed char is negative,
* we want to instead treat it as an 8-bit unsigned char, hence the
* double cast.
*/
#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
/* Enter a start condition. This macro really ought to take a parameter,
* but we do it the disgusting crufty way forced on us by the ()-less
* definition of BEGIN.
*/
#define BEGIN yy_start = 1 + 2 *
/* Translate the current start state into a value that can be later handed
* to BEGIN to return to the state. The YYSTATE alias is for lex
* compatibility.
*/
#define YY_START ((yy_start - 1) / 2)
#define YYSTATE YY_START
/* Action number for EOF rule of a given start state. */
#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
/* Special action meaning "start processing a new file". */
#define YY_NEW_FILE yyrestart( yyin )
#define YY_END_OF_BUFFER_CHAR 0
/* Size of default input buffer. */
#define YY_BUF_SIZE 16384
typedef struct yy_buffer_state *YY_BUFFER_STATE;
extern int yyleng;
extern FILE *yyin, *yyout;
#define EOB_ACT_CONTINUE_SCAN 0
#define EOB_ACT_END_OF_FILE 1
#define EOB_ACT_LAST_MATCH 2
/* The funky do-while in the following #define is used to turn the definition
* int a single C statement (which needs a semi-colon terminator). This
* avoids problems with code like:
*
* if ( condition_holds )
* yyless( 5 );
* else
* do_something_else();
*
* Prior to using the do-while the compiler would get upset at the
* "else" because it interpreted the "if" statement as being all
* done when it reached the ';' after the yyless() call.
*/
/* Return all but the first 'n' matched characters back to the input stream. */
#define yyless(n) \
do \
{ \
/* Undo effects of setting up yytext. */ \
*yy_cp = yy_hold_char; \
yy_c_buf_p = yy_cp = yy_bp + n - YY_MORE_ADJ; \
YY_DO_BEFORE_ACTION; /* set up yytext again */ \
} \
while ( 0 )
#define unput(c) yyunput( c, yytext_ptr )
/* The following is because we cannot portably get our hands on size_t
* (without autoconf's help, which isn't available because we want
* flex-generated scanners to compile on their own).
*/
typedef unsigned int yy_size_t;
struct yy_buffer_state
{
FILE *yy_input_file;
char *yy_ch_buf; /* input buffer */
char *yy_buf_pos; /* current position in input buffer */
/* Size of input buffer in bytes, not including room for EOB
* characters.
*/
yy_size_t yy_buf_size;
/* Number of characters read into yy_ch_buf, not including EOB
* characters.
*/
int yy_n_chars;
/* Whether we "own" the buffer - i.e., we know we created it,
* and can realloc() it to grow it, and should free() it to
* delete it.
*/
int yy_is_our_buffer;
/* Whether this is an "interactive" input source; if so, and
* if we're using stdio for input, then we want to use getc()
* instead of fread(), to make sure we stop fetching input after
* each newline.
*/
int yy_is_interactive;
/* Whether we're considered to be at the beginning of a line.
* If so, '^' rules will be active on the next match, otherwise
* not.
*/
int yy_at_bol;
/* Whether to try to fill the input buffer when we reach the
* end of it.
*/
int yy_fill_buffer;
int yy_buffer_status;
#define YY_BUFFER_NEW 0
#define YY_BUFFER_NORMAL 1
/* When an EOF's been seen but there's still some text to process
* then we mark the buffer as YY_EOF_PENDING, to indicate that we
* shouldn't try reading from the input source any more. We might
* still have a bunch of tokens to match, though, because of
* possible backing-up.
*
* When we actually see the EOF, we change the status to "new"
* (via yyrestart()), so that the user can continue scanning by
* just pointing yyin at a new input file.
*/
#define YY_BUFFER_EOF_PENDING 2
};
static YY_BUFFER_STATE yy_current_buffer = 0;
/* We provide macros for accessing buffer states in case in the
* future we want to put the buffer states in a more general
* "scanner state".
*/
#define YY_CURRENT_BUFFER yy_current_buffer
/* yy_hold_char holds the character lost when yytext is formed. */
static char yy_hold_char;
static int yy_n_chars; /* number of characters read into yy_ch_buf */
int yyleng;
/* Points to current character in buffer. */
static char *yy_c_buf_p = (char *) 0;
static int yy_init = 1; /* whether we need to initialize */
static int yy_start = 0; /* start state number */
/* Flag which is used to allow yywrap()'s to do buffer switches
* instead of setting up a fresh yyin. A bit of a hack ...
*/
static int yy_did_buffer_switch_on_eof;
void yyrestart YY_PROTO(( FILE *input_file ));
void yy_switch_to_buffer YY_PROTO(( YY_BUFFER_STATE new_buffer ));
void yy_load_buffer_state YY_PROTO(( void ));
YY_BUFFER_STATE yy_create_buffer YY_PROTO(( FILE *file, int size ));
void yy_delete_buffer YY_PROTO(( YY_BUFFER_STATE b ));
void yy_init_buffer YY_PROTO(( YY_BUFFER_STATE b, FILE *file ));
void yy_flush_buffer YY_PROTO(( YY_BUFFER_STATE b ));
#define YY_FLUSH_BUFFER yy_flush_buffer( yy_current_buffer )
YY_BUFFER_STATE yy_scan_buffer YY_PROTO(( char *base, yy_size_t size ));
YY_BUFFER_STATE yy_scan_string YY_PROTO(( yyconst char *str ));
YY_BUFFER_STATE yy_scan_bytes YY_PROTO(( yyconst char *bytes, int len ));
static void *yy_flex_alloc YY_PROTO(( yy_size_t ));
static void *yy_flex_realloc YY_PROTO(( void *, yy_size_t ));
static void yy_flex_free YY_PROTO(( void * ));
#define yy_new_buffer yy_create_buffer
#define yy_set_interactive(is_interactive) \
{ \
if ( ! yy_current_buffer ) \
yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
yy_current_buffer->yy_is_interactive = is_interactive; \
}
#define yy_set_bol(at_bol) \
{ \
if ( ! yy_current_buffer ) \
yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
yy_current_buffer->yy_at_bol = at_bol; \
}
#define YY_AT_BOL() (yy_current_buffer->yy_at_bol)
typedef unsigned char YY_CHAR;
FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
typedef int yy_state_type;
extern char *yytext;
#define yytext_ptr yytext
static yy_state_type yy_get_previous_state YY_PROTO(( void ));
static yy_state_type yy_try_NUL_trans YY_PROTO(( yy_state_type current_state ));
static int yy_get_next_buffer YY_PROTO(( void ));
static void yy_fatal_error YY_PROTO(( yyconst char msg[] ));
/* Done after the current pattern has been matched and before the
* corresponding action - sets up yytext.
*/
#define YY_DO_BEFORE_ACTION \
yytext_ptr = yy_bp; \
yyleng = (int) (yy_cp - yy_bp); \
yy_hold_char = *yy_cp; \
*yy_cp = '\0'; \
yy_c_buf_p = yy_cp;
#define YY_NUM_RULES 68
#define YY_END_OF_BUFFER 69
static yyconst short int yy_accept[227] =
{ 0,
0, 0, 69, 67, 65, 3, 56, 25, 67, 41,
67, 67, 46, 47, 41, 41, 40, 41, 41, 7,
7, 7, 66, 42, 41, 45, 41, 63, 63, 48,
43, 57, 44, 65, 41, 31, 41, 5, 5, 5,
0, 0, 28, 0, 51, 0, 0, 55, 0, 49,
36, 34, 35, 23, 1, 2, 37, 22, 7, 7,
11, 0, 0, 0, 32, 33, 52, 50, 53, 58,
63, 63, 0, 60, 54, 0, 0, 28, 0, 5,
0, 0, 30, 5, 20, 19, 5, 5, 0, 0,
0, 6, 26, 27, 6, 29, 0, 0, 0, 64,
0, 2, 22, 0, 0, 24, 10, 0, 38, 59,
63, 0, 6, 5, 20, 19, 0, 0, 14, 13,
0, 0, 19, 0, 8, 0, 21, 17, 16, 0,
9, 0, 0, 0, 23, 0, 12, 12, 0, 22,
39, 63, 14, 13, 0, 0, 19, 0, 8, 0,
21, 0, 13, 0, 0, 15, 0, 20, 0, 12,
0, 19, 0, 16, 0, 0, 18, 0, 0, 0,
22, 63, 0, 13, 0, 0, 15, 0, 20, 0,
0, 19, 0, 14, 0, 0, 13, 0, 19, 0,
17, 0, 0, 16, 0, 0, 63, 0, 14, 0,
0, 13, 0, 19, 0, 13, 0, 16, 61, 0,
63, 0, 13, 0, 63, 0, 0, 63, 0, 62,
63, 63, 63, 63, 4, 0
} ;
static yyconst int yy_ec[256] =
{ 0,
1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
1, 1, 2, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 2, 1, 1, 1, 1,
1, 4, 5, 6, 7, 1, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20, 21,
21, 21, 21, 21, 21, 21, 21, 22, 23, 24,
25, 26, 8, 27, 28, 29, 28, 30, 30, 28,
31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
8, 1, 8, 8, 32, 33, 34, 35, 36, 37,
38, 39, 40, 40, 41, 40, 40, 42, 40, 43,
44, 40, 40, 40, 40, 45, 46, 40, 40, 47,
40, 40, 48, 49, 50, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1
} ;
static yyconst int yy_meta[51] =
{ 0,
1, 1, 2, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 3, 3,
3, 1, 1, 1, 1, 1, 1, 4, 4, 5,
6, 7, 1, 5, 5, 5, 5, 5, 5, 8,
8, 8, 8, 8, 8, 8, 8, 1, 1, 1
} ;
static yyconst short int yy_base[233] =
{ 0,
0, 49, 281, 825, 57, 825, 255, 825, 15, 825,
256, 0, 825, 825, 42, 239, 228, 60, 69, 78,
204, 72, 32, 225, 218, 213, 49, 0, 195, 68,
825, 175, 825, 124, 102, 129, 65, 138, 175, 169,
116, 84, 206, 142, 825, 173, 162, 825, 188, 825,
825, 825, 825, 163, 825, 0, 825, 183, 150, 198,
825, 158, 0, 89, 825, 825, 825, 825, 825, 169,
0, 151, 102, 825, 825, 0, 213, 220, 132, 225,
228, 237, 825, 249, 252, 264, 145, 0, 240, 277,
257, 286, 56, 825, 308, 825, 289, 152, 151, 825,
298, 0, 311, 323, 301, 331, 0, 156, 825, 825,
135, 334, 339, 361, 364, 376, 342, 351, 388, 391,
403, 416, 419, 427, 354, 384, 431, 434, 439, 447,
454, 130, 128, 459, 462, 470, 473, 481, 485, 488,
825, 125, 491, 494, 506, 519, 522, 530, 497, 534,
537, 547, 550, 558, 562, 565, 570, 573, 581, 589,
592, 595, 603, 606, 614, 618, 621, 121, 114, 626,
629, 124, 637, 640, 648, 652, 655, 660, 663, 671,
674, 677, 680, 683, 691, 694, 697, 700, 703, 706,
709, 717, 720, 723, 109, 105, 97, 726, 729, 737,
740, 743, 746, 749, 752, 755, 758, 761, 825, 96,
88, 764, 767, 210, 81, 309, 106, 62, 90, 825,
58, 45, 20, 30, 0, 825, 785, 791, 799, 805,
808, 816
} ;
static yyconst short int yy_def[233] =
{ 0,
226, 1, 226, 226, 226, 226, 226, 226, 226, 226,
226, 227, 226, 226, 226, 226, 226, 226, 226, 226,
20, 226, 226, 226, 226, 226, 226, 228, 228, 226,
226, 226, 226, 226, 226, 226, 226, 226, 38, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 229, 226, 226, 20, 226,
226, 226, 230, 226, 226, 226, 226, 226, 226, 226,
228, 228, 226, 226, 226, 34, 226, 43, 226, 226,
226, 226, 226, 226, 226, 226, 38, 40, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 229, 231, 226, 226, 226, 230, 226, 226, 226,
228, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 231, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 231, 137, 226, 226,
226, 228, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 137,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 228, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 228, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
228, 226, 226, 226, 228, 226, 232, 228, 232, 226,
228, 228, 228, 228, 228, 0, 226, 226, 226, 226,
226, 226
} ;
static yyconst short int yy_nxt[876] =
{ 0,
4, 5, 6, 5, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 10, 17, 18, 19, 20, 21,
22, 23, 24, 25, 26, 27, 4, 28, 28, 28,
28, 29, 30, 28, 28, 28, 28, 28, 28, 28,
28, 28, 28, 28, 28, 28, 28, 31, 32, 33,
34, 46, 34, 64, 50, 47, 65, 93, 41, 93,
41, 225, 35, 224, 36, 37, 51, 38, 39, 40,
42, 73, 43, 69, 70, 44, 44, 44, 54, 54,
54, 55, 74, 85, 85, 85, 56, 223, 58, 222,
60, 60, 60, 57, 58, 220, 59, 59, 60, 221,
91, 62, 92, 92, 92, 73, 61, 62, 62, 62,
108, 220, 61, 109, 62, 62, 74, 41, 81, 41,
82, 82, 82, 218, 63, 76, 52, 76, 215, 42,
83, 43, 83, 214, 44, 44, 44, 77, 211, 78,
79, 210, 80, 80, 80, 81, 209, 84, 84, 84,
115, 115, 115, 53, 86, 197, 87, 87, 88, 196,
44, 44, 44, 195, 89, 172, 61, 90, 97, 169,
168, 105, 61, 105, 90, 90, 106, 106, 106, 142,
141, 54, 54, 54, 63, 86, 133, 88, 88, 88,
132, 226, 101, 111, 110, 89, 226, 100, 90, 101,
101, 103, 103, 103, 99, 90, 90, 93, 94, 93,
98, 216, 104, 216, 58, 217, 60, 60, 60, 104,
104, 226, 91, 75, 95, 95, 95, 62, 72, 112,
96, 113, 113, 113, 62, 62, 112, 68, 114, 114,
114, 116, 67, 80, 80, 80, 119, 119, 119, 66,
226, 117, 53, 120, 118, 82, 82, 82, 125, 125,
125, 118, 118, 52, 48, 120, 121, 84, 84, 84,
85, 85, 85, 121, 121, 128, 128, 128, 121, 45,
226, 122, 123, 123, 123, 121, 121, 226, 122, 122,
126, 226, 126, 124, 226, 127, 127, 127, 226, 226,
124, 124, 129, 226, 92, 92, 92, 131, 131, 131,
216, 134, 216, 134, 217, 130, 135, 135, 135, 106,
106, 106, 130, 130, 129, 226, 95, 95, 95, 103,
103, 103, 226, 226, 97, 226, 139, 130, 139, 226,
136, 140, 140, 140, 130, 130, 226, 138, 138, 106,
106, 106, 143, 143, 143, 144, 226, 113, 113, 113,
149, 149, 149, 226, 150, 226, 150, 226, 145, 151,
151, 151, 125, 125, 125, 145, 145, 144, 226, 114,
114, 114, 115, 115, 115, 226, 226, 97, 226, 226,
145, 226, 226, 146, 147, 147, 147, 145, 145, 226,
146, 146, 127, 127, 127, 148, 119, 119, 119, 153,
153, 153, 148, 148, 226, 226, 155, 152, 155, 226,
154, 156, 156, 156, 152, 152, 226, 154, 154, 157,
226, 157, 226, 226, 158, 158, 158, 123, 123, 123,
161, 226, 161, 226, 226, 162, 162, 162, 159, 127,
127, 127, 128, 128, 128, 160, 160, 164, 164, 164,
166, 226, 166, 163, 226, 167, 167, 167, 165, 226,
163, 163, 131, 131, 131, 165, 165, 135, 135, 135,
135, 135, 135, 170, 226, 170, 226, 226, 171, 171,
171, 226, 226, 226, 170, 226, 170, 226, 226, 171,
171, 171, 226, 140, 140, 140, 140, 140, 140, 143,
143, 143, 174, 174, 174, 149, 149, 149, 226, 176,
173, 176, 226, 175, 177, 177, 177, 173, 173, 226,
175, 175, 178, 226, 178, 226, 226, 179, 179, 179,
147, 147, 147, 181, 226, 181, 226, 226, 182, 182,
182, 180, 151, 151, 151, 151, 151, 151, 180, 180,
183, 226, 183, 226, 226, 184, 184, 184, 153, 153,
153, 186, 226, 186, 226, 226, 187, 187, 187, 185,
156, 156, 156, 156, 156, 156, 185, 185, 158, 158,
158, 158, 158, 158, 188, 226, 188, 226, 226, 189,
189, 189, 188, 226, 188, 226, 226, 189, 189, 189,
162, 162, 162, 162, 162, 162, 190, 226, 190, 226,
226, 191, 191, 191, 164, 164, 164, 193, 226, 193,
226, 226, 194, 194, 194, 192, 167, 167, 167, 167,
167, 167, 192, 192, 171, 171, 171, 171, 171, 171,
198, 226, 198, 226, 226, 199, 199, 199, 174, 174,
174, 201, 226, 201, 226, 226, 202, 202, 202, 200,
177, 177, 177, 177, 177, 177, 200, 200, 179, 179,
179, 179, 179, 179, 203, 226, 203, 226, 226, 204,
204, 204, 182, 182, 182, 182, 182, 182, 184, 184,
184, 184, 184, 184, 205, 226, 205, 226, 226, 206,
206, 206, 187, 187, 187, 187, 187, 187, 189, 189,
189, 189, 189, 189, 191, 191, 191, 191, 191, 191,
207, 226, 207, 226, 226, 208, 208, 208, 194, 194,
194, 194, 194, 194, 199, 199, 199, 199, 199, 199,
212, 226, 212, 226, 226, 213, 213, 213, 202, 202,
202, 202, 202, 202, 204, 204, 204, 204, 204, 204,
206, 206, 206, 206, 206, 206, 208, 208, 208, 208,
208, 208, 213, 213, 213, 213, 213, 213, 49, 49,
49, 226, 49, 71, 71, 71, 71, 71, 71, 102,
226, 102, 102, 102, 102, 102, 102, 107, 107, 107,
137, 226, 137, 226, 226, 137, 219, 219, 219, 219,
219, 219, 219, 219, 3, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226
} ;
static yyconst short int yy_chk[876] =
{ 0,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 9, 2, 23, 15, 9, 23, 93, 5, 93,
5, 224, 2, 223, 2, 2, 15, 2, 2, 2,
5, 30, 5, 27, 27, 5, 5, 5, 18, 18,
18, 19, 30, 37, 37, 37, 19, 222, 22, 221,
22, 22, 22, 19, 20, 219, 20, 20, 20, 218,
42, 22, 42, 42, 42, 73, 20, 20, 22, 22,
64, 217, 20, 64, 20, 20, 73, 41, 35, 41,
35, 35, 35, 215, 20, 34, 35, 34, 211, 41,
36, 41, 36, 210, 41, 41, 41, 34, 197, 34,
34, 196, 34, 34, 34, 36, 195, 36, 36, 36,
79, 79, 79, 36, 38, 172, 38, 38, 38, 169,
44, 44, 44, 168, 38, 142, 38, 38, 44, 133,
132, 62, 38, 62, 38, 38, 62, 62, 62, 111,
108, 54, 54, 54, 38, 40, 99, 40, 40, 40,
98, 87, 54, 72, 70, 40, 59, 49, 40, 54,
54, 58, 58, 58, 47, 40, 40, 43, 43, 43,
46, 214, 58, 214, 60, 214, 60, 60, 60, 58,
58, 39, 43, 32, 43, 43, 43, 60, 29, 77,
43, 77, 77, 77, 60, 60, 78, 26, 78, 78,
78, 80, 25, 80, 80, 80, 81, 81, 81, 24,
21, 80, 17, 82, 80, 82, 82, 82, 89, 89,
89, 80, 80, 16, 11, 84, 82, 84, 84, 84,
85, 85, 85, 82, 82, 91, 91, 91, 84, 7,
3, 85, 86, 86, 86, 84, 84, 0, 85, 85,
90, 0, 90, 86, 0, 90, 90, 90, 0, 0,
86, 86, 92, 0, 92, 92, 92, 97, 97, 97,
216, 101, 216, 101, 216, 92, 101, 101, 101, 105,
105, 105, 92, 92, 95, 0, 95, 95, 95, 103,
103, 103, 0, 0, 95, 0, 104, 95, 104, 0,
103, 104, 104, 104, 95, 95, 0, 103, 103, 106,
106, 106, 112, 112, 112, 113, 0, 113, 113, 113,
117, 117, 117, 0, 118, 0, 118, 0, 113, 118,
118, 118, 125, 125, 125, 113, 113, 114, 0, 114,
114, 114, 115, 115, 115, 0, 0, 114, 0, 0,
114, 0, 0, 115, 116, 116, 116, 114, 114, 0,
115, 115, 126, 126, 126, 116, 119, 119, 119, 120,
120, 120, 116, 116, 0, 0, 121, 119, 121, 0,
120, 121, 121, 121, 119, 119, 0, 120, 120, 122,
0, 122, 0, 0, 122, 122, 122, 123, 123, 123,
124, 0, 124, 0, 0, 124, 124, 124, 123, 127,
127, 127, 128, 128, 128, 123, 123, 129, 129, 129,
130, 0, 130, 128, 0, 130, 130, 130, 129, 0,
128, 128, 131, 131, 131, 129, 129, 134, 134, 134,
135, 135, 135, 136, 0, 136, 0, 0, 136, 136,
136, 137, 137, 137, 138, 0, 138, 0, 0, 138,
138, 138, 137, 139, 139, 139, 140, 140, 140, 143,
143, 143, 144, 144, 144, 149, 149, 149, 0, 145,
143, 145, 0, 144, 145, 145, 145, 143, 143, 0,
144, 144, 146, 0, 146, 0, 0, 146, 146, 146,
147, 147, 147, 148, 0, 148, 0, 0, 148, 148,
148, 147, 150, 150, 150, 151, 151, 151, 147, 147,
152, 0, 152, 0, 0, 152, 152, 152, 153, 153,
153, 154, 0, 154, 0, 0, 154, 154, 154, 153,
155, 155, 155, 156, 156, 156, 153, 153, 157, 157,
157, 158, 158, 158, 159, 0, 159, 0, 0, 159,
159, 159, 160, 0, 160, 0, 0, 160, 160, 160,
161, 161, 161, 162, 162, 162, 163, 0, 163, 0,
0, 163, 163, 163, 164, 164, 164, 165, 0, 165,
0, 0, 165, 165, 165, 164, 166, 166, 166, 167,
167, 167, 164, 164, 170, 170, 170, 171, 171, 171,
173, 0, 173, 0, 0, 173, 173, 173, 174, 174,
174, 175, 0, 175, 0, 0, 175, 175, 175, 174,
176, 176, 176, 177, 177, 177, 174, 174, 178, 178,
178, 179, 179, 179, 180, 0, 180, 0, 0, 180,
180, 180, 181, 181, 181, 182, 182, 182, 183, 183,
183, 184, 184, 184, 185, 0, 185, 0, 0, 185,
185, 185, 186, 186, 186, 187, 187, 187, 188, 188,
188, 189, 189, 189, 190, 190, 190, 191, 191, 191,
192, 0, 192, 0, 0, 192, 192, 192, 193, 193,
193, 194, 194, 194, 198, 198, 198, 199, 199, 199,
200, 0, 200, 0, 0, 200, 200, 200, 201, 201,
201, 202, 202, 202, 203, 203, 203, 204, 204, 204,
205, 205, 205, 206, 206, 206, 207, 207, 207, 208,
208, 208, 212, 212, 212, 213, 213, 213, 227, 227,
227, 0, 227, 228, 228, 228, 228, 228, 228, 229,
0, 229, 229, 229, 229, 229, 229, 230, 230, 230,
231, 0, 231, 0, 0, 231, 232, 232, 232, 232,
232, 232, 232, 232, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226, 226, 226, 226, 226, 226,
226, 226, 226, 226, 226
} ;
static yy_state_type yy_last_accepting_state;
static char *yy_last_accepting_cpos;
/* The intent behind this definition is that it'll catch
* any uses of REJECT which flex missed.
*/
#define REJECT reject_used_but_not_detected
#define yymore() yymore_used_but_not_detected
#define YY_MORE_ADJ 0
char *yytext;
#define INITIAL 0
/********************************************************************
*
* File: datafile.lex, lexyy.c
*
* Contents: lexical analyzer for evolver data files.
* Constructed from datafile.lex by lex.
*/
/* will have my own input() and output() */
#ifdef FLEX_SCANNER
#define YY_INPUT(buf,result,max_size) \
{ \
int c = kb_input(); \
result = (c == 0) ? YY_NULL : (buf[0] = c, 1); \
}
#else
/* lex scanner */
#undef input
#undef unput
#define input kb_input
#define unput rawunput
#endif
#include "include.h"
#include "lex.h"
#include "ytab.h"
static int previous_char = 0; /* for CR conversion */
static int BUFFSIZE = 0; /* size of lex buffer */
static char *buff = NULL; /* lex buffer, expandable */
static int spot = 0;
#define ERRBUFFSIZE 80
static char errbuff[ERRBUFFSIZE+4]; /* for reporting spot of error */
static int errspot;
extern int ubuff_spot;
struct ckey { char *name; int token; } const_expr_keywords[] =
{
{"pi",PI_},
{"e",E_},
{"g",G_}
};
void savein ARGS((int));
void get_more_input ARGS((void));
int keyword_compare ARGS(( struct ckey *, struct ckey *));
/* Wrapper for yylex() to buffer look-ahead token */
#define UNPUTMAX 10
int unputted_tok[UNPUTMAX]; /* unput token number */
int unput_tok_count; /* 1 if token was unput */
YYSTYPE yylval;
char kb_input_new ARGS((void));
void kb_unput ARGS((char));
int kblex ARGS((void));
#define KB_INPUT kb_input_new
#define KB_UNPUT kb_unput
/* for generation of bad tokens for error message generation */
/* for use with -E command line option */
int next_err_token = 0; /* token in file for which to generate error */
int token_count; /* resets on file initialization */
int err_tok_gen_flag; /* whether -E option in effect */
int kb_yylex(lvalp)
YYSTYPE *lvalp; /* for pure parser destination for yylval */
{
if ( lvalp )
{ PROF_FINISH(yyparse); /* exclude from yyparse time */
}
PROF_START(yylex);
if ( unput_tok_count )
{ tok = unputted_tok[--unput_tok_count];
}
else
{
/* clean out previous data */
/* memset(&yylval,0,sizeof(yylval)); time hog*/
/* tok = yylex(); */
if ( err_tok_gen_flag )
{ if ( token_count == next_err_token )
{ tok = GEN_ERROR_TOKEN;
if ( yytext )
strcpy(yytext,"generated error");
next_err_token++;
token_count += 10000000; /* just one error per file */
return tok;
}
token_count++;
}
tok = kblex();
}
switch ( tok )
{ case '(' : parens++; break;
case ')' : parens--; break;
case '{' : brace_depth++; break;
case '}' : brace_depth--; break;
}
if ( lvalp )
{
{
/* non-movsd substitute for *lvalp = yylval; */
int i;
int *dest = (int*)lvalp;
int *src = (int*)&yylval;
for ( i = 0 ; i < sizeof(yylval)/sizeof(int) ; i++ )
*(dest++) = *(src++);
}
PROF_START(yyparse);
}
PROF_FINISH(yylex);
return tok;
}
/* For unputting unneeded look-ahead token */
void unput_tok()
{
if ( unput_tok_count >= UNPUTMAX )
kb_error(2324,"Internal error: unputted_tok stack overflow.\n",RECOVERABLE);
unputted_tok[unput_tok_count++] = tok;
/* fprintf(stderr,"UNPUT %3d %s %s\n",tok,tokname(tok),yytext); */
/* tok = UNPUTTED_; */ /* some places depend on knowing unput lookahead */
}
#ifndef NOPROTO
int rawinput ARGS((void));
int yyback(int *,int);
/* #define yyoutput yyout_unused */
/* #define yyunput yyunput_unused */
#endif
extern FILE *data_fd;
extern char *cmdptr;
int line_no = 1;
int macro_flag; /* tells macro() identifier is being #define'd */
/* return values for macro() */
#define NO_MACRO 0
#define WAS_MACRO_DEF 1
#define MACRO_EXPANDED 2
char *whitespace = " \t\r,:;"; /* whitespace */
#define SUBMAX 500
int macro_max;
int macro_subs_top; /* index of top of string space */
int macro_subs_max; /* space allocated for strings */
struct dkey { char *name; int token; } datafile_keywords[] =
{
{"content_rank",CONTENT_RANK_},
{"clip_coeff",CLIP_COEFF},
{"slice_coeff",SLICE_COEFF},
{"high_constraint",V_HIGH_CONSTRAINT},
{"high_boundary",V_HIGH_BOUNDARY},
{"suppress_warning",SUPPRESS_WARNING_},
{"unsuppress_warning",UNSUPPRESS_WARNING_},
{"volume_method_name",VOLUME_METHOD_NAME_},
{"partner_hitting",PARTNER_HITTING_},
{"procedure",PROCEDURE_WORD_},
{"display_origin",DISPLAY_ORIGIN_},
{"length_method_name",LENGTH_METHOD_NAME_},
{"area_method_name",AREA_METHOD_NAME_},
{"hessian_special_normal_vector",HESSIAN_SPECIAL_NORMAL_VECTOR_},
{"keep_originals",KEEP_ORIGINALS_},
{"element_modulus",ELEMENT_MODULUS_},
{"swap_colors",SWAP_COLORS_},
{"self",SELF_},
{"conserved",CONSERVED_},
{"actual_volume",ACTUAL_VOLUME_},
{"keep_macros",KEEP_MACROS_},
{"pdelta",DELTA_ },
{"tolerance",TOLERANCE_},
{"lagrange_multiplier",LAGRANGE_MULTIPLIER_ },
{"evolver_version",VERSION_},
{"orientation",ORIENTATION_},
{"ignore_constraints",IGNORE_CONSTRAINTS_},
{"ignore_fixed",IGNORE_FIXED_},
{"load_library",LOAD_LIBRARY_},
{"interp_bdry_param",INTERP_BDRY_PARAM_},
{"axial_point",AXIAL_POINT_},
{"lagrange",LAGRANGE_},
{"lagrange_order",LAGRANGE_ORDER_},
{"parameter_1",PARAMETER_1_},
{"optimizing_parameter",OPTIMIZING_PARAMETER_},
{"optimising_parameter",OPTIMIZING_PARAMETER_},
{"everything_quantities",EVERYTHING_QUANTITIES_},
{"value",VALUE_},
{"target",TARGET_},
{"define",DEFINE_},
{"attribute",ATTRIBUTE_},
{"method_instance",METHOD_INSTANCE_},
{"method",METHOD_},
{"scalar_integrand",SCALAR_INTEGRAND_},
{"vector_integrand",VECTOR_INTEGRAND_},
{"k_vector_order",K_VEC_ORDER_},
{"form_integrand",FORM_INTEGRAND_},
{"mobility",MOBILITY_},
{"mobility_tensor",MOBILITY_TENSOR_},
{"bare",BARE_},
{"boundary_curvature",BOUNDARY_CURVATURE_},
{"modulus",MODULUS_},
{"info_only",INFO_ONLY_},
{"global_method",GLOBAL_METHOD_},
{"global",GLOBAL_},
{"area_fixed",AREA_FIXED_},
{"fixed_area",AREA_FIXED_},
{"view_matrix",VIEW_MATRIX_},
{"view_transforms",VIEW_TRANSFORMS_},
{"view_transform_generators",VIEW_TRANSFORM_GENS_},
{"homothety",HOMOTHETY_},
{"approximate_curvature",APPROX_CURV_},
{"approx_curvature",APPROX_CURV_},
{"phasefile",PHASEFILE_},
{"phase",PHASE_},
{"autopop",AUTOPOP_},
{"autopop_quartic",AUTOPOP_QUARTIC_},
{"autochop",AUTOCHOP_},
{"total_time",TOTAL_TIME_},
{"effective_area",EFFECTIVE_AREA_},
{"runge_kutta",RUNGE_KUTTA_},
{"color",COLOR_},
{"backcolor",BACKCOLOR_},
{"frontcolor",FRONTCOLOR_},
{"mean_curvature_integral",MEAN_CURV_INT_},
{"normal_curvature",NORMAL_CURVATURE_},
{"square_curvature",SQUARE_CURVATURE_},
{"squared_curvature",SQUARE_CURVATURE_},
{"square_gaussian_curvature",SQGAUSS_},
{"squared_gaussian_curvature",SQGAUSS_},
{"gauss_curvature",GAUSS_CURVATURE_},
{"insulating_knot_energy",INSULATING_KNOT_ENERGY_},
{"conducting_knot_energy",CONDUCTING_KNOT_ENERGY_},
{"space_dimension",SPACE_DIMENSION_},
{"surface_dimension",SURFACE_DIMENSION_},
{"simplex_representation",SIMPLEX_REP_},
{"metric",METRIC_},
{"klein_metric",KLEIN_METRIC_},
{"conformal_metric",CONFORMAL_},
{"fixed",FIXED_},
{"no_refine",NO_REFINE_},
{"hit_partner",HIT_PARTNER_},
{"no_display",NODISPLAY_},
{"noncontent",NONCONTENT_},
{"efixed",EFIXED_},
{"symmetry_group",SYMMETRY_GROUP_},
{"wrap",WRAP_},
{"torus",TORUS_},
{"torus_filled",TORUS_FILLED_},
{"torus_periods",TORUS_PERIODS_},
{"periods",PERIODS_},
{"display_periods",DISPLAY_PERIODS_},
{"string",STRING_},
{"soapfilm",SOAPFILM_},
{"wulff",WULFF_},
{"boundary",BOUNDARY_},
{"boundaries",BOUNDARY_},
{"constraint",CONSTRAINT_},
{"constraints",CONSTRAINT_},
{"surface_energy",SURFACE_ENERGY_},
{"formula",FUNCTION_},
{"function",FUNCTION_},
{"parameter",PARAMETERS_},
{"parameters",PARAMETERS_},
{"parameter_file",PARAMETER_FILE_},
{"symmetric_content",SYMMETRIC_CONTENT_},
{"integral_order",V_INTEGRAL_ORDER},
{"integral_order_1d",V_INTEGRAL_ORDER_1D},
{"integral_order_2d",V_INTEGRAL_ORDER_2D},
{"integration_order",V_INTEGRAL_ORDER},
{"integration_order_1d",V_INTEGRAL_ORDER_1D},
{"integration_order_2d",V_INTEGRAL_ORDER_2D},
{"constraint_tolerance",CONSTRAINT_TOLERANCE_ },
{"convex",CONVEX_},
{"nonwall",NONWALL_},
{"nonnegative",NONNEGATIVE_},
{"nonpositive",NONPOSITIVE_},
{"global",GLOBAL_},
{"energy",ENERGY_},
{"content",CONTENT_},
{"quadratic",QUADRATIC_},
{"linear",LINEAR_},
{"area_normalization",MEAN_CURV_},
{"jiggle",JIGGLE_},
{"diffusion",DIFFUSION_},
{"merit_factor",MERITFACTOR_},
{"gravity_constant",GRAV_CONST_},
{"spring_constant",SPRING_CONSTANT_},
{"gap_constant",GAP_CONSTANT_},
{"scale",SCALE_},
{"pscale",SCALE_},
{"temperature",TEMPERATURE_},
{"pressure",PRESSURE_},
{"volume",VOLUME_},
{"density",DENSITY_},
{"tension",DENSITY_},
{"nodisplay",NODISPLAY_},
{"scale_limit",SCALE_LIMIT_},
{"zoom_vertex",ZOOM_VERTEX_},
{"zoom_radius",ZOOM_RADIUS_},
{"quantity",QUANTITY_ },
{"volconst",VOLCONST_ },
{"read",READ_},
{"and",AND_},
{"or",OR_},
{"not",NOT_},
{"mod",'%'},
{"imod",IMOD_},
{"idiv",IDIV_},
{"dot_product",DOT_},
{"pi",PI_},
{"e",E_},
{"g",G_},
{"tag",TAG_},
{"original",ORIGINAL_},
{"vertices",VERTICES_},
{"vertex",VERTICES_},
{"edges",EDGES_},
{"edge",EDGES_},
{"faces",FACES_},
{"face",FACES_},
{"facets",FACES_},
{"facet",FACES_},
{"bodies",BODIES_},
{"body",BODIES_},
{"facet_edges",FACETEDGES_},
{"facet_edge",FACETEDGES_},
{"facetedges",FACETEDGES_},
{"facetedge",FACETEDGES_}
};
struct ckey mathfunc_keywords[] = {
{"wrap_inverse",WRAP_INVERSE_},
{"ellipticK",ELLIPTICK},
{"ellipticE",ELLIPTICE},
{"log",LOG},
{"exp",EXP},
{"sin",SIN},
{"cos",COS},
{"tan",TAN},
{"asin",ASIN},
{"acos",ACOS},
{"atan",ATAN},
{"sinh",SINH},
{"cosh",COSH},
{"tanh",TANH},
{"asinh",ASINH},
{"acosh",ACOSH},
{"atanh",ATANH},
{"sqrt",SQRT},
{"sqr",SQR},
{"ceil",CEIL_},
{"floor",FLOOR_},
{"abs",ABS}
};
struct ckey mathfunc2_keywords[] = { /* two arguments */
{"wrap_compose",WRAP_COMPOSE_},
{"atan2",ATAN2_},
{"incompleteEllipticF",INCOMPLETE_ELLIPTICF},
{"incompleteEllipticE",INCOMPLETE_ELLIPTICE},
{"maximum",MAXIMUM_},
{"minimum",MINIMUM_},
{"pow",POW}
};
struct ckey command_keywords[] =
{
{"valid_constraint",VALID_CONSTRAINT_},
{"valid_boundary",VALID_BOUNDARY_},
{"profiling",PROFILING_},
{"reset_profiling",RESET_PROFILING_},
{"suppress_warning",SUPPRESS_WARNING_},
{"unsuppress_warning",UNSUPPRESS_WARNING_},
{"delete_text",DELETE_TEXT_},
{"display_text", DISPLAY_TEXT_ },
{"simplex_to_fe", SIMPLEX_TO_FE_ },
{"addload", ADDLOAD_ },
{"whereami",WHEREAMI_},
{"breakpoint",BREAKPOINT_},
{"breakpoints",BREAKPOINT_},
{"abort",ABORT_},
{"subcommand",SUBCOMMAND_},
{"global",GLOBAL_},
{"repartition",REPARTITION_},
{"free_discards",FREE_DISCARDS_},
{"dump_memlist",DUMP_MEMLIST_},
{"reverse_orientation",REVERSE_ORIENTATION_},
{"matrix_multiply",MATRIX_MULTIPLY_},
{"matrix_inverse",MATRIX_INVERSE_},
{"matrix_determinant",MATRIX_DETERMINANT_},
{"mid_edge",MID_EDGE_},
{"mid_facet",MID_FACET_},
{"flush_counts",FLUSH_COUNTS_},
{"valid_element",VALID_ELEMENT_},
{"reset_counts",RESET_COUNTS_},
{"vertex_merge",MERGE_VERTEX_},
{"edge_merge",MERGE_EDGE_},
{"facet_merge",MERGE_FACET_},
{"mpi_task",MPI_TASK_ATTR_},
{"mean_curvature",MEAN_CURVATURE_},
{"element_modulus",ELEMENT_MODULUS_},
{"ignore_constraints",IGNORE_CONSTRAINTS_},
{"ignore_fixed",IGNORE_FIXED_},
{"global_method",GLOBAL_METHOD_},
{"scalar_integrand",SCALAR_INTEGRAND_},
{"vector_integrand",VECTOR_INTEGRAND_},
{"k_vector_order",K_VEC_ORDER_},
{"form_integrand",FORM_INTEGRAND_},
{"info_only",INFO_ONLY_},
{"method",METHOD_},
{"parallel_exec",PARALLEL_EXEC_},
{"task_exec",TASK_EXEC_},
{"pop",POP_},
{"pop_tri_to_edge",POP_TRI_TO_EDGE_},
{"pop_edge_to_tri",POP_EDGE_TO_TRI_},
{"pop_quad_to_quad",POP_QUAD_TO_QUAD_},
{"local",LOCAL_},
{"for",FOR_},
{"warning_messages",WARNING_MESSAGES_},
{"equiangulate",EQUIANGULATE_},
{"no_refine",NO_REFINE_},
{"hit_partner",HIT_PARTNER_},
{"no_display",NODISPLAY_},
{"vertexnormal",VERTEXNORMAL_},
{"colorfile",COLORFILE_},
{"date_and_time",DATE_AND_TIME_},
{"exprint",EXPRINT_},
{"energy",ENERGY_},
{"info_only",INFO_ONLY_},
{"conserved",CONSERVED_},
{"exec",EXEC_},
{"wrap_vertex",WRAP_VERTEX_},
{"self",SELF_},
{"is_defined",IS_DEFINED_},
{"nodisplay",NODISPLAY_},
{"no_display",NODISPLAY_},
{"function",FUNCTION_},
{"reorder_storage",REORDER_STORAGE_},
{"renumber_all",RENUMBER_ALL_},
/* {"view_matrix",VIEW_MATRIX_}, */
{"pause",PAUSE_},
{"pdelta",DELTA_ },
{"pscale",SCALE_ },
{"scale",SCALE_ },
{"tolerance",TOLERANCE_},
{"method_instance",METHOD_INSTANCE_},
{"logfile",LOGFILE_},
{"keylogfile",KEYLOGFILE_},
{"frontbody",FRONTBODY_},
{"backbody",BACKBODY_},
{"new_vertex",NEWVERTEX_},
{"new_edge",NEWEDGE_},
{"new_facet",NEWFACET_},
{"new_body",NEWBODY_},
{"noncontent",NONCONTENT_},
/* {"inverse_periods",INVERSE_PERIODS_}, */
{"return",RETURN_},
{"postscript",POSTSCRIPT_},
{"ooglfile",OOGLFILE_},
{"binary_off_file",BINARY_OFF_FILE_},
{"vertex_average",VERTEX_AVERAGE_},
{"raw_vertex_average",RAW_VERTEX_AVERAGE_},
{"rawest_vertex_average",RAWEST_VERTEX_AVERAGE_},
{"axial_point",AXIAL_POINT_},
{"metis_factor",METIS_FACTOR_},
{"lagrange",LAGRANGE_},
{"metis",METIS_},
{"metis_readjust",METIS_READJUST_},
{"body_metis",BODY_METIS_},
{"kmetis",KMETIS_},
{"ometis",OMETIS_},
{"sizeof",SIZEOF_},
{"move",MOVE_},
{"geompipe",GEOMPIPE_},
{"convert_to_quantities",CONVERT_TO_QUANTS_},
{"edgeswap",EDGESWAP_},
{"t1_edgeswap",T1_EDGESWAP_},
/* {"torus_periods",TORUS_PERIODS_}, */
{"break",BREAK_},
{"volfixed",FIXEDVOL_},
{"continue",CONTINUE_},
{"volconst",VOLCONST_ },
{"ritz",RITZ_},
{"orientation",ORIENTATION_},
{"eigenprobe",EIGENPROBE_},
{"lanczos",LANCZOS_},
{"tetra_point",TETRA_POINT_},
{"triple_point",TRIPLE_POINT_},
{"value",VALUE_},
{"target",TARGET_},
{"datafilename",DATAFILENAME_},
{"geomview",GEOMVIEW_},
{"saddle",HESSIAN_SADDLE_},
{"midv",MIDV_},
{"define",DEFINE_},
{"attribute",ATTRIBUTE_},
{"attributes",ATTRIBUTE_},
{"string",STRING_},
{"sobolev",SOBOLEV_},
{"sobolev_seek",SOBOLEV_SEEK_},
{"dirichlet",DIRICHLET_},
{"dirichlet_seek",DIRICHLET_SEEK_},
{"wrap",WRAP_},
{"total",TOTAL_},
{"history",HISTORY_},
{"fix",FIX_},
{"unfix",UNFIX_},
{"bare",BARE_},
{"phase",PHASE_},
{"foreach",FOREACH_},
{"rebody", REBODY_},
{"burchard", BURCHARD_},
{"close_show",CLOSE_SHOW_},
{"show_off",CLOSE_SHOW_},
/* {"view_transforms",VIEW_TRANSFORMS_}, */
/* {"view_transform_swap_colors",VIEW_TRANSFORM_SWAP_COLORS_}, */
/* {"view_transform_parity",VIEW_TRANSFORM_PARITY_}, */
{"transform_depth",TRANSFORM_DEPTH_},
{"transform_expr",TRANSFORM_EXPR_},
{"modulus",MODULUS_},
{"boundary",BOUNDARY_},
{"on_constraint",ON_CONSTRAINT_},
{"hit_constraint",HIT_CONSTRAINT_},
{"on_boundary",ON_BOUNDARY_},
{"on_quantity",ON_QUANTITY_},
{"on_method_instance",ON_METHOD_INSTANCE_},
{"hessian",HESSIAN_},
{"hessian_seek",HESSIAN_SEEK_},
{"hessian_menu",HESSIAN_MENU_},
{"help",HELP_},
{"quit",QUIT_},
{"exit",QUIT_},
{"bye",QUIT_},
{"dump",DUMP_},
{"load",LOAD_},
{"permload",PERMLOAD_},
{"quantity",QUANTITY_},
{"spring_constant",GAP_CONSTANT_},
{"gap_constant",GAP_CONSTANT_},
{"notch",NOTCH_},
{"while",WHILE_},
{"do",DO_},
{"if",IF_},
{"then",THEN_},
{"else",ELSE_},
{"histogram",HISTOGRAM_},
{"loghistogram",LOGHISTOGRAM_},
{"show_expr",SHOW_EXPR_},
{"show_trans",SHOW_TRANS_},
{"dihedral",DIHEDRAL_},
{"max",MAX_},
{"min",MIN_},
{"avg",AVG_},
{"sum",SUM_},
{"count",COUNT_},
{"print",PRINT_},
{"eprint",EPRINT_},
{"printf",PRINTF_},
{"errprintf",ERRPRINTF_},
{"sprintf",SPRINTF_},
{"binary_printf",BINARY_PRINTF_},
{"procedures",PROCEDURES_},
{"procedure",PROCEDURE_WORD_},
{"on",ON_},
{"counts",COUNTS_},
{"extrapolate",EXTRAPOLATE_},
{"off",OFF_},
{"areaweed",AREAWEED_},
{"edgeweed",EDGEWEED_},
{"edge_divide",EDGEDIVIDE_},
{"alice",ALICE_},
{"stability_test",STABILITY_TEST_},
{"zoom",ZOOM_},
{"utest",UTEST_},
{"system",SYSTEM_},
{"chdir",CHDIR_},
{"longj",LONG_JIGGLE_},
{"rawv",RAW_VERAVG_},
{"rawestv",RAWEST_VERAVG_},
{"go",GO_},
{"refine",REFINE_},
{"check",CHECK_},
{"show_vol",SHOW_VOL_},
{"id",ID_},
{"oid",OID_},
{"and",AND_},
{"or",OR_},
{"not",NOT_},
{"mod",'%'},
{"imod",IMOD_},
{"idiv",IDIV_},
{"dot_product",DOT_},
{"pi",PI_},
{"e",E_},
{"g",G_},
{"tag",TAG_},
{"original",ORIGINAL_},
{"fixed",FIXED_},
{"vertices",VERTICES_},
{"vertex",VERTICES_},
{"edges",EDGES_},
{"edge",EDGES_},
{"facets",FACETS_},
{"facet",FACETS_},
{"faces",FACETS_},
{"face",FACETS_},
{"facet_edges",FACETEDGES_},
{"facet_edge",FACETEDGES_},
{"facetedges",FACETEDGES_},
{"facetedge",FACETEDGES_},
{"bodies",BODIES_},
{"body",BODIES_},
{"topinfo",TOPINFO_},
{"bottominfo",BOTTOMINFO_},
{"length",LENGTH_ },
{"valence",VALENCE_ },
{"area",AREA_ },
{"volume",VOLUME_ },
{"sqcurve",SQ_MEAN_CURV_},
{"where",WHERE_ },
{"list",LIST_ },
{"show",SHOW_},
{"showq",SHOWQ_},
{"delete",DELETE_ },
{"dissolve",DISSOLVE_ },
{"refine",REFINE_ },
{"shell",SHELL_},
{"constraint",CONSTRAINT_},
{"pressure",PRESSURE_},
{"color",COLOR_},
{"backcolor",BACKCOLOR_},
{"frontcolor",FRONTCOLOR_},
{"opacity",OPACITY_},
{"volume",VOLUME_},
{"density",DENSITY_},
{"tension",DENSITY_},
{"set",SET_},
{"read",READ_},
{"unset",UNSET_},
{"recalc",RECALC_},
{"optimize",OPTIMIZE_},
{"optimise",OPTIMIZE_},
{"autochop",AUTOCHOP_},
};
struct ckey togglenames[] = {
{"immediate_autopop",IMMEDIATE_AUTOPOP_},
{"star_finagling",STAR_FINAGLING_},
{"force_deletion",FORCE_DELETION_},
{"function_quantity_sparse",FUNCTION_QUANTITY_SPARSE_},
{"slice_view",SLICE_VIEW_},
{"clip_view",CLIP_VIEW_},
{"quietload",QUIETLOAD_},
{"big_endian",BIG_ENDIAN_},
{"little_endian",LITTLE_ENDIAN_},
{"full_bounding_box",FULL_BOUNDING_BOX_},
{"pop_disjoin",POP_DISJOIN_},
{"pop_enjoin",POP_ENJOIN_},
{"pop_to_edge",POP_TO_EDGE_},
{"pop_to_face",POP_TO_FACE_},
{"mpi_debug",MPI_DEBUG_},
{"smooth_graph",SMOOTH_GRAPH_},
{"bezier_basis",BEZIER_BASIS_},
{"break_after_warning",BREAK_AFTER_WARNING_},
{"blas_flag",BLAS_FLAG_},
{"diffusion",DIFFUSION_},
{"augmented_hessian",AUGMENTED_HESSIAN_},
{"sparse_constraints",SPARSE_CONSTRAINTS_},
{"visibility_test", VISIBILITY_TEST_},
{"circular_arc_draw",CIRCULAR_ARC_DRAW_},
{"rgb_colors",RGB_COLORS_FLAG_},
{"kraynikpopvertex",KRAYNIKPOPVERTEX_FLAG_},
{"kraynikpopedge",KRAYNIKPOPEDGE_FLAG_},
{"sobolev_mode",SOBOLEV_MODE_},
{"dirichlet_mode",DIRICHLET_MODE_},
{"verbose",VERBOSE_},
{"torus_filled",TORUS_FILLED_},
{"ambient_pressure",AMBIENT_PRESSURE_},
{"backcull",BACKCULL_},
{"interp_normals",INTERP_NORMALS_},
{"volgrads_every",VOLGRADS_EVERY_},
{"zener_drag",ZENER_DRAG_},
{"hessian_special_normal",HESSIAN_SPECIAL_NORMAL_},
{"hessian_normal_perp",HESSIAN_NORMAL_PERP_},
{"show_all_quantities",SHOW_ALL_QUANTITIES_},
{"pscolorflag",PSCOLORFLAG_},
{"ps_colorflag",PSCOLORFLAG_},
{"ps_gridflag",GRIDFLAG_},
{"gridflag",GRIDFLAG_},
{"crossingflag",CROSSINGFLAG_},
{"labelflag",LABELFLAG_},
{"ps_labelflag",LABELFLAG_},
{"hessian_normal_one",HESSIAN_NORMAL_ONE_},
{"interp_bdry_param",INTERP_BDRY_PARAM_},
{"hessian_double_normal",HESSIAN_DOUBLE_NORMAL_},
{"h_inverse_metric",H_INVERSE_METRIC_},
{"squared_gradient",SQUARED_GRADIENT_},
{"linear_metric",LINEAR_METRIC_},
{"metric_convert",METRIC_CONVERT_},
{"quantities_only",QUANTITIES_ONLY_},
{"ysmp",YSMP_},
{"bunch_kaufman",BUNCH_KAUFMAN_},
{"bunch_kauffman",BUNCH_KAUFMAN_},
{"hessian_normal",HESSIAN_NORMAL_},
{"jiggle",JIGGLE_TOGGLE_},
{"assume_oriented",ASSUME_ORIENTED_},
{"ribiere",RIBIERE_CG_},
{"area_normalization",MEAN_CURV_},
{"force_pos_def",FORCE_POS_DEF_},
{"autodisplay",AUTODISPLAY_},
{"lagrange",LAGRANGE_},
{"quadratic",QUADRATIC_},
{"linear",LINEAR_},
{"show_inner",SHOW_INNER_},
{"area_fixed",AREA_FIXED_},
{"fixed_area",AREA_FIXED_},
{"clipped",CLIPPED_CELLS_},
{"clipped_cells",CLIPPED_CELLS_},
{"raw_cells",RAW_CELLS_},
{"connected",CONNECTED_CELLS_},
{"connected_cells",CONNECTED_CELLS_},
{"show_outer",SHOW_OUTER_},
{"colormap",COLORMAP_},
{"thicken",THICKEN_},
{"hessian_diff",HESSIAN_DIFF_},
{"normal_motion",NORMAL_MOTION_},
{"runge_kutta",RUNGE_KUTTA_},
{"deturck",DETURCK_},
{"kusner",KUSNER_},
{"view_4d",VIEW_4D_},
{"conf_edge",CONF_EDGE_SQCURV_},
{"mean_curvature_integral",MEAN_CURV_INT_},
{"sqgauss",SQGAUSS_},
{"autopop",AUTOPOP_},
{"autopop_quartic",AUTOPOP_QUARTIC_},
{"old_area",OLD_AREA_},
{"approx_curv",APPROX_CURV_},
{"check_increase",CHECK_INCREASE_},
{"debug",DEBUG_},
{"memdebug",MEMDEBUG_},
{"itdebug",ITDEBUG_},
{"gravity",GRAVITY_},
{"effective_area",EFFECTIVE_AREA_},
{"estimate",ESTIMATE_},
{"post_project",POST_PROJECT_},
{"transforms",TRANSFORMS_},
{"quiet",QUIET_},
{"quietgo",QUIETGO_},
{"hessian_quiet",HESSIAN_QUIET_},
{"conj_grad",CONJ_GRAD_},
{"homothety",HOMOTHETY_},
{"facet_colors",FACET_COLORS_},
{"shading",SHADING_},
{"div_normal_curvature",DIV_NORMAL_CURVATURE_},
{"normal_curvature",NORMAL_CURVATURE_},
{"boundary_curvature",BOUNDARY_CURVATURE_},
{"self_similar",SELF_SIMILAR_},
{"gv_binary",GV_BINARY_},
{"metric_conversion",METRIC_CONVERSION_},
{"autorecalc",AUTORECALC_},
{"pinning",PINNING_}
};
struct ckey colornames[] = {
{"clear",CLEAR}, /* transparent */
{"transparent",CLEAR}, /* transparent */
{"black",BLACK}, /* dark colors */
{"blue",BLUE},
{"green",GREEN},
{"cyan",CYAN},
{"red",RED},
{"magenta",MAGENTA},
{"brown",BROWN},
{"lightgray",LIGHTGRAY},
{"lightgrey",LIGHTGRAY},
{"gray",LIGHTGRAY},
{"grey",LIGHTGRAY},
{"darkgray",DARKGRAY}, /* light colors */
{"darkgrey",DARKGRAY}, /* light colors */
{"lightblue",LIGHTBLUE},
{"lightgreen",LIGHTGREEN},
{"lightcyan",LIGHTCYAN},
{"lightred",LIGHTRED},
{"lightmagenta",LIGHTMAGENTA},
{"yellow",YELLOW},
{"white",WHITE}
};
struct ckey internal_variables[] = {
{"autochop_length",V_AUTOCHOP_LENGTH},
{"string_curve_tolerance",V_STRING_CURVE_TOLERANCE},
{"corona_state",V_CORONA_STATE},
{"mpi_maxtask",V_MPI_MAXTASK},
{"this_task",V_THIS_TASK}, /* MPI task number */
{"window_aspect_ratio",V_WINDOW_ASPECT_RATIO},
{"mindeg_debug_level",V_MINDEG_DEBUG_LEVEL},
{"mindeg_min_region_size",V_MINDEG_MIN_REGION_SIZE},
{"mindeg_margin",V_MINDEG_MARGIN},
{"fix_count",V_FIX_COUNT},
{"unfix_count",V_UNFIX_COUNT},
{"edge_delete_count",V_EDGE_DELETE_COUNT},
{"facet_delete_count",V_FACET_DELETE_COUNT},
{"vertex_dissolve_count",V_VERTEX_DISSOLVE_COUNT},
{"edge_dissolve_count",V_EDGE_DISSOLVE_COUNT},
{"facet_dissolve_count",V_FACET_DISSOLVE_COUNT},
{"body_dissolve_count",V_BODY_DISSOLVE_COUNT},
{"edge_refine_count",V_EDGE_REFINE_COUNT},
{"facet_refine_count",V_FACET_REFINE_COUNT},
{"vertex_pop_count",V_VERTEX_POP_COUNT},
{"edge_pop_count",V_EDGE_POP_COUNT},
{"pop_tri_to_edge_count",V_POP_TRI_TO_EDGE_COUNT},
{"pop_edge_to_tri_count",V_POP_EDGE_TO_TRI_COUNT},
{"pop_quad_to_quad_count",V_POP_QUAD_TO_QUAD_COUNT},
{"edgeswap_count",V_EDGESWAP_COUNT},
{"t1_edgeswap_count",V_T1_EDGESWAP_COUNT},
{"ps_labelsize",V_PS_LABELSIZE_},
{"ps_stringwidth",V_PS_STRINGWIDTH_},
{"ps_fixededgewidth",V_PS_FIXEDEDGEWIDTH_},
{"ps_tripleedgewidth",V_PS_TRIPLEEDGEWIDTH_},
{"ps_conedgewidth",V_PS_CONEDGEWIDTH_},
{"ps_bareedgewidth",V_PS_BAREEDGEWIDTH_},
{"ps_gridedgewidth",V_PS_GRIDEDGEWIDTH_},
{"scrollbuffersize",V_SCROLLBUFFERSIZE_},
{"visibility_debug",V_VISIBILITY_DEBUG_},
{"check_count",V_CHECK_COUNT_},
{"breakflag",V_BREAKFLAG_},
{"everything_quantities",EVERYTHING_QUANTITIES_},
{"gravity_constant",GRAV_CONST_},
{"hessian_slant_cutoff",V_HESSIAN_SLANT_CUTOFF},
{"ambient_pressure_value",V_AMBIENT_PRESSURE},
{"last_error",V_LAST_ERROR},
{"memory_arena",V_MEMARENA},
{"memory_used",V_MEMUSED},
{"background",V_BACKGROUND},
{"brightness",V_BRIGHTNESS},
{"diffusion_coeff",V_DIFFUSION},
{"transform_count",V_TRANSFORM_COUNT},
{"scale_limit",V_SCALE_LIMIT},
{"clock",V_CLOCK},
{"cpu_counter",V_CPU_COUNTER},
{"target_tolerance",V_TARGET_TOLERANCE},
{"thickness",V_THICKNESS},
{"spring_constant",V_GAP_CONSTANT},
{"gap_constant",V_GAP_CONSTANT},
{"lagrange_order",V_LAGRANGE_ORDER},
{"last_eigenvalue",V_LAST_EIGENVALUE},
{"last_hessian_scale",V_LAST_HESSIAN_SCALE},
{"integral_order",V_INTEGRAL_ORDER},
{"integral_order_1d",V_INTEGRAL_ORDER_1D},
{"integral_order_2d",V_INTEGRAL_ORDER_2D},
{"integration_order",V_INTEGRAL_ORDER},
{"integration_order_1d",V_INTEGRAL_ORDER_1D},
{"integration_order_2d",V_INTEGRAL_ORDER_2D},
{"random_seed",V_RANDOM_SEED},
{"random",V_RANDOM},
{"linear_metric_mix",V_LINEAR_METRIC_MIX},
{"quadratic_metric_mix",V_QUADRATIC_METRIC_MIX},
{"pickvnum",V_PICKVNUM},
{"pickenum",V_PICKENUM},
{"pickfnum",V_PICKFNUM},
{"eigen_pos",V_EIGENPOS},
{"eigen_neg",V_EIGENNEG},
{"eigen_zero",V_EIGENZERO},
{"eigenpos",V_EIGENPOS},
{"eigenneg",V_EIGENNEG},
{"eigenzero",V_EIGENZERO},
{"total_time",V_TIME},
{"jiggle_temperature",V_JIG_TEMP},
{"iteration_counter",V_ITER_COUNTER},
{"scale_scale",V_SCALE_SCALE},
{"vertex_count",V_VERTEXCOUNT},
{"edge_count",V_EDGECOUNT},
{"facet_count",V_FACETCOUNT},
{"body_count",V_BODYCOUNT},
{"facetedge_count",V_FACETEDGECOUNT},
{"total_energy",V_ENERGY},
{"total_area",V_AREA},
{"total_length",V_LENGTH},
{"scale",V_SCALE},
{"space_dimension",V_SPACE_DIMENSION},
{"surface_dimension",V_SURFACE_DIMENSION},
{"torus",V_TORUS},
{"symmetry_group",V_SYMMETRY_GROUP},
{"simplex_representation",V_SIMPLEX},
{"constraint_tolerance",V_TOLERANCE},
{"hessian_epsilon",V_HESS_EPSILON},
{"equi_count",V_EQUI_COUNT},
{"delete_count",V_DELETE_COUNT},
{"refine_count",V_REFINE_COUNT},
{"notch_count",V_NOTCH_COUNT},
{"dissolve_count",V_DISSOLVE_COUNT},
{"pop_count",V_POP_COUNT},
{"where_count",V_WHERE_COUNT}
};
/* %option array */
/* Macros after this point can all be overridden by user definitions in
* section 1.
*/
#ifndef YY_SKIP_YYWRAP
#ifdef __cplusplus
extern "C" int yywrap YY_PROTO(( void ));
#else
extern int yywrap YY_PROTO(( void ));
#endif
#endif
#ifndef YY_NO_UNPUT
static void yyunput YY_PROTO(( int c, char *buf_ptr ));
#endif
#ifndef yytext_ptr
static void yy_flex_strncpy YY_PROTO(( char *, yyconst char *, int ));
#endif
#ifndef YY_NO_INPUT
#ifdef __cplusplus
static int yyinput YY_PROTO(( void ));
#else
static int input YY_PROTO(( void ));
#endif
#endif
#if YY_STACK_USED
static int yy_start_stack_ptr = 0;
static int yy_start_stack_depth = 0;
static int *yy_start_stack = 0;
#ifndef YY_NO_PUSH_STATE
static void yy_push_state YY_PROTO(( int new_state ));
#endif
#ifndef YY_NO_POP_STATE
static void yy_pop_state YY_PROTO(( void ));
#endif
#ifndef YY_NO_TOP_STATE
static int yy_top_state YY_PROTO(( void ));
#endif
#else
#define YY_NO_PUSH_STATE 1
#define YY_NO_POP_STATE 1
#define YY_NO_TOP_STATE 1
#endif
#ifdef YY_MALLOC_DECL
YY_MALLOC_DECL
#else
#if __STDC__
#ifndef __cplusplus
#include
#endif
#else
/* Just try to get by without declaring the routines. This will fail
* miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int)
* or sizeof(void*) != sizeof(int).
*/
#endif
#endif
/* Amount of stuff to slurp up with each read. */
#ifndef YY_READ_BUF_SIZE
#define YY_READ_BUF_SIZE 8192
#endif
/* Copy whatever the last rule matched to the standard output. */
#ifndef ECHO
/* This used to be an fputs(), but since the string might contain NUL's,
* we now use fwrite().
*/
#define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
#endif
/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
* is returned in "result".
*/
#ifndef YY_INPUT
#define YY_INPUT(buf,result,max_size) \
if ( yy_current_buffer->yy_is_interactive ) \
{ \
int c = '*', n; \
for ( n = 0; n < max_size && \
(c = getc( yyin )) != EOF && c != '\n'; ++n ) \
buf[n] = (char) c; \
if ( c == '\n' ) \
buf[n++] = (char) c; \
if ( c == EOF && ferror( yyin ) ) \
YY_FATAL_ERROR( "input in flex scanner failed" ); \
result = n; \
} \
else if ( ((result = fread( buf, 1, max_size, yyin )) == 0) \
&& ferror( yyin ) ) \
YY_FATAL_ERROR( "input in flex scanner failed" );
#endif
/* No semi-colon after return; correct usage is to write "yyterminate();" -
* we don't want an extra ';' after the "return" because that will cause
* some compilers to complain about unreachable statements.
*/
#ifndef yyterminate
#define yyterminate() return YY_NULL
#endif
/* Number of entries by which start-condition stack grows. */
#ifndef YY_START_STACK_INCR
#define YY_START_STACK_INCR 25
#endif
/* Report a fatal error. */
#ifndef YY_FATAL_ERROR
#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
#endif
/* Default declaration of generated scanner - a define so the user can
* easily add parameters.
*/
#ifndef YY_DECL
#define YY_DECL int yylex YY_PROTO(( void ))
#endif
/* Code executed at the beginning of each rule, after yytext and yyleng
* have been set up.
*/
#ifndef YY_USER_ACTION
#define YY_USER_ACTION
#endif
/* Code executed at the end of each rule. */
#ifndef YY_BREAK
#define YY_BREAK break;
#endif
#define YY_RULE_SETUP \
if ( yyleng > 0 ) \
yy_current_buffer->yy_at_bol = \
(yytext[yyleng - 1] == '\n'); \
YY_USER_ACTION
YY_DECL
{
register yy_state_type yy_current_state;
register char *yy_cp, *yy_bp;
register int yy_act;
if ( yy_init )
{
yy_init = 0;
#ifdef YY_USER_INIT
YY_USER_INIT;
#endif
if ( ! yy_start )
yy_start = 1; /* first start state */
if ( ! yyin )
yyin = stdin;
if ( ! yyout )
yyout = stdout;
if ( ! yy_current_buffer )
yy_current_buffer =
yy_create_buffer( yyin, YY_BUF_SIZE );
yy_load_buffer_state();
}
while ( 1 ) /* loops until end-of-file is reached */
{
yy_cp = yy_c_buf_p;
/* Support of yytext. */
*yy_cp = yy_hold_char;
/* yy_bp points to the position in yy_ch_buf of the start of
* the current run.
*/
yy_bp = yy_cp;
yy_current_state = yy_start;
yy_current_state += YY_AT_BOL();
yy_match:
do
{
register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
if ( yy_accept[yy_current_state] )
{
yy_last_accepting_state = yy_current_state;
yy_last_accepting_cpos = yy_cp;
}
while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
{
yy_current_state = (int) yy_def[yy_current_state];
if ( yy_current_state >= 227 )
yy_c = yy_meta[(unsigned int) yy_c];
}
yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
++yy_cp;
}
while ( yy_base[yy_current_state] != 825 );
yy_find_action:
yy_act = yy_accept[yy_current_state];
if ( yy_act == 0 )
{ /* have to back up */
yy_cp = yy_last_accepting_cpos;
yy_current_state = yy_last_accepting_state;
yy_act = yy_accept[yy_current_state];
}
YY_DO_BEFORE_ACTION;
do_action: /* This label is used only to access EOF actions. */
switch ( yy_act )
{ /* beginning of action switch */
case 0: /* must back up */
/* undo the effects of YY_DO_BEFORE_ACTION */
*yy_cp = yy_hold_char;
yy_cp = yy_last_accepting_cpos;
yy_current_state = yy_last_accepting_state;
goto yy_find_action;
case 1:
YY_RULE_SETUP
{ /* eat comment */
register int c;
in_comment = 1;
for ( ; ; )
{ while ( (c = input()) != '*' && c != 0 )
if ( c == '\n' ) line_no++; /* eat up text of comment */
if ( c == '*' )
{ while ( (c = input()) == '*' ) ;
if ( c == '/' ) break; /* found the end */
if ( c == '\n' ) line_no++;
}
if ( c == 0 && yywrap() )
{ kb_error(2325,"End-of-file in comment\n",RECOVERABLE ); break; }
}
in_comment = 0;
}
YY_BREAK
case 2:
YY_RULE_SETUP
/* comment */ ;
YY_BREAK
case 3:
YY_RULE_SETUP
{ line_no++; }
YY_BREAK
case 4:
YY_RULE_SETUP
{ errspot -= 15; line_no--; }
YY_BREAK
case 5:
YY_RULE_SETUP
{ char *c = strtok(yytext,whitespace);
yylval.r = atof(strtok(yytext,whitespace));
yylval.i = atoi(strtok(yytext,whitespace));
if ( lists_flag==LISTS_FULL ) return(tok=LEAD_INTEGER_);
else if ( uminus_flag || c[0] != '-' )
return(tok = (fabs(yylval.r) > MAXINT) ? REAL_ : INTEGER_);
else { unput_string(c+1); c[1] = 0;
return (tok = minus_type(c[0]));
}
}
YY_BREAK
case 6:
YY_RULE_SETUP
{ char *c = strtok(yytext,whitespace);
yylval.i = atoi(c);
yylval.r = atof(strtok(c,whitespace));
yylval.qnum = 0;
if ((lists_flag!=LISTS_OFF) && uminus_flag && (parens==0))
return(tok = (fabs(yylval.r) > MAXINT) ? REAL_ : INTEGER_);
else { unput_string(c+1); c[1] = 0;
return (tok = minus_type(c[0]));
}
}
YY_BREAK
case 7:
YY_RULE_SETUP
{ yylval.i = atoi(yytext);
yylval.r = atof(strtok(yytext,whitespace));
yylval.qnum = 0;
return(tok = (fabs(yylval.r) > MAXINT) ? REAL_ : INTEGER_);
}
YY_BREAK
case 8:
YY_RULE_SETUP
{ yylval.i = atoi(yytext);
yylval.qnum = atoi(strchr(yytext,'@')+1);
return(tok = LEAD_INTEGER_AT_);
}
YY_BREAK
case 9:
YY_RULE_SETUP
{ yylval.i = atoi(yytext);
yylval.qnum = atoi(strchr(yytext,'@')+1);
return(tok = INTEGER_AT_);
}
YY_BREAK
case 10:
YY_RULE_SETUP
{ sscanf(yytext+2,"%x",&yylval.i);
yylval.r = (REAL)(yylval.i);
return(tok = INTEGER_);
} /* hex */
YY_BREAK
case 11:
YY_RULE_SETUP
{ char *c = yytext; /* binary */
yylval.i = 0;
while ( isdigit(*c) ) { yylval.i = 2*yylval.i + *c - '0'; c++;}
yylval.r = (REAL)(yylval.i);
return(tok = INTEGER_);
}
YY_BREAK
case 12:
YY_RULE_SETUP
return VERSIONTOKEN_;
YY_BREAK
case 13:
case 14:
case 15:
case 16:
case 17:
case 18:
YY_RULE_SETUP
{
char *c = strtok(yytext,whitespace);
yylval.r = atof(c);
if ((lists_flag!=LISTS_OFF) && uminus_flag && (parens==0))
return(tok = REAL_);
else
{ unput_string(c+1); c[1] = 0;
verb_flag = 0;
return (tok = minus_type(c[0]));
}
}
YY_BREAK
case 19:
case 20:
case 21:
case 22:
case 23:
case 24:
YY_RULE_SETUP
{ yylval.r = atof(yytext);
return(tok = REAL_); }
YY_BREAK
case 25:
YY_RULE_SETUP
{ /* read quoted string */
int n;
in_quote = 1;
for (n=0;;n++)
{ int c;
c = input();
if ( c == '\n' ) line_no++;
if ( c == '"' && (n == 0 || (yytext[n-1] != '\\')) ) break;
if ( n < 198 ) yytext[n] = c;
else if ( n==199 )
kb_error(2326,"Quoted string over 198 characters.",WARNING);
}
yytext[n] = 0;
reduce_string(yytext);
in_quote = 0;
return(tok = QUOTATION_);
}
YY_BREAK
case 26:
YY_RULE_SETUP
verb_flag = 0; return (tok = minus_type('-'));
YY_BREAK
case 27:
*yy_cp = yy_hold_char; /* undo effects of setting up yytext */
yy_c_buf_p = yy_cp -= 1;
YY_DO_BEFORE_ACTION; /* set up yytext again */
YY_RULE_SETUP
verb_flag = 0; return (tok = minus_type('-'));
YY_BREAK
case 28:
YY_RULE_SETUP
{ if (datafile_flag && uminus_flag && (parens == 0) )
return(tok = UMINUS_);
else { verb_flag = 0; return ( tok = minus_type('-') );}
}
YY_BREAK
case 29:
YY_RULE_SETUP
{ verb_flag = 2; yylval.i = SUBASSIGN_; return (tok= ASSIGNOP_);}
YY_BREAK
case 30:
YY_RULE_SETUP
{ return ( tok = minus_type('-')); }
YY_BREAK
case 31:
YY_RULE_SETUP
{ if (datafile_flag && uminus_flag && (parens == 0) )
return ( tok = UMINUS_);
else { verb_flag = 0; return ( tok = minus_type('-') ); }
}
YY_BREAK
case 32:
YY_RULE_SETUP
{ verb_flag = 2; return (tok= ASSIGN_);}
YY_BREAK
case 33:
YY_RULE_SETUP
{ verb_flag = 2;
kb_error(2327,"You mistyped ';=' for ':='?\n",WARNING);
return (tok= ASSIGN_);
}
YY_BREAK
case 34:
YY_RULE_SETUP
{ verb_flag = 2; yylval.i = PLUSASSIGN_; return (tok= ASSIGNOP_);}
YY_BREAK
case 35:
YY_RULE_SETUP
{ verb_flag = 2; yylval.i = SUBASSIGN_; return (tok= ASSIGNOP_);}
YY_BREAK
case 36:
YY_RULE_SETUP
{ verb_flag = 2; yylval.i = MULTASSIGN_; return (tok= ASSIGNOP_);}
YY_BREAK
case 37:
YY_RULE_SETUP
{ verb_flag = 2; yylval.i = DIVASSIGN_; return (tok= ASSIGNOP_);}
YY_BREAK
case 38:
YY_RULE_SETUP
{ verb_flag = 2; return (tok = PERM_ASSIGN_);}
YY_BREAK
case 39:
YY_RULE_SETUP
{ verb_flag = 2; return (tok = REDEFINE_); }
YY_BREAK
case 40:
YY_RULE_SETUP
{ return (tok = minus_type('-')); }
YY_BREAK
case 41:
YY_RULE_SETUP
{ verb_flag = 0 ; return(tok = yytext[0]); }
YY_BREAK
case 42:
YY_RULE_SETUP
{ verb_flag = 1; return tok = ';'; }
YY_BREAK
case 43:
YY_RULE_SETUP
{ verb_flag = 1; return(tok = yytext[0]); }
YY_BREAK
case 44:
YY_RULE_SETUP
{ return(tok = yytext[0]); }
YY_BREAK
case 45:
YY_RULE_SETUP
{ return tok = (datafile_flag ? '=' : EQ_); }
YY_BREAK
case 46:
YY_RULE_SETUP
{ verb_flag = 0; return(tok = yytext[0]); }
YY_BREAK
case 47:
YY_RULE_SETUP
{ return(tok = yytext[0]); }
YY_BREAK
case 48:
YY_RULE_SETUP
{ return(tok = yytext[0]); }
YY_BREAK
case 49:
YY_RULE_SETUP
{ return(tok = '^'); }
YY_BREAK
case 50:
YY_RULE_SETUP
{ return(tok = EQ_); }
YY_BREAK
case 51:
YY_RULE_SETUP
{ return(tok = NE_); }
YY_BREAK
case 52:
YY_RULE_SETUP
{ return(tok = LE_); }
YY_BREAK
case 53:
YY_RULE_SETUP
{ return(tok = GE_); }
YY_BREAK
case 54:
YY_RULE_SETUP
{ return(tok = OR_); }
YY_BREAK
case 55:
YY_RULE_SETUP
{ return(tok = AND_); }
YY_BREAK
case 56:
YY_RULE_SETUP
{ return(tok = NOT_); }
YY_BREAK
case 57:
YY_RULE_SETUP
{ return (tok = PIPE_); /* pipe followed by quoted string */ }
YY_BREAK
case 58:
YY_RULE_SETUP
{ return (tok = REDIRECT_); /* for redirection */ }
YY_BREAK
case 59:
YY_RULE_SETUP
{ return (tok = REDIRECTOVER_); /* for overwrite redirection */ }
YY_BREAK
case 60:
YY_RULE_SETUP
{ return (tok = BACKQUOTE_COMMA_); }
YY_BREAK
case 61:
YY_RULE_SETUP
{ if (!datafile_flag)
kb_error(1880,"#define valid only in top of datafile.\n",WARNING);
macro_flag = 1;
}
YY_BREAK
case 62:
YY_RULE_SETUP
{ /* nested include */
char *name = strchr(yytext,'"')+1;/* initial quote + 1 */
*strchr(name,'"') = 0; /* replace final quote by 0 */
push_commandfd(NULL,name);
}
YY_BREAK
case 63:
YY_RULE_SETUP
{ strncpy(yylval.lexeme,yytext,31);
if ( !macro() ) return identcase(yytext);
}
YY_BREAK
case 64:
YY_RULE_SETUP
{ yylval.i = yytext[1]; return tok = SINGLE_LETTER_; }
YY_BREAK
case 65:
YY_RULE_SETUP
;
YY_BREAK
case 66:
YY_RULE_SETUP
{ if ( cond_expr_flag ) return tok = ':';}
YY_BREAK
case 67:
YY_RULE_SETUP
{ if ( isprint(yytext[0]) )
sprintf(errmsg,"Illegal token: %c\n",yytext[0]);
else
sprintf(errmsg,"Illegal token: 0x%02X\n",yytext[0]);
yyerror(errmsg);
return tok=LEXERROR;
}
YY_BREAK
case 68:
YY_RULE_SETUP
ECHO;
YY_BREAK
case YY_STATE_EOF(INITIAL):
yyterminate();
case YY_END_OF_BUFFER:
{
/* Amount of text matched not including the EOB char. */
int yy_amount_of_matched_text = (int) (yy_cp - yytext_ptr) - 1;
/* Undo the effects of YY_DO_BEFORE_ACTION. */
*yy_cp = yy_hold_char;
if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_NEW )
{
/* We're scanning a new file or input source. It's
* possible that this happened because the user
* just pointed yyin at a new source and called
* yylex(). If so, then we have to assure
* consistency between yy_current_buffer and our
* globals. Here is the right place to do so, because
* this is the first action (other than possibly a
* back-up) that will match for the new input source.
*/
yy_n_chars = yy_current_buffer->yy_n_chars;
yy_current_buffer->yy_input_file = yyin;
yy_current_buffer->yy_buffer_status = YY_BUFFER_NORMAL;
}
/* Note that here we test for yy_c_buf_p "<=" to the position
* of the first EOB in the buffer, since yy_c_buf_p will
* already have been incremented past the NUL character
* (since all states make transitions on EOB to the
* end-of-buffer state). Contrast this with the test
* in input().
*/
if ( yy_c_buf_p <= &yy_current_buffer->yy_ch_buf[yy_n_chars] )
{ /* This was really a NUL. */
yy_state_type yy_next_state;
yy_c_buf_p = yytext_ptr + yy_amount_of_matched_text;
yy_current_state = yy_get_previous_state();
/* Okay, we're now positioned to make the NUL
* transition. We couldn't have
* yy_get_previous_state() go ahead and do it
* for us because it doesn't know how to deal
* with the possibility of jamming (and we don't
* want to build jamming into it because then it
* will run more slowly).
*/
yy_next_state = yy_try_NUL_trans( yy_current_state );
yy_bp = yytext_ptr + YY_MORE_ADJ;
if ( yy_next_state )
{
/* Consume the NUL. */
yy_cp = ++yy_c_buf_p;
yy_current_state = yy_next_state;
goto yy_match;
}
else
{
yy_cp = yy_c_buf_p;
goto yy_find_action;
}
}
else switch ( yy_get_next_buffer() )
{
case EOB_ACT_END_OF_FILE:
{
yy_did_buffer_switch_on_eof = 0;
if ( yywrap() )
{
/* Note: because we've taken care in
* yy_get_next_buffer() to have set up
* yytext, we can now set up
* yy_c_buf_p so that if some total
* hoser (like flex itself) wants to
* call the scanner after we return the
* YY_NULL, it'll still work - another
* YY_NULL will get returned.
*/
yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
yy_act = YY_STATE_EOF(YY_START);
goto do_action;
}
else
{
if ( ! yy_did_buffer_switch_on_eof )
YY_NEW_FILE;
}
break;
}
case EOB_ACT_CONTINUE_SCAN:
yy_c_buf_p =
yytext_ptr + yy_amount_of_matched_text;
yy_current_state = yy_get_previous_state();
yy_cp = yy_c_buf_p;
yy_bp = yytext_ptr + YY_MORE_ADJ;
goto yy_match;
case EOB_ACT_LAST_MATCH:
yy_c_buf_p =
&yy_current_buffer->yy_ch_buf[yy_n_chars];
yy_current_state = yy_get_previous_state();
yy_cp = yy_c_buf_p;
yy_bp = yytext_ptr + YY_MORE_ADJ;
goto yy_find_action;
}
break;
}
default:
YY_FATAL_ERROR(
"fatal flex scanner internal error--no action found" );
} /* end of action switch */
} /* end of scanning one token */
} /* end of yylex */
/* yy_get_next_buffer - try to read in a new buffer
*
* Returns a code representing an action:
* EOB_ACT_LAST_MATCH -
* EOB_ACT_CONTINUE_SCAN - continue scanning from current position
* EOB_ACT_END_OF_FILE - end of file
*/
static int yy_get_next_buffer()
{
register char *dest = yy_current_buffer->yy_ch_buf;
register char *source = yytext_ptr;
register int number_to_move, i;
int ret_val;
if ( yy_c_buf_p > &yy_current_buffer->yy_ch_buf[yy_n_chars + 1] )
YY_FATAL_ERROR(
"fatal flex scanner internal error--end of buffer missed" );
if ( yy_current_buffer->yy_fill_buffer == 0 )
{ /* Don't try to fill the buffer, so this is an EOF. */
if ( yy_c_buf_p - yytext_ptr - YY_MORE_ADJ == 1 )
{
/* We matched a singled characater, the EOB, so
* treat this as a final EOF.
*/
return EOB_ACT_END_OF_FILE;
}
else
{
/* We matched some text prior to the EOB, first
* process it.
*/
return EOB_ACT_LAST_MATCH;
}
}
/* Try to read more data. */
/* First move last chars to start of buffer. */
number_to_move = (int) (yy_c_buf_p - yytext_ptr) - 1;
for ( i = 0; i < number_to_move; ++i )
*(dest++) = *(source++);
if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_EOF_PENDING )
/* don't do the read, it's not guaranteed to return an EOF,
* just force an EOF
*/
yy_n_chars = 0;
else
{
int num_to_read =
yy_current_buffer->yy_buf_size - number_to_move - 1;
while ( num_to_read <= 0 )
{ /* Not enough room in the buffer - grow it. */
#ifdef YY_USES_REJECT
YY_FATAL_ERROR(
"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
#else
/* just a shorter name for the current buffer */
YY_BUFFER_STATE b = yy_current_buffer;
int yy_c_buf_p_offset =
(int) (yy_c_buf_p - b->yy_ch_buf);
if ( b->yy_is_our_buffer )
{
int new_size = b->yy_buf_size * 2;
if ( new_size <= 0 )
b->yy_buf_size += b->yy_buf_size / 8;
else
b->yy_buf_size *= 2;
b->yy_ch_buf = (char *)
/* Include room in for 2 EOB chars. */
yy_flex_realloc( (void *) b->yy_ch_buf,
b->yy_buf_size + 2 );
}
else
/* Can't grow it, we don't own it. */
b->yy_ch_buf = 0;
if ( ! b->yy_ch_buf )
YY_FATAL_ERROR(
"fatal error - scanner input buffer overflow" );
yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset];
num_to_read = yy_current_buffer->yy_buf_size -
number_to_move - 1;
#endif
}
if ( num_to_read > YY_READ_BUF_SIZE )
num_to_read = YY_READ_BUF_SIZE;
/* Read in more data. */
YY_INPUT( (&yy_current_buffer->yy_ch_buf[number_to_move]),
yy_n_chars, num_to_read );
}
if ( yy_n_chars == 0 )
{
if ( number_to_move == YY_MORE_ADJ )
{
ret_val = EOB_ACT_END_OF_FILE;
yyrestart( yyin );
}
else
{
ret_val = EOB_ACT_LAST_MATCH;
yy_current_buffer->yy_buffer_status =
YY_BUFFER_EOF_PENDING;
}
}
else
ret_val = EOB_ACT_CONTINUE_SCAN;
yy_n_chars += number_to_move;
yy_current_buffer->yy_ch_buf[yy_n_chars] = YY_END_OF_BUFFER_CHAR;
yy_current_buffer->yy_ch_buf[yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR;
yytext_ptr = &yy_current_buffer->yy_ch_buf[0];
return ret_val;
}
/* yy_get_previous_state - get the state just before the EOB char was reached */
static yy_state_type yy_get_previous_state()
{
register yy_state_type yy_current_state;
register char *yy_cp;
yy_current_state = yy_start;
yy_current_state += YY_AT_BOL();
for ( yy_cp = yytext_ptr + YY_MORE_ADJ; yy_cp < yy_c_buf_p; ++yy_cp )
{
register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
if ( yy_accept[yy_current_state] )
{
yy_last_accepting_state = yy_current_state;
yy_last_accepting_cpos = yy_cp;
}
while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
{
yy_current_state = (int) yy_def[yy_current_state];
if ( yy_current_state >= 227 )
yy_c = yy_meta[(unsigned int) yy_c];
}
yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
}
return yy_current_state;
}
/* yy_try_NUL_trans - try to make a transition on the NUL character
*
* synopsis
* next_state = yy_try_NUL_trans( current_state );
*/
#ifdef YY_USE_PROTOS
static yy_state_type yy_try_NUL_trans( yy_state_type yy_current_state )
#else
static yy_state_type yy_try_NUL_trans( yy_current_state )
yy_state_type yy_current_state;
#endif
{
register int yy_is_jam;
register char *yy_cp = yy_c_buf_p;
register YY_CHAR yy_c = 1;
if ( yy_accept[yy_current_state] )
{
yy_last_accepting_state = yy_current_state;
yy_last_accepting_cpos = yy_cp;
}
while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
{
yy_current_state = (int) yy_def[yy_current_state];
if ( yy_current_state >= 227 )
yy_c = yy_meta[(unsigned int) yy_c];
}
yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
yy_is_jam = (yy_current_state == 226);
return yy_is_jam ? 0 : yy_current_state;
}
#ifndef YY_NO_UNPUT
#ifdef YY_USE_PROTOS
static void yyunput( int c, register char *yy_bp )
#else
static void yyunput( c, yy_bp )
int c;
register char *yy_bp;
#endif
{
register char *yy_cp = yy_c_buf_p;
/* undo effects of setting up yytext */
*yy_cp = yy_hold_char;
if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
{ /* need to shift things up to make room */
/* +2 for EOB chars. */
register int number_to_move = yy_n_chars + 2;
register char *dest = &yy_current_buffer->yy_ch_buf[
yy_current_buffer->yy_buf_size + 2];
register char *source =
&yy_current_buffer->yy_ch_buf[number_to_move];
while ( source > yy_current_buffer->yy_ch_buf )
*--dest = *--source;
yy_cp += (int) (dest - source);
yy_bp += (int) (dest - source);
yy_n_chars = yy_current_buffer->yy_buf_size;
if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
YY_FATAL_ERROR( "flex scanner push-back overflow" );
}
*--yy_cp = (char) c;
yytext_ptr = yy_bp;
yy_hold_char = *yy_cp;
yy_c_buf_p = yy_cp;
}
#endif /* ifndef YY_NO_UNPUT */
#ifdef __cplusplus
static int yyinput()
#else
static int input()
#endif
{
int c;
*yy_c_buf_p = yy_hold_char;
if ( *yy_c_buf_p == YY_END_OF_BUFFER_CHAR )
{
/* yy_c_buf_p now points to the character we want to return.
* If this occurs *before* the EOB characters, then it's a
* valid NUL; if not, then we've hit the end of the buffer.
*/
if ( yy_c_buf_p < &yy_current_buffer->yy_ch_buf[yy_n_chars] )
/* This was really a NUL. */
*yy_c_buf_p = '\0';
else
{ /* need more input */
yytext_ptr = yy_c_buf_p;
++yy_c_buf_p;
switch ( yy_get_next_buffer() )
{
case EOB_ACT_END_OF_FILE:
{
if ( yywrap() )
{
yy_c_buf_p =
yytext_ptr + YY_MORE_ADJ;
return EOF;
}
if ( ! yy_did_buffer_switch_on_eof )
YY_NEW_FILE;
#ifdef __cplusplus
return yyinput();
#else
return input();
#endif
}
case EOB_ACT_CONTINUE_SCAN:
yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
break;
case EOB_ACT_LAST_MATCH:
#ifdef __cplusplus
YY_FATAL_ERROR(
"unexpected last match in yyinput()" );
#else
YY_FATAL_ERROR(
"unexpected last match in input()" );
#endif
}
}
}
c = *(unsigned char *) yy_c_buf_p; /* cast for 8-bit char's */
*yy_c_buf_p = '\0'; /* preserve yytext */
yy_hold_char = *++yy_c_buf_p;
yy_current_buffer->yy_at_bol = (c == '\n');
return c;
}
#ifdef YY_USE_PROTOS
void yyrestart( FILE *input_file )
#else
void yyrestart( input_file )
FILE *input_file;
#endif
{
if ( ! yy_current_buffer )
yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );
yy_init_buffer( yy_current_buffer, input_file );
yy_load_buffer_state();
}
#ifdef YY_USE_PROTOS
void yy_switch_to_buffer( YY_BUFFER_STATE new_buffer )
#else
void yy_switch_to_buffer( new_buffer )
YY_BUFFER_STATE new_buffer;
#endif
{
if ( yy_current_buffer == new_buffer )
return;
if ( yy_current_buffer )
{
/* Flush out information for old buffer. */
*yy_c_buf_p = yy_hold_char;
yy_current_buffer->yy_buf_pos = yy_c_buf_p;
yy_current_buffer->yy_n_chars = yy_n_chars;
}
yy_current_buffer = new_buffer;
yy_load_buffer_state();
/* We don't actually know whether we did this switch during
* EOF (yywrap()) processing, but the only time this flag
* is looked at is after yywrap() is called, so it's safe
* to go ahead and always set it.
*/
yy_did_buffer_switch_on_eof = 1;
}
#ifdef YY_USE_PROTOS
void yy_load_buffer_state( void )
#else
void yy_load_buffer_state()
#endif
{
yy_n_chars = yy_current_buffer->yy_n_chars;
yytext_ptr = yy_c_buf_p = yy_current_buffer->yy_buf_pos;
yyin = yy_current_buffer->yy_input_file;
yy_hold_char = *yy_c_buf_p;
}
#ifdef YY_USE_PROTOS
YY_BUFFER_STATE yy_create_buffer( FILE *file, int size )
#else
YY_BUFFER_STATE yy_create_buffer( file, size )
FILE *file;
int size;
#endif
{
YY_BUFFER_STATE b;
b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
if ( ! b )
YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
b->yy_buf_size = size;
/* yy_ch_buf has to be 2 characters longer than the size given because
* we need to put in 2 end-of-buffer characters.
*/
b->yy_ch_buf = (char *) yy_flex_alloc( b->yy_buf_size + 2 );
if ( ! b->yy_ch_buf )
YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
b->yy_is_our_buffer = 1;
yy_init_buffer( b, file );
return b;
}
#ifdef YY_USE_PROTOS
void yy_delete_buffer( YY_BUFFER_STATE b )
#else
void yy_delete_buffer( b )
YY_BUFFER_STATE b;
#endif
{
if ( ! b )
return;
if ( b == yy_current_buffer )
yy_current_buffer = (YY_BUFFER_STATE) 0;
if ( b->yy_is_our_buffer )
yy_flex_free( (void *) b->yy_ch_buf );
yy_flex_free( (void *) b );
}
#ifndef YY_ALWAYS_INTERACTIVE
#ifndef YY_NEVER_INTERACTIVE
extern int isatty YY_PROTO(( int ));
#endif
#endif
#ifdef YY_USE_PROTOS
void yy_init_buffer( YY_BUFFER_STATE b, FILE *file )
#else
void yy_init_buffer( b, file )
YY_BUFFER_STATE b;
FILE *file;
#endif
{
yy_flush_buffer( b );
b->yy_input_file = file;
b->yy_fill_buffer = 1;
#if YY_ALWAYS_INTERACTIVE
b->yy_is_interactive = 1;
#else
#if YY_NEVER_INTERACTIVE
b->yy_is_interactive = 0;
#else
b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
#endif
#endif
}
#ifdef YY_USE_PROTOS
void yy_flush_buffer( YY_BUFFER_STATE b )
#else
void yy_flush_buffer( b )
YY_BUFFER_STATE b;
#endif
{
b->yy_n_chars = 0;
/* We always need two end-of-buffer characters. The first causes
* a transition to the end-of-buffer state. The second causes
* a jam in that state.
*/
b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
b->yy_buf_pos = &b->yy_ch_buf[0];
b->yy_at_bol = 1;
b->yy_buffer_status = YY_BUFFER_NEW;
if ( b == yy_current_buffer )
yy_load_buffer_state();
}
#ifndef YY_NO_SCAN_BUFFER
#ifdef YY_USE_PROTOS
YY_BUFFER_STATE yy_scan_buffer( char *base, yy_size_t size )
#else
YY_BUFFER_STATE yy_scan_buffer( base, size )
char *base;
yy_size_t size;
#endif
{
YY_BUFFER_STATE b;
if ( size < 2 ||
base[size-2] != YY_END_OF_BUFFER_CHAR ||
base[size-1] != YY_END_OF_BUFFER_CHAR )
/* They forgot to leave room for the EOB's. */
return 0;
b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
if ( ! b )
YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
b->yy_buf_pos = b->yy_ch_buf = base;
b->yy_is_our_buffer = 0;
b->yy_input_file = 0;
b->yy_n_chars = b->yy_buf_size;
b->yy_is_interactive = 0;
b->yy_at_bol = 1;
b->yy_fill_buffer = 0;
b->yy_buffer_status = YY_BUFFER_NEW;
yy_switch_to_buffer( b );
return b;
}
#endif
#ifndef YY_NO_SCAN_STRING
#ifdef YY_USE_PROTOS
YY_BUFFER_STATE yy_scan_string( yyconst char *str )
#else
YY_BUFFER_STATE yy_scan_string( str )
yyconst char *str;
#endif
{
int len;
for ( len = 0; str[len]; ++len )
;
return yy_scan_bytes( str, len );
}
#endif
#ifndef YY_NO_SCAN_BYTES
#ifdef YY_USE_PROTOS
YY_BUFFER_STATE yy_scan_bytes( yyconst char *bytes, int len )
#else
YY_BUFFER_STATE yy_scan_bytes( bytes, len )
yyconst char *bytes;
int len;
#endif
{
YY_BUFFER_STATE b;
char *buf;
yy_size_t n;
int i;
/* Get memory for full buffer, including space for trailing EOB's. */
n = len + 2;
buf = (char *) yy_flex_alloc( n );
if ( ! buf )
YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
for ( i = 0; i < len; ++i )
buf[i] = bytes[i];
buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
b = yy_scan_buffer( buf, n );
if ( ! b )
YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
/* It's okay to grow etc. this buffer, and we should throw it
* away when we're done.
*/
b->yy_is_our_buffer = 1;
return b;
}
#endif
#ifndef YY_NO_PUSH_STATE
#ifdef YY_USE_PROTOS
static void yy_push_state( int new_state )
#else
static void yy_push_state( new_state )
int new_state;
#endif
{
if ( yy_start_stack_ptr >= yy_start_stack_depth )
{
yy_size_t new_size;
yy_start_stack_depth += YY_START_STACK_INCR;
new_size = yy_start_stack_depth * sizeof( int );
if ( ! yy_start_stack )
yy_start_stack = (int *) yy_flex_alloc( new_size );
else
yy_start_stack = (int *) yy_flex_realloc(
(void *) yy_start_stack, new_size );
if ( ! yy_start_stack )
YY_FATAL_ERROR(
"out of memory expanding start-condition stack" );
}
yy_start_stack[yy_start_stack_ptr++] = YY_START;
BEGIN(new_state);
}
#endif
#ifndef YY_NO_POP_STATE
static void yy_pop_state()
{
if ( --yy_start_stack_ptr < 0 )
YY_FATAL_ERROR( "start-condition stack underflow" );
BEGIN(yy_start_stack[yy_start_stack_ptr]);
}
#endif
#ifndef YY_NO_TOP_STATE
static int yy_top_state()
{
return yy_start_stack[yy_start_stack_ptr - 1];
}
#endif
#ifndef YY_EXIT_FAILURE
#define YY_EXIT_FAILURE 2
#endif
#ifdef YY_USE_PROTOS
static void yy_fatal_error( yyconst char msg[] )
#else
static void yy_fatal_error( msg )
char msg[];
#endif
{
(void) fprintf( stderr, "%s\n", msg );
exit( YY_EXIT_FAILURE );
}
/* Redefine yyless() so it works in section 3 code. */
#undef yyless
#define yyless(n) \
do \
{ \
/* Undo effects of setting up yytext. */ \
yytext[yyleng] = yy_hold_char; \
yy_c_buf_p = yytext + n - YY_MORE_ADJ; \
yy_hold_char = *yy_c_buf_p; \
*yy_c_buf_p = '\0'; \
yyleng = n; \
} \
while ( 0 )
/* Internal utility routines. */
#ifndef yytext_ptr
#ifdef YY_USE_PROTOS
static void yy_flex_strncpy( char *s1, yyconst char *s2, int n )
#else
static void yy_flex_strncpy( s1, s2, n )
char *s1;
yyconst char *s2;
int n;
#endif
{
register int i;
for ( i = 0; i < n; ++i )
s1[i] = s2[i];
}
#endif
#ifdef YY_USE_PROTOS
static void *yy_flex_alloc( yy_size_t size )
#else
static void *yy_flex_alloc( size )
yy_size_t size;
#endif
{
return (void *) malloc( size );
}
#ifdef YY_USE_PROTOS
static void *yy_flex_realloc( void *ptr, yy_size_t size )
#else
static void *yy_flex_realloc( ptr, size )
void *ptr;
yy_size_t size;
#endif
{
/* The cast to (char *) in the following accommodates both
* implementations that use char* generic pointers, and those
* that use void* generic pointers. It works with the latter
* because both ANSI C and C++ allow castless assignment from
* any pointer type to void*, and deal with argument conversions
* as though doing an assignment.
*/
return (void *) realloc( (char *) ptr, size );
}
#ifdef YY_USE_PROTOS
static void yy_flex_free( void *ptr )
#else
static void yy_flex_free( ptr )
void *ptr;
#endif
{
free( ptr );
}
#if YY_MAIN
int main()
{
yylex();
return 0;
}
#endif
/* My own input() function to handle case insensitivity and macros */
/* and line counting */
/* for saving input for command definition */
int inputbuffersize = 0;
int inputbufferspot = 0; /* where next character will go */
int inputsave_flag = 0; /* so only save when reading command */
char *inputbuffer;
void savein(c)
int c;
{ if ( !inputsave_flag ) return;
if ( inputbufferspot >= inputbuffersize )
{ int newsize = inputbuffersize?2*inputbuffersize:1000;
inputbuffer = my_list_realloc(inputbuffer,newsize,ETERNAL_BLOCK);
inputbuffersize = newsize;
}
inputbuffer[inputbufferspot++] = (char)c;
}
void reset_inputbuffer()
{ inputbufferspot = 0;
inputsave_flag = 1;
}
#define MOREMAX 1000
char morebuff[MOREMAX+2];
int rawinput()
{
int c=0,retval;
if ( cmdptr ) /* read from string */
{
if ( *cmdptr == 0 ) /* newline at end of each line */
{ if ( previous_char != '\n' )
{ retval = previous_char = '\n';
errbuff[errspot++] = retval;
savein(retval);
}
else retval = 0;
goto rawreturn;
}
c = *(cmdptr++);
if ( c == MOREIN ) /* for really long input lines */
{
#ifdef USE_READLINE //CSL
prompt(CONTPROMPT,morebuff,MOREMAX);
#else
getstring(morebuff,MOREMAX);
#endif
cmdptr = morebuff;
if ( !*cmdptr )
{ if (!in_quote && !in_comment) errbuff[errspot++] = '\n';
retval = '\n';
savein(retval);
goto rawexit;
}
c = *(cmdptr++);
}
}
else /* read from file */
{ for(;;)
{
if ( commandfd == NULL ) /* in case read after close */
{ retval = previous_char = 0; goto rawreturn; }
c = getc(commandfd);
if ( c != -1 ) break;
pop_commandfd(); /* EOF, so pop #include stack */
if ( !datafile_flag ) /* EOF for a command file */
{ retval = previous_char = 0; goto rawreturn; }
}
}
/* taking care of various line-ending combinations */
if ( (c == '\n') && (previous_char == '\r') )
return rawinput();
previous_char = c;
if ( c == '\r' )
c = '\n';
errbuff[errspot++] = (char)c;
retval = c;
savein(retval);
rawexit:
if ( errspot >= ERRBUFFSIZE ) /* need partial reset */
{ memcpy(errbuff,errbuff+ERRBUFFSIZE/2,ERRBUFFSIZE/2);
errspot = ERRBUFFSIZE/2;
}
rawreturn:
return retval;
}
void get_more_input()
{int n;
#ifdef USE_READLINE //CSL
prompt(MOREPROMPT,morebuff,MOREMAX);
#else
if ( !topflag && (!quiet_load_flag || (commandfd == stdin)) )
outstring("more> ");
getstring(morebuff,MOREMAX);
#endif
n = strlen(morebuff);
if ( (morebuff[n-1] != MOREIN) && (morebuff[n-1] != '\n') )
morebuff[n] = '\n'; morebuff[n+1] = 0;
catfulltext(morebuff);
cmdptr = morebuff;
}
int kb_input()
{
int c;
if ( spot > 0 )
{ c = buff[--spot];
goto input_exit;
}
retry:
c = rawinput();
if ( (c == '\\') ) /* line splicing */
{ /* have to do line splicing as input filter to remove
special character of line start */
int cc = c;
c = rawinput();
if ( c == 0 )
{ get_more_input(); c = ' '; goto input_exit; }
if ( c == '\n' )
{ int ccc;
line_no++;
ccc = rawinput();
if ( ccc == 0 )
{ get_more_input(); c = ' '; goto input_exit; }
rawunput(ccc); c = ' ';
}
else { rawunput(c); c = cc; /* not linesplicing */ }
}
if ( c == 0 && in_comment ) { get_more_input(); goto retry; }
if ( c == 0 && in_quote ) { get_more_input(); goto retry; }
input_exit:
return c;
}
void rawunput(c)
int c;
{
if ( spot >= BUFFSIZE - 1 )
{ buff = my_list_realloc(buff,BUFFSIZE+500,ETERNAL_BLOCK);
BUFFSIZE += 500;
}
buff[spot++] = (char)c;
}
void unput_string(s)
char *s;
{ char *c;
c = s ; while ( *c ) c++; /* find end of token */
while ( c != s ) { --c; unput(*c); }
}
void dump_buff(str,size) /* for error reporting */
char *str;
size_t size;
{ int place;
strcpy(str," Input line so far: \n");
size -= strlen(str)+3;
errbuff[errspot] = 0;
for ( place = errspot-1 ; place >= 0 ; place-- )
{ if (errbuff[place]==0 ) errbuff[place] = ' '; /* nulls creep in */
if (errbuff[place]=='\n' && place < errspot-2) break;
}
strncat(str,errbuff+place+1,size);
if ( str[strlen(str)-1] != '\n' ) strcat(str,"\n");
}
int yywrap()
{ /* Called at end of input. Return 1 if really done, 0 if not */
spot = 0; /* clean buffer */
if ( (parens > 0) || (brace_depth > 0) || in_quote || in_comment
|| in_function || in_control_structure /* || loopdepth */ )
{ get_more_input(); return 0; }
if ( !help_flag )
switch ( tok )
{ case '+': case '-': case '*': /* might be wrap symbols */
if ( read_wrap_flag ) return 1;
else { get_more_input(); return 0 ; }
break;
case UMINUS_: case ',':
case '=': case '?': case ':': case OR_: case AND_: case NOT_:
case EQ_: case '>': case '<': case LE_: case GE_: case NE_:
case '/': case '%': case '^': case ON_CONSTRAINT_:
case HIT_CONSTRAINT_: case ON_BOUNDARY_: case DO_ : case FOR_:
case WHILE_ : case IF_ : case ELSE_: case THEN_ : case SET_:
case DEFINE_: case WHERE_: case ASSIGN_ : case PERM_ASSIGN_:
case REDEFINE_ : case FUNCTION_: case PROCEDURE_WORD_:
get_more_input(); return 0;
break;
default: return 1;
}
return 1; /* done */
}
void macro_init()
{
if ( macro_subs ) myfree((char *)macro_subs);
if ( macros ) myfree((char *)macros);
macro_subs = NULL;
macros = NULL;
macro_count = macro_subs_top = macro_max = macro_subs_max = 0;
}
void yylex_init()
{
unput_tok_count = 0;
ubuff_spot = 0;
spot = 0;
errspot = 0;
yylval.i = 0;
yylval.r = 0.0;
in_function = brace_depth = in_quote = in_comment = 0;
#ifdef FLEX_SCANNER
if ( yy_current_buffer) YY_FLUSH_BUFFER;
#endif
}
/*************************************************************
*
* Function: record_macro()
*
* Purpose: Record macro definition.
*
*/
void record_macro()
{
int len;
char *mspot;
int cont_flag;
int backslash_spot;
macro_flag = 0;
if ( macro_count >= macro_max )
{ if ( macro_max == 0 )
{ macro_max = 10;
macros = (struct macro *)mycalloc(macro_max,sizeof(struct macro));
}
else
{
macros = (struct macro *)kb_realloc((char *)macros,
2*macro_max*sizeof(struct macro));
macro_max *= 2;
}
}
strncpy(macros[macro_count].name,yytext,MACRONAMESIZE);
if ( macro_subs_max == 0 )
{ macro_subs_max = 2*SUBMAX;
macro_subs = (char *)mycalloc(macro_subs_max,1);
}
/* read in macro string */
for ( len = 0, cont_flag = 0 ; ; len++ )
{ int c = KB_INPUT();
if ( len == 0 && (c == ' ' || c == '\t') )
{ len--;
continue; /* skip leading whitespace */
}
if ( c == '\\' )
{ cont_flag = 1;
backslash_spot = len;
}
else if ( c != ' ' && c != '\t' && c != '\n' && c != 0 )
cont_flag = 0;
if ( (c == '\0') || (c == '\n') )
{
line_no++;
if ( !cont_flag )
break;
cont_flag = 0;
len = backslash_spot;
macro_subs[macro_subs_top+len] = 0;
len--;
continue;
}
if ( macro_subs_top+len >= macro_subs_max-2 )
{ macro_subs = (char *)kb_realloc(macro_subs,macro_subs_max+2*SUBMAX);
macro_subs_max += 2*SUBMAX;
}
macro_subs[macro_subs_top+len] = (char)c;
}
mspot = macro_subs+macro_subs_top;
/* strip terminal comment */
if ( strstr(mspot,"//") )
{ *strstr(mspot,"//") = 0;
len = strlen(mspot);
}
else mspot[len] = 0;
/* strip trailing blanks */
while ( (len > 0) && (mspot[len-1] == ' ') ) mspot[--len] = 0;
macros[macro_count].subsize = len;
macros[macro_count++].offset = macro_subs_top;
macro_subs_top += len+1;
}
/*************************************************************
*
* Function: macro()
*
* Purpose: See if yytext is a macro, and do substitution.
*
* Return: 1 if macro, 0 if not.
*
*/
int macro()
{
int n,k;
char *c;
if ( macro_flag ) { record_macro(); return WAS_MACRO_DEF; }
if ( strcmp(yytext,"_anti_line_no_") == 0 )
{ line_no--; /* kludge line backup */
errspot -= 15;
return 1;
}
if ( !keep_macros_flag && !datafile_flag ) return 0; /* no macros in commands */
/* find name, simple linear search */
for ( n = macro_count-1 ; n >= 0 ; n-- ) /* use latest definition */
if ( strcmp(yytext,macros[n].name) == 0 ) break;
if ( n < 0 ) return 0; /* not found */
/* insert string into input in reverse order so reads ok */
c = macro_subs+macros[n].offset;
for ( k = macros[n].subsize - 1 ; k >= 0 ; k-- )
KB_UNPUT(c[k]);
KB_UNPUT(' '); /* substitution starts with whitespace; for proper
preservation of unary minus leading in the macro */
return MACRO_EXPANDED;
}
/* for deciding type of minus sign or plus sign */
int minus_type(c)
int c; /* '+' or '-' */
{ int result;
switch ( tok )
{ case LEAD_INTEGER_:
case SIGNED_NUMBER_:
case INTEGER_:
case REAL_:
case PI_:
case E_:
case G_:
case PARAM_: case ARRAYIDENT_:
case COORD_: case VALUE_: case BARE_:
case IDENT_: case QUANTITY_NAME_: case WRAP_: case PERM_IDENT_:
case LENGTH_: case DIHEDRAL_: case VALENCE_:
case AREA_: case VOLUME_: case DENSITY_: case TAG_:
case ID_: case ORIGINAL_: case SQ_MEAN_CURV_:
case OID_: case INTERNAL_VARIABLE_: case COLOR_:
case TOGGLEVALUE_: case EXTRA_ATTRIBUTE_: case PRESSURE_:
case ARRAY_ATTRIBUTE_:
case FRONTCOLOR_: case BACKCOLOR_: case TARGET_:
case NO_REFINE_: case VOLCONST_: case FRONTBODY_: case NONCONTENT_:
case BACKBODY_: case TETRA_POINT_: case TRIPLE_POINT_:
case MIDV_: case PHASE_: case MODULUS_:
case METHOD_NAME_: case NODISPLAY_: case HIT_PARTNER_:
case ']': case ')':
result = c;
break;
default:
result = (c=='-' ? UMINUS_ : UPLUS_) ;
break;
}
return result;
}
/****************************************************************************
*
* function identcase()
*
* purpose: handle case of identifier token, maybe macro, keyword, etc.
*/
int keyword_compare(a,b)
struct ckey *a,*b;
{ return stricmp(a->name,b->name); }
int identcase(lexeme)
char *lexeme;
{
int k,i;
int type;
struct sym *s;
static int sorted = 0; /* flag for sorting keywords */
struct ckey *keyptr;
struct ckey key; /* for bsearch key */
char *c,*p;
dll_func_type h;
yylval.i = 0;
if ( ! sorted )
{ qsort((char*)datafile_keywords,
sizeof(datafile_keywords)/ sizeof(struct dkey),sizeof(struct dkey),
FCAST keyword_compare);
qsort((char*)command_keywords,
sizeof(command_keywords)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
qsort((char*)togglenames,
sizeof(togglenames)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
qsort((char*)colornames,
sizeof(colornames)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
qsort((char*)internal_variables,
sizeof(internal_variables)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
qsort((char*)mathfunc_keywords,
sizeof(mathfunc_keywords)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
qsort((char*)mathfunc2_keywords,
sizeof(mathfunc2_keywords)/ sizeof(struct ckey),sizeof(struct ckey),
FCAST keyword_compare);
sorted = 1;
}
if ( strcmp(lexeme,"_command_") == 0 ) { return tok = COMMAND_START_ ; }
if ( strcmp(lexeme,"_expr_") == 0 ) { return tok = EXPRESSION_START_; }
/* strip whitespace from front of lexeme */
c = strtok(lexeme,whitespace);
if ( c != lexeme ) { p = lexeme; while ( *c ) *(p++) = *(c++); *p = 0;}
if ( strlen(lexeme) == 1 )
{ char ch = lexeme[0];
if ( verb_flag == 1 || tok==PRINT_ ||
(verb_flag == 2 && (toupper(ch) < 'W')) )
{ yylval.i=lexeme[0];
if ( single_redefine[yylval.i].start ) return tok = SINGLE_REDEFD_;
switch ( yylval.i )
{ case 't': case 'l': case 'j': case 'P': case 'M':
case 'w': case 'n': case 'm': case 'b':
case 'k': case 'K': case 'p': case 'y':
return ( tok = SINGLE_LETTER_ARG_ );
case 'G': if ( verb_flag ) return ( tok = SINGLE_LETTER_ARG_ );
else return tok=G_;
default: return ( tok = SINGLE_LETTER_ );
}
}
else
switch ( toupper(lexeme[0]) )
{ case 'X': case 'Y': case 'Z': case 'W':
yylval.i = ((toupper(lexeme[0]) - 'X' + 4) % 4) + 1;
return COORD_;
}
}
if ( toupper(lexeme[0]) == 'X' )
{ char *c;
for ( c = lexeme+1 ; isdigit(*c) ; c++ ) ;
if ( *c == 0 )
{ yylval.i = atoi(lexeme+1);
if ( yylval.i != 0 )
return COORD_;
}
}
if ( toupper(lexeme[0]) == 'P' && isdigit(lexeme[1]) && !lexeme[2] )
{ yylval.i = atoi(lexeme+1);
return PARAM_;
}
if ( lexeme[0] == 'g' )
{ char *c;
for ( c = lexeme+1 ; isdigit(*c) ; c++ ) ;
if ( *c == 0 )
{ yylval.i = atoi(lexeme+1);
return GO_COUNT_;
}
}
if ( strncmp(lexeme,"usr",3) == 0 )
{ char *c;
for ( c = lexeme+3 ; isdigit(*c) ; c++ ) ;
if ( *c == 0 )
{ yylval.i = atoi(lexeme+3);
return USERFUNC_;
}
}
key.name = lexeme;
#define BSEARCH(namelist)\
(struct ckey*)bsearch((char*)&key,(char*)(namelist),\
sizeof(namelist)/sizeof(struct ckey),\
sizeof(struct ckey),FCAST keyword_compare);
keyptr = BSEARCH(colornames);
if ( keyptr )
{ yylval.r = yylval.i = keyptr->token;
return (tok = INTEGER_);
}
/* search math funcs */
keyptr = BSEARCH(mathfunc_keywords);
if ( keyptr ) { yylval.i = keyptr->token; return (tok = MATHFUNC_); }
keyptr = BSEARCH(mathfunc2_keywords);
if ( keyptr ) { yylval.i = keyptr->token; return (tok = MATHFUNC2_); }
if ( const_expr_flag )
{ for ( k=0 ; ktoken;}
keyptr = BSEARCH(command_keywords);
if ( keyptr )
{ sprintf(errmsg,
"Use of the keyword '%s' as an identifier is very ill-advised!\n",
lexeme);
kb_error(2328,errmsg, WARNING);
}
}
else /* search keywords and internal variables */
{
keyptr = BSEARCH(command_keywords);
if ( keyptr )
{ if ( kb_stricmp(lexeme,"HELP") == 0 ) help_flag = 1;
yylval.i = tok = keyptr->token;
switch ( tok )
{ /* set verb_flag when expecting a command */
case THEN_: case ELSE_: case DO_: verb_flag = 1; break;
/* clear verb_flag when expecting an expression */
case PRINT_:
case IF_: case WHILE_: case VIEW_TRANSFORMS_: case TRANSFORM_DEPTH_:
case METIS_: case KMETIS_: case OMETIS_: case EDGEWEED_:
case AREAWEED_: case EDGEDIVIDE_: case LANCZOS_: case RITZ_:
case EIGENPROBE_: case MOVE_: case ZOOM_: case LAGRANGE_: case SET_:
case PRINTF_: case LIST_: case DELETE_: case VERTEX_AVERAGE_:
case BINARY_PRINTF_:
case DISSOLVE_: case REFINE_: case EDGESWAP_: case FIX_: case UNFIX_:
case SPRINTF_: case EPRINT_: case HISTOGRAM_: case LOGHISTOGRAM_:
case FOREACH_: case SHOW_EXPR_: case UNSET_:
case HESSIAN_SADDLE_: case HESSIAN_SEEK_: case NOTCH_:
case AUTOCHOP_: case AUTOPOP_: case OPTIMIZE_:
verb_flag = 0; break;
case SHOW_: if ( verb_flag ) tok = SHOWVERB_;
verb_flag = 0;
break;
case TRANSFORM_EXPR_: if ( verb_flag ) tok = TRANSFORM_EXPR_VERB_;
verb_flag = 0;
break;
}
return tok;
}
}
for ( i = 0 ; i < NUMDATATYPES ; i++ )
if ( stricmp(lexeme,datatype_name[i]) == 0 )
{ yylval.i = DATATYPE_;
yylval.datatype = i;
return tok = DATATYPE_;
}
keyptr = BSEARCH(togglenames);
if ( keyptr )
{ yylval.i = keyptr->token;
if ( verb_flag != 0 ) tok = TOGGLENAME_;
else tok = TOGGLEVALUE_;
return tok;
}
keyptr = BSEARCH(internal_variables);
if ( keyptr )
{ yylval.i = keyptr->token;
return tok = INTERNAL_VARIABLE_;
}
/* search local variables */
yylval.i = lookup_local_var(lexeme);
if ( yylval.i )
{ struct global *g;
g = globals(yylval.i);
if ( g->flags & SUBROUTINE )
return ( tok = PROCEDURE_ );
else if ( g->flags & ORDINARY_PARAM )
{ switch ( g->type )
{ case VERTEX_TYPE:
yylval.etype = VERTEX;
return ( tok = ELEMENT_IDENT_ );
case ELEMENTID_TYPE:
yylval.etype = -1;
return ( tok = ELEMENT_IDENT_ );
case EDGE_TYPE:
yylval.etype = EDGE;
return ( tok = ELEMENT_IDENT_ );
case FACET_TYPE:
yylval.etype = FACET;
return ( tok = ELEMENT_IDENT_ );
case BODY_TYPE:
yylval.etype = BODY;
return ( tok = ELEMENT_IDENT_ );
case FACETEDGE_TYPE:
yylval.etype = FACETEDGE;
return ( tok = ELEMENT_IDENT_ );
default:
return ( tok = IDENT_ );
}
}
else if ( g->flags & FUNCTION_NAME )
return ( tok = FUNCTION_IDENT_ );
else if ( g->flags & PROCEDURE_NAME )
return ( tok = PROCEDURE_IDENT_ );
else if ( g->flags & STRINGVAL )
return ( tok = STRINGGLOBAL_ );
else if ( g->flags & QUANTITY_NAME ) /* can't happen */
return ( tok = QUANTITY_NAME_ );
else if ( g->flags & METHOD_NAME ) /* can't happen */
return ( tok = METHOD_NAME_ );
else if ( g->flags & CONSTRAINT_NAME ) /* can't happen */
return ( tok = CONSTRAINT_NAME_ );
else if ( g->flags & BOUNDARY_NAME ) /* can't happen */
return ( tok = BOUNDARY_NAME_ );
else if ( g->flags & DYNAMIC_LOAD_FUNC ) /* can't happen */
return ( tok = DYNAMIC_LOAD_FUNC_ );
else if ( g->flags & ARRAY_PARAM )
return ( tok = ARRAYIDENT_ );
else if ( g->flags & GLOB_LOCALVAR )
return IDENT_;
else
return (tok = NEWIDENT_);
}
/* search symbol table */
s = symbol_lookup(lexeme);
if ( s )
{ yysym = s; yylval.i = yysym-symtable; verb_flag = 0;
return (tok = SYMBOL_ );
}
/* search parameter names */
yylval.i = lookup_global_hash(lexeme,0,0,HASH_LOOK);
if ( yylval.i != 0 )
{ int nametype = yylval.i & NAMETYPEMASK;
struct global *g;
yylval.i &= INDEXMASK; /* get plain index */
if ( nametype == QUANTITYNAME )
return tok = QUANTITY_NAME_;
else if ( nametype == METHODNAME )
return tok = METHOD_NAME_;
else if ( nametype == PERM_NAME )
{ yylval.i |= PERMGLOBAL;
if ( perm_globals(yylval.i)->flags & SUBROUTINE )
return ( tok = PERM_PROCEDURE_ );
else if ( perm_globals(yylval.i)->flags & STRINGVAL )
return ( tok = PERM_STRINGGLOBAL_ );
else if ( perm_globals(yylval.i)->flags & ARRAY_PARAM )
return ( tok = ARRAYIDENT_ );
else return (tok = PERM_IDENT_);
}
yylval.i |= EPHGLOBAL;
g = globals(yylval.i);
if ( g->flags & SUBROUTINE )
return ( tok = PROCEDURE_ );
else if ( g->flags & FUNCTION_NAME )
return ( tok = FUNCTION_IDENT_ );
else if ( g->flags & PROCEDURE_NAME )
return ( tok = PROCEDURE_IDENT_ );
else if ( g->flags & STRINGVAL )
return ( tok = STRINGGLOBAL_ );
else if ( g->flags & QUANTITY_NAME )
return ( tok = QUANTITY_NAME_ );
else if ( g->flags & METHOD_NAME )
return ( tok = METHOD_NAME_ );
else if ( g->flags & CONSTRAINT_NAME )
return ( tok = CONSTRAINT_NAME_ );
else if ( g->flags & BOUNDARY_NAME )
return ( tok = BOUNDARY_NAME_ );
else if ( g->flags & DYNAMIC_LOAD_FUNC )
return ( tok = DYNAMIC_LOAD_FUNC_ );
else if ( g->flags & ARRAY_PARAM )
return ( tok = ARRAYIDENT_ );
else
{ switch ( g->type )
{ case VERTEX_TYPE:
yylval.etype = VERTEX;
return ( tok = ELEMENT_IDENT_ );
case ELEMENTID_TYPE:
yylval.etype = -1;
return ( tok = ELEMENT_IDENT_ );
case EDGE_TYPE:
yylval.etype = EDGE;
return ( tok = ELEMENT_IDENT_ );
case FACET_TYPE:
yylval.etype = FACET;
return ( tok = ELEMENT_IDENT_ );
case BODY_TYPE:
yylval.etype = BODY;
return ( tok = ELEMENT_IDENT_ );
case FACETEDGE_TYPE:
yylval.etype = FACETEDGE;
return ( tok = ELEMENT_IDENT_ );
default:
return ( tok = IDENT_ );
}
}
}
/* search extra attributes */
for ( type = 0 ; type < NUMELEMENTS ; type++ )
{ struct extra *ex;
int i;
for ( i = 0, ex = EXTRAS(type) ;
i < web.skel[type].extra_count ; i++ , ex++ )
if ( stricmp(lexeme, ex->name) == 0 )
{ strncpy(idname,lexeme,sizeof(idname)); /* save text */
yylval.qnum = i;
yylval.etype = type;
return tok = ex->array_spec.dim ? ARRAY_ATTRIBUTE_ : EXTRA_ATTRIBUTE_;
}
}
/* search dynamic load libraries */
h = search_libraries(lexeme);
if ( h )
{ yylval.i = add_global(lexeme);
globals(yylval.i)->flags |= DYNAMIC_LOAD_FUNC;
globals(yylval.i)->value.funcptr = h;
return ( tok = DYNAMIC_LOAD_FUNC_ );
}
/* if here, then not keyword */
strncpy(idname,lexeme,sizeof(idname)); /* save text */
if ( strlen(lexeme) == 1 )
{ sprintf(errmsg,
"Use of single letter command '%c' is illegal here!\n",
lexeme[0]);
kb_error(2329,errmsg, WARNING);
if ( !datafile_flag) return tok = lexeme[0];
}
yylval.i = 0;
return(tok = NEWIDENT_) ;
} /* end identcase() */
/******************************************************************
*
* function: keywordname()
*
* purpose: find keyword of given token number.
*
*/
char *keywordname(toknum)
int toknum;
{ int k,i,imax;
for ( k = 0 ; k < sizeof(command_keywords)/sizeof(struct ckey) ; k++ )
if ( toknum == command_keywords[k].token )
{ static char name[32];
strncpy(name,command_keywords[k].name,31);
return name;
}
for ( k = 0 ; k < sizeof(togglenames)/sizeof(struct ckey) ; k++ )
if ( toknum == togglenames[k].token )
{ static char name[32];
strncpy(name,togglenames[k].name,31);
return name;
}
for ( k = 0 ; k < sizeof(internal_variables)/sizeof(struct ckey) ; k++ )
if ( toknum == internal_variables[k].token )
{ static char name[32];
strncpy(name,internal_variables[k].name,31);
return name;
}
imax = sizeof(colornames)/sizeof(struct ckey);
for ( i = 0 ; i < imax ; i++ )
if ( colornames[i].token == toknum )
return colornames[i].name;
imax = sizeof(datafile_keywords)/sizeof(struct dkey);
for ( i = 0 ; i < imax ; i++ )
if ( datafile_keywords[i].token == toknum )
return datafile_keywords[i].name;
imax = sizeof(mathfunc_keywords)/sizeof(struct ckey);
for ( i = 0 ; i < imax ; i++ )
if ( mathfunc_keywords[i].token == toknum )
return mathfunc_keywords[i].name;
imax = sizeof(mathfunc2_keywords)/sizeof(struct ckey);
for ( i = 0 ; i < imax ; i++ )
if ( mathfunc2_keywords[i].token == toknum )
return mathfunc2_keywords[i].name;
/* unfound */
return tokname(toknum);
}
/****************************************************************************
*
* function identtype()
*
* purpose: find type of an identifier. This version used by
* is_variable() etc. commands.
*/
int identtype(word)
char *word;
{
int type;
struct sym *s;
struct ckey *keyptr;
struct ckey key; /* for bsearch key */
if ( strlen(word) == 1 )
{
if ( single_redefine[yylval.i].start ) return tok = SINGLE_REDEFD_;
switch ( word[0] )
{ case 't': case 'l': case 'j': case 'P': case 'M':
case 'w': case 'n': case 'm': case 'b':
case 'k': case 'K': case 'p': case 'y':
return ( tok = SINGLE_LETTER_ARG_ );
case 'G': if ( verb_flag ) return tok = SINGLE_LETTER_ARG_;
else return tok = G_; break;
default: return ( tok = SINGLE_LETTER_ );
}
}
key.name = word;
keyptr = BSEARCH(colornames);
if ( keyptr )
return INTEGER_;
/* search math funcs */
keyptr = BSEARCH(mathfunc_keywords);
if ( keyptr ) { return MATHFUNC_; }
keyptr = BSEARCH(mathfunc2_keywords);
if ( keyptr ) { return MATHFUNC2_; }
/* search keywords and internal variables */
{
keyptr = BSEARCH(command_keywords);
if ( keyptr )
{
return tok;
}
keyptr = BSEARCH(togglenames);
if ( keyptr )
return tok;
keyptr = BSEARCH(internal_variables);
if ( keyptr ) { return INTERNAL_VARIABLE_; }
}
/* search local variables */
yylval.i = lookup_local_var(word);
if ( yylval.i )
{ struct global *g;
g = globals(yylval.i);
if ( g->flags & SUBROUTINE )
return ( tok = PROCEDURE_ );
else if ( g->flags & ORDINARY_PARAM )
return ( tok = IDENT_ );
else if ( g->flags & STRINGVAL )
return ( tok = STRINGGLOBAL_ );
else if ( g->flags & QUANTITY_NAME ) /* can't happen */
return ( tok = QUANTITY_NAME_ );
else if ( g->flags & METHOD_NAME ) /* can't happen */
return ( tok = METHOD_NAME_ );
else if ( g->flags & CONSTRAINT_NAME ) /* can't happen */
return ( tok = CONSTRAINT_NAME_ );
else if ( g->flags & BOUNDARY_NAME ) /* can't happen */
return ( tok = BOUNDARY_NAME_ );
else if ( g->flags & DYNAMIC_LOAD_FUNC ) /* can't happen */
return ( tok = DYNAMIC_LOAD_FUNC_ );
else if ( g->flags & ARRAY_PARAM )
return ( tok = ARRAYIDENT_ );
else if ( g->flags & GLOB_LOCALVAR )
return IDENT_;
else return (tok = NEWIDENT_);
}
/* search symbol table */
s = symbol_lookup(word);
if ( s )
{ yysym = s; yylval.i = yysym-symtable; verb_flag = 0;
return (tok = SYMBOL_ );
}
/* search parameter names */
yylval.i = lookup_perm_global(word);
if ( yylval.i >= 0 )
{
if ( perm_globals(yylval.i)->flags & SUBROUTINE )
return ( tok = PERM_PROCEDURE_ );
else if ( globals(yylval.i)->flags & STRINGVAL )
return ( tok = PERM_STRINGGLOBAL_ );
else return (tok = PERM_IDENT_);
}
yylval.i = lookup_global(word);
if ( yylval.i >= 0 )
{
if ( globals(yylval.i)->flags & SUBROUTINE )
return ( tok = PROCEDURE_ );
else if ( globals(yylval.i)->flags & STRINGVAL )
return ( tok = STRINGGLOBAL_ );
else if ( globals(yylval.i)->flags & QUANTITY_NAME )
return ( tok = QUANTITY_NAME_ );
else if ( globals(yylval.i)->flags & METHOD_NAME )
return ( tok = METHOD_NAME_ );
else if ( globals(yylval.i)->flags & DYNAMIC_LOAD_FUNC )
return ( tok = DYNAMIC_LOAD_FUNC_ );
else if ( globals(yylval.i)->flags & ARRAY_PARAM )
return ( tok = ARRAYIDENT_ );
else return (tok = IDENT_);
}
/* search extra attributes */
for ( type = 0 ; type <= BODY ; type++ )
{ struct extra *ex;
int i;
for ( i = 0, ex = EXTRAS(type) ;
i < web.skel[type].extra_count ; i++ , ex++ )
if ( stricmp(word, ex->name) == 0 )
{ strncpy(idname,word,sizeof(idname)); /* save text */
yylval.qnum = i;
yylval.etype = type;
return tok = ex->array_spec.dim ? ARRAY_ATTRIBUTE_ : EXTRA_ATTRIBUTE_;
}
}
/* if here, then not keyword */
yylval.i = 0;
return(tok = NEWIDENT_) ;
} /* end identtype() */
/*********************************************************************
*
* function: kblex()
*
* purpose: my own lexical analyzer, faster (for Evolver) and
* more comprehensible.
*/
/* States */
#define L_START 1
#define L_SLASH 2
#define L_LINECOMMENT 3
#define L_DOT 4
#define L_DIGITS 5
#define L_DIGITS_DOT 6
#define L_WHITESPACE 7
#define L_WHITESIGN 8
#define L_LINESTART 9
#define L_LEAD_INTEGER 10
#define L_LEAD_INTEGER_AT 11
#define L_INTEGER_AT 12
#define L_DIGITS_E 13
#define L_ALPHANUM 14
#define L_COLON 15
#define L_SEMICOLON 16
#define L_PLUS 17
#define L_MINUS 18
#define L_STAR 19
#define L_BANG 20
#define L_PIPE 21
#define L_AND 22
#define L_GREATER 23
#define L_COLONCOLON 24
#define L_SINGLE_QUOTE 25
#define L_HEXNUMBER 26
#define L_ZERO 27
#define L_GRGR 28
#define L_BACKQUOTE 29
#define L_SHARP 30
#define L_COLONCOLONCOLON 31
#define L_QUOTE 32
#define L_EQUAL 33
#define L_LESS 34
#define L_DIGITS_E_DIGITS 35
#define L_LEAD_MINUS 36
#define L_BACKSLASH 37
/* Unput buffer */
int ubuff_max = 0;
int ubuff_spot = 0; /* index of first vacant spot in unput_buff */
char *unput_buff;
/* the token */
/*char *yytext;*/
int yytext_max;
char kb_input_new()
{ char c;
if ( ubuff_spot )
{ c = unput_buff[--ubuff_spot];
unput_buff[ubuff_spot] = 0;
return c;
}
c = rawinput();
while ( c == 0 )
{ if ( yywrap() )
return 0;
else
c = rawinput();
}
return c;
}
void kb_unput(c)
char c;
{ if ( ubuff_spot >= ubuff_max )
{ if ( unput_buff )
{ ubuff_max *= 2;
unput_buff = realloc(unput_buff,ubuff_max);
}
else
{ ubuff_max = 16000;
unput_buff = calloc(ubuff_max,sizeof(char));
}
}
unput_buff[ubuff_spot++] = c;
}
int kblex()
{ int state;
char nextchar;
char *yyspot; /* first empty spot in yytext */
int retval;
PROF_START(kblex);
if ( !yytext )
{ yytext_max = 200;
yytext = calloc(yytext_max,sizeof(char));
}
yyspot = yytext;
memset(&yylval,0,sizeof(yylval));
state = tok ? L_START : L_LINESTART;
for(;;)
{ int len = yyspot-yytext;
if ( len >= yytext_max-2 )
{ yytext_max *= 2;
yytext = realloc(yytext,yytext_max);
yyspot = yytext + len;
}
*(yyspot++) = nextchar = kb_input_new();
switch ( state )
{
case L_START:
if ( nextchar == '0' )
state = L_ZERO;
else if ( isdigit(nextchar) )
state = L_DIGITS;
else if ( isalpha(nextchar) )
state = L_ALPHANUM;
else
switch ( nextchar )
{
case 0: tok=0; goto kblex_exit;
case '\n' : line_no++; yyspot = yytext; state = L_LINESTART;
break;
case ' ': case '\t':
yyspot--; state = L_WHITESPACE; break;
case '/': state = L_SLASH; break;
case '.': state = L_DOT; break;
case '_': state = L_ALPHANUM; break;
case ':': state = L_COLON; break;
case ';': state = L_SEMICOLON; break;
case '+': state = L_PLUS; break;
case '-': state = L_MINUS; break;
case '*': state = L_STAR; break;
case '!': state = L_BANG; break;
case '|': state = L_PIPE; break;
case '&': state = L_AND; break;
case '>': state = L_GREATER; break;
case '\'': state = L_SINGLE_QUOTE; break;
case '"': state = L_QUOTE; break;
case '`': state = L_BACKQUOTE; break;
case '=': state = L_EQUAL; break;
case '<': state = L_LESS; break;
case '\\': state = L_BACKSLASH; break;
case '#': state = L_SHARP; break;
case '(': verb_flag = 0;
*yyspot = 0; tok = nextchar; goto kblex_exit;
case ')':
case '^':
case ',':
case '?':
case '%':
case '[':
case ']':
case '}':
case '@':
*yyspot = 0; tok = nextchar; goto kblex_exit;
case '{': verb_flag = 1;
*yyspot = 0; tok = nextchar; goto kblex_exit;
default:
sprintf(errmsg,"Illegal character '%c'\n",nextchar);
kb_error(3658,errmsg,RECOVERABLE);
}
break;
case L_BACKSLASH:
/* allow trailing whitespace */
while ( nextchar == ' ' || nextchar == '\t' )
nextchar = kb_input_new();
if ( nextchar == '\n' )
{ yyspot = yytext;
state = L_START;
line_no++;
break;
}
kb_error(3659,
"Illegal backslash. Backslash is line continuation character.\n",
RECOVERABLE);
break;
case L_EQUAL:
if ( nextchar == '=' )
{ *yyspot = 0;
tok = EQ_;
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
tok = (datafile_flag ? '=' : EQ_);
goto kblex_exit;
case L_QUOTE:
{ /* read quoted string */
int n;
in_quote = 1;
for (n=0;;n++)
{ if ( nextchar == '\n' ) line_no++;
if ( nextchar == '"' && (n == 0 || (yytext[n-1] != '\\')) )
break;
if ( n >= yytext_max - 2 )
{ yytext_max *= 2;
yytext = realloc(yytext,yytext_max);
}
yytext[n] = nextchar;
nextchar = kb_input_new();
}
yytext[n] = 0;
reduce_string(yytext);
in_quote = 0;
tok = QUOTATION_;
goto kblex_exit;
}
break;
case L_LESS:
if ( nextchar == '=' )
{ *yyspot = 0;
tok = LE_;
goto kblex_exit;
}
else
{ kb_unput(nextchar);
yyspot[-1] = 0;
tok = '<';
goto kblex_exit;
}
break;
case L_GREATER:
if ( nextchar == '>' )
state = L_GRGR;
else if ( nextchar == '=' )
{ *yyspot = 0;
tok = GE_;
goto kblex_exit;
}
else
{ kb_unput(nextchar);
yyspot[-1] = 0;
tok = '>';
goto kblex_exit;
}
break;
case L_GRGR:
if ( nextchar == '>' )
{ *yyspot = 0;
tok = REDIRECTOVER_;
goto kblex_exit;
}
else
{ kb_unput(nextchar);
yyspot[-1] = 0;
tok = REDIRECT_;
goto kblex_exit;
}
break;
case L_SINGLE_QUOTE:
if ( nextchar == '\'' )
kb_error(3577,"Empty single quotes.\n",RECOVERABLE);
if ( nextchar == 0 || nextchar == '\n' )
kb_error(3570,"Dangling single quote.\n",RECOVERABLE);
yylval.i = nextchar;
nextchar = kb_input_new();
if ( nextchar != '\'' )
kb_error(3583,"Single quote not closed after one character.\n",
RECOVERABLE);
yytext[1] = 0;
tok = SINGLE_LETTER_;
goto kblex_exit;
break;
case L_BACKQUOTE:
while ( nextchar == ' ' ) yyspot[-1] = nextchar = kb_input_new();
if ( nextchar == ',' )
{ *yyspot = 0;
tok = BACKQUOTE_COMMA_;
goto kblex_exit;
}
yyspot[-1] = 0;
kb_unput(nextchar);
tok = '`';
goto kblex_exit;
break;
case L_SHARP:
while ( isalpha(nextchar) )
*(yyspot++) = nextchar = kb_input_new();
yyspot[-1] = 0;
if ( strcmp(yytext,"#define") == 0 )
{ if (!datafile_flag)
kb_error(2853,"#define valid only in top of datafile.\n",WARNING);
macro_flag = 1;
state = L_START;
yyspot = yytext;
break;
}
if ( strcmp(yytext,"#include") == 0 )
{
while ( nextchar != '"' ) nextchar = kb_input_new();
yyspot = yytext;
do
*(yyspot++) = nextchar = kb_input_new();
while ( nextchar != '"' );
yyspot[-1] = 0;
push_commandfd(NULL,yytext);
state = L_LINESTART;
yyspot = yytext;
break;
}
kb_error(3681,"Illegal # directive.\n",RECOVERABLE);
break;
case L_ZERO:
if ( toupper(nextchar) == 'X' )
state = L_HEXNUMBER;
else if ( nextchar == '.' )
state = L_DIGITS_DOT;
else if ( isdigit(nextchar) )
state = L_DIGITS;
else
{ kb_unput(nextchar);
yyspot[-1] = 0;
yylval.i = 0;
verb_flag = 0;
tok = INTEGER_;
goto kblex_exit;
}
break;
case L_HEXNUMBER:
if ( isdigit(nextchar) ||
(toupper(nextchar) >= 'A' && toupper(nextchar) <= 'F') )
break;
yyspot[-1] = 0;
kb_unput(nextchar);
sscanf(yytext+2,"%x",&yylval.i);
yylval.r = (REAL)yylval.i;
verb_flag = 0;
tok = INTEGER_;
goto kblex_exit;
case L_WHITESPACE:
if ( nextchar == '+' || nextchar == '-' )
{ state = L_WHITESIGN;
break;
}
if ( nextchar == ' ' || nextchar == '\t' )
{ yyspot--; break;
}
else
{ state = L_START;
kb_unput(nextchar);
yyspot--;
}
break;
case L_WHITESIGN:
kb_unput(nextchar);
if ( !isspace(nextchar) && (yytext[0] == '-') )
{ if ( datafile_flag && uminus_flag && (parens == 0) )
{ tok = UMINUS_;
goto kblex_exit;
}
}
/* else go back and treat as ordinary - */
yyspot--;
state = yytext[0] == '+' ? L_PLUS : L_MINUS;
break;
case L_LINESTART:
if ( nextchar == 0 )
{ tok = 0;
goto kblex_exit;
}
if ( nextchar == ' ' || nextchar == '\t' )
yyspot--;
else if ( isdigit(nextchar) )
state = L_LEAD_INTEGER;
else if ( nextchar == '-' )
state = L_LEAD_MINUS;
else
{ kb_unput(nextchar);
state = L_START;
yyspot = yytext;
}
break;
case L_LEAD_MINUS:
if ( isdigit(nextchar) )
state = L_LEAD_INTEGER;
else
{ kb_unput(nextchar);
state = L_WHITESIGN;
yyspot--;
}
break;
case L_LEAD_INTEGER:
if ( isdigit(nextchar) )
break;
if ( nextchar == '.' )
{ state = L_DIGITS_DOT;
break;
}
if ( (toupper(nextchar) == 'E') || (toupper(nextchar) == 'D') )
{ state = L_DIGITS_E;
break;
}
if ( nextchar == '@' )
{ state = L_LEAD_INTEGER_AT;
break;
}
/* have LEAD_INTEGER_ */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.r = atof(yytext);
yylval.i = atoi(yytext);
verb_flag = 0;
if ( lists_flag==LISTS_FULL )
{ tok = LEAD_INTEGER_;
goto kblex_exit;
}
else if ( uminus_flag || yytext[0] != '-' )
{ tok = (fabs(yylval.r) > MAXINT) ? REAL_ : INTEGER_;
goto kblex_exit;
}
else
{ for ( yyspot -= 2 ; yyspot != yytext ; yyspot-- )
kb_unput(*yyspot);
yytext[1] = 0;
tok = minus_type(yytext[0]);
goto kblex_exit;
}
break;
case L_DIGITS:
if ( isdigit(nextchar) )
break;
if ( nextchar == '.' )
{ state = L_DIGITS_DOT;
break;
}
if ( (toupper(nextchar) == 'E') || (toupper(nextchar) == 'D') )
{ state = L_DIGITS_E;
break;
}
if ( nextchar == '@' )
{ state = L_INTEGER_AT;
break;
}
if ( toupper(nextchar) == 'B' )
{ char *c;
yylval.i = 0;
for ( c = yytext; *c=='0' || *c=='1' ; c++ )
yylval.i = 2*yylval.i + (*c - '0');
if ( c == yyspot-1 )
{ yylval.r = (REAL)yylval.i;
verb_flag = 0;
tok = INTEGER_;
goto kblex_exit;
}
/* else fall through to ordinary integer */
}
/* have INTEGER_ */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.r = atof(yytext);
yylval.i = atoi(yytext);
verb_flag = 0;
tok = (fabs(yylval.r) > MAXINT) ? REAL_ : INTEGER_;
goto kblex_exit;
case L_DIGITS_DOT:
if ( (toupper(nextchar) == 'E') || (toupper(nextchar) == 'D') )
{ state = L_DIGITS_E;
break;
}
if ( isdigit(nextchar) )
break;
if ( isalpha(nextchar) )
{ *yyspot = 0;
tok = VERSIONTOKEN_;
goto kblex_exit;
}
/* have complete REAL */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.r = atof(yytext);
verb_flag = 0;
tok = REAL_;
goto kblex_exit;
case L_DOT:
if ( isdigit(nextchar) )
{ state = L_DIGITS_DOT;
break;
}
/* else just a dot */
kb_unput(nextchar);
yyspot[-1] = 0;
tok = '.';
goto kblex_exit;
case L_LEAD_INTEGER_AT:
if ( isdigit(nextchar) )
break;
/* have token */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.i = atoi(yytext);
yylval.qnum = atoi(strchr(yytext,'@')+1);
if ( yylval.i == 0 )
kb_error(3554,"Missing task number.",DATAFILE_ERROR);
verb_flag = 0;
tok = LEAD_INTEGER_AT_;
goto kblex_exit;
case L_INTEGER_AT:
if ( isdigit(nextchar) )
break;
/* have token */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.i = atoi(yytext);
yylval.qnum = atoi(strchr(yytext,'@')+1);
if ( yylval.i == 0 )
kb_error(3553,"Missing task number.",DATAFILE_ERROR);
verb_flag = 0;
tok = INTEGER_AT_;
goto kblex_exit;
case L_SLASH:
switch ( nextchar )
{ case '*':
{ /* eat comment */
register int c;
in_comment = 1;
state = L_START;
for ( ; ; )
{ while ( (c = kb_input_new()) != '*' && c != 0 )
if ( c == '\n' )
{ line_no++; /* eat up text of comment */
state = L_LINESTART;
}
if ( c == '*' )
{ while ( (c = kb_input_new()) == '*' ) ;
if ( c == '/' ) break; /* found the end */
if ( c == '\n' )
{ line_no++;
state = L_LINESTART;
}
}
if ( c == 0 && yywrap() )
{ kb_error(2861,"End-of-file in comment\n",RECOVERABLE );
break;
}
}
in_comment = 0;
yyspot = yytext;
}
break;
case '/': state = L_LINECOMMENT; break;
case '=': *yyspot = 0; yylval.i = DIVASSIGN_;
verb_flag = 0;
tok=ASSIGNOP_;
goto kblex_exit;
default: kb_unput(nextchar);
yyspot[-1] = 0;
verb_flag = 0;
tok = '/';
goto kblex_exit;
}
break; /* end L_SLASH */
case L_DIGITS_E:
if ( isdigit(nextchar) || nextchar == '+' || nextchar == '-' )
{ state = L_DIGITS_E_DIGITS;
break;
}
kb_error(3664,"Missing exponent for scientific notation.\n",
RECOVERABLE);
break;
case L_DIGITS_E_DIGITS:
if ( isdigit(nextchar) )
break;
/* have token */
kb_unput(nextchar);
yyspot[-1] = 0;
yylval.r = atof(yytext);
verb_flag = 0;
tok = REAL_;
goto kblex_exit;
case L_ALPHANUM:
if ( isalnum(nextchar) || nextchar == '_' )
break;
/* have token */
kb_unput(nextchar);
yyspot[-1] = 0;
strncpy(yylval.lexeme,yytext,31);
retval = macro();
if ( retval == WAS_MACRO_DEF )
{ /* macro() ate up rest of line */
state = L_LINESTART;
yyspot = yytext;
}
else if ( retval == MACRO_EXPANDED )
{ state = L_START;
yyspot = yytext;
}
else
{
tok = identcase(yytext);
goto kblex_exit;
}
break;
case L_COLON:
if ( nextchar == '=' )
{ verb_flag = 2; yyspot[-1] = 0;
tok = ASSIGN_;
goto kblex_exit;
}
if ( nextchar == ':' )
{ state = L_COLONCOLON;
break;
}
kb_unput(nextchar);
yyspot[-1] = 0;
if ( cond_expr_flag )
{ tok = ':';
goto kblex_exit;
}
/* else treat as whitespace */
yyspot = yytext;
state = L_START;
break;
case L_COLONCOLON:
if ( nextchar == '=' )
{ verb_flag = 2; yyspot[-1] = 0;
tok = PERM_ASSIGN_;
goto kblex_exit;
}
if ( nextchar == ':' )
{ state = L_COLONCOLONCOLON;
break;
}
kb_error(3568,"Illegal token '::'\n",RECOVERABLE);
break;
case L_COLONCOLONCOLON:
if ( nextchar == '=' )
{ verb_flag = 2; yyspot[-1] = 0;
tok = REDEFINE_;
goto kblex_exit;
}
kb_error(3569,"Illegal token ':::'\n",RECOVERABLE);
break;
case L_SEMICOLON:
if ( nextchar == '=' )
{ verb_flag = 2;
kb_error(2868,"You mistyped ';=' for ':='?\n",WARNING);
tok= ASSIGN_;
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
verb_flag = 1;
tok = ';';
goto kblex_exit;
case L_PLUS:
verb_flag = 0;
if ( nextchar == '=' )
{ verb_flag = 0; *yyspot = 0;
yylval.i = PLUSASSIGN_;
tok = ASSIGNOP_;
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
tok = '+';
goto kblex_exit;
case L_MINUS:
verb_flag = 0;
if ( nextchar == '=' )
{ verb_flag = 0; yylval.i = SUBASSIGN_;
*yyspot = 0;
tok= ASSIGNOP_;
goto kblex_exit;
}
verb_flag = 0;
kb_unput(nextchar);
tok = minus_type('-');
goto kblex_exit;
case L_STAR:
verb_flag = 0;
if ( nextchar == '=' )
{ verb_flag = 0; *yyspot = 0;
yylval.i = MULTASSIGN_;
tok = ASSIGNOP_;
goto kblex_exit;
}
if ( nextchar == '*' )
{ verb_flag = 0; *yyspot = 0;
tok = '^';
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
tok = '*';
goto kblex_exit;
case L_BANG:
verb_flag = 0;
if ( nextchar == '=' )
{ *yyspot = 0;
tok = NE_;
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
tok = NOT_;
goto kblex_exit;
case L_PIPE:
if ( nextchar == '|' )
{ *yyspot = 0;
tok = OR_;
goto kblex_exit;
}
kb_unput(nextchar);
yyspot[-1] = 0;
tok = PIPE_;
goto kblex_exit;
case L_AND:
if ( nextchar == '&' )
{ *yyspot = 0;
tok = AND_;
goto kblex_exit;
}
kb_error(3566,"Illegal token '&'\n",RECOVERABLE);
break;
case L_LINECOMMENT:
if ( (nextchar == '\n') || (nextchar == 0) )
{ line_no++;
state = L_LINESTART;
yyspot = yytext;
break;
}
yyspot--; /* don't save comment token */
break;
default:
fprintf(stderr,"Unhandled state: %d\n",state);
*yyspot = 0;
tok = 1;
goto kblex_exit;
}
}
kblex_exit:
PROF_FINISH(kblex);
return tok;
}
evolver-2.30c.dfsg/src/wulff.c 0000644 0001753 0001753 00000015511 11410765113 016507 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/****************************************************************
*
* File: wulff.c
*
* Purpose: Routines dealing with surface energy as function
* of normal direction.
*/
/*****************************************************************
*
* Discussion: For a chunk of surface represented by its
* normal vector N (length is area of chunk), its energy is
* the inner product of N with the Wulff vector W, which is a
* function of N. For a given set of Wulff vectors, W is the
* one whose inner product with N is greatest. The Wulff vectors
* are the vertices of the Wulff crystal. For simple area,
* W is the normalization of N.
*
* Force is energy gradient, so for N depending on a parameter u,
*
* dE/du = +
*
* However, the fact that W has maximal product with N implies
* = 0, so dE/du = . So we need only
* the Wulff vector to calculate both energy and force.
*/
#include "include.h"
/*******************************************************
*
* wulff_initialize()
*
* Purpose: Read in Wulff vectors from file and initialze
* Wulff variables. If special name, redirects
* Wulff functions to special functions in this
* file.
*
* Input: Name of file with Wulff vectors.
*
* Output: Array of Wulff vectors, wulff_flag set
*/
void wulff_initialize(wulffname)
char *wulffname;
{
FILE *wfd;
REAL *row; /* current Wulff vector */
int k; /* vector number */
int j; /* dimension number */
if ( (web.representation != SOAPFILM ) || (SDIM != 3) )
kb_error(1385,"Can only do Wulff energy for 2D surface in 3D.\n",RECOVERABLE);
if ( !wulffname || (wulffname[0] == 0) )
kb_error(2857,"Missing Wulff file name.\n",RECOVERABLE);
web.wulff_flag = 1;
/* save name */
strncpy(web.wulff_name,wulffname,sizeof(web.wulff_name));
/* test special names */
if ( (strncmp(wulffname,"hemisphere",10) == 0 )
|| (strcmp(wulffname,"hemi") == 0) )
{ get_wulff = hemi_wulff;
return;
}
else if ( strncmp(wulffname,"lens",4) == 0 )
{ get_wulff = lens_wulff;
return;
}
/* default is from file */
get_wulff = file_wulff;
wfd = path_open(wulffname,NOTDATAFILENAME);
if ( wfd == NULL )
{ sprintf(errmsg,"Cannot open Wulff vector file %s.\n",wulffname);
kb_error(1386,errmsg,DATAFILE_ERROR);
return;
}
for ( k = 0 ; k < MAXWULFF ; k++ )
{ row = wulff_vector[k];
for ( j = 0 ; j < SDIM ; j++ )
#ifdef LONGDOUBLE
if ( fscanf(wfd,"%Lf",row+j) != 1 ) break;
#else
if ( fscanf(wfd,"%lf",row+j) != 1 ) break;
#endif
}
fclose(wfd);
web.wulff_count = k;
}
/******************************************************************8
*
* Function: file_wulff()
*
* Purpose: Finds Wulff vector that has maximum dot product
* with given vector.
*
* Input: Pointer to given vector,
* pointer to destination of Wulff vector.
*
* Output: Components of Wulff vector put in place.
*/
void file_wulff(norm,wulff)
REAL *norm;
REAL *wulff;
{
REAL maxw = -1e20;
REAL *w; /* Wulff vector being tested */
int k;
int best = 0;
for ( k = 0 ; k < web.wulff_count ; k++ )
{ w = wulff_vector[k];
if ( SDIM_dot(w,norm) > maxw )
{ best = k;
maxw = SDIM_dot(w,norm);
}
}
memcpy((char *)wulff,(char *)wulff_vector[best],SDIM*sizeof(REAL));
}
/******************************************************************
*
* Function: hemi_wulff()
*
* Purpose: Provide Wulff vector for upper hemisphere Wulff shape.
*/
void hemi_wulff(normal,wulff)
REAL *normal;
REAL *wulff;
{
int i;
REAL norm;
wulff[0] = normal[0];
wulff[1] = normal[1];
if ( normal[2] < 0.0 )
wulff[2] = 0.0;
else wulff[2] = normal[2];
norm = sqrt(SDIM_dot(wulff,wulff));
if ( norm > 0.0 )
for ( i = 0 ; i < SDIM ; i++ )
wulff[i] /= norm;
}
/********************************************************************
*
* Function: lens_wulff
*
* Purpose: Provide Wulff vector for lens-shaped Wulff shape.
*/
void lens_wulff(normal,wulff)
REAL *normal;
REAL *wulff;
{
REAL norm;
/* test whether interior or edge Wulff vector */
norm = dot(normal,normal,2); /* x and y only */
if ( norm < 3*normal[2]*normal[2] )
{ /* interior */
norm = sqrt(norm + normal[2]*normal[2]);
if ( norm > 0.0 )
{ wulff[0] = normal[0]/norm;
wulff[1] = normal[1]/norm;
wulff[2] = normal[2]/norm - 0.5;
}
}
else
{ /* edge */
norm = sqrt(norm/0.75);
wulff[0] = normal[0]/norm;
wulff[1] = normal[1]/norm;
wulff[2] = 0.0;
}
}
/************************************************************************
Wulff energy as method
**************************************************************************/
void wulff_method_init(mode,mi)
int mode;
struct method_instance *mi;
{ char response[200];
if ( web.modeltype != LINEAR )
kb_error(2859,"Wulff energy can only be done in LINEAR model.\n",
RECOVERABLE);
if ( web.wulff_flag == 0 )
{ prompt("Enter Wulff name (hemi,lens, or filename): ",response,sizeof(response));
wulff_initialize(response);
}
}
REAL facet_wulff_value(f_info)
struct qinfo *f_info;
{ REAL normal[MAXCOORD];
REAL wulff [MAXCOORD];
REAL density = get_facet_density(f_info->id);
REAL energy;
REAL side [MAXCOORD][MAXCOORD];
int i,j;
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = f_info->x[ii][j] - f_info->x[i][j];
}
/* calculate normal */
cross_prod(side[0],side[1],normal);
(*get_wulff)(normal,wulff);
energy = SDIM_dot(wulff,normal)/2;
return density*energy;
}
REAL facet_wulff_grad(f_info)
struct qinfo *f_info;
{ REAL normal[MAXCOORD];
REAL wulff [MAXCOORD];
REAL temp [MAXCOORD];
REAL side [MAXCOORD][MAXCOORD];
REAL density = get_facet_density(f_info->id);
REAL energy;
int i,j;
for ( i = 0 ; i < FACET_EDGES ; i++ )
{ int ii = (i+1)%FACET_EDGES;
for ( j = 0 ; j < SDIM ; j++ )
side[i][j] = f_info->x[ii][j] - f_info->x[i][j];
}
/* calculate normal */
cross_prod(side[0],side[1],normal);
(*get_wulff)(normal,wulff);
/* force on each vertex */
for ( i = 0 ; i < FACET_VERTS ; i++ ) /* vertex loop */
{ int k;
j = (i+1)%FACET_EDGES; /* opposite side */
cross_prod(side[j],wulff,temp);
for ( k = 0 ; k < SDIM ; k++ )
f_info->grad[i][k] -= density*temp[k]/2;
}
energy = SDIM_dot(wulff,normal)/2;
return density*energy;
}
evolver-2.30c.dfsg/src/machine.c 0000644 0001753 0001753 00000004240 11410765113 016765 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/* machine.c */
/* missing routines on some systems; see include.h for defines */
#include "include.h"
/**********************************************************************8
*
* function: set_ctypes()
*
* purpose: implement toupper and tolower as arrays and set up
* ctype flag bits.
*/
void set_ctypes()
{
int c;
for ( c = 0xFF ; c > 0 ; c-- )
{ kb_upper_array[c] = (char)c;
kb_lower_array[c] = (char)c;
}
for ( c = 'a' ; c <= 'z' ; c++ )
kb_upper_array[c] = (char)(c + 'A' - 'a');
for ( c = 'A' ; c <= 'Z' ; c++ )
kb_lower_array[c] = (char)(c - 'A' + 'a');
}
int kb_stricmp(a,b)
char *a,*b;
{ register char aa,bb; /* lower case versions of characters */
for(;;a++,b++)
{ aa = tolower(*a);
bb = tolower(*b);
if ( aa < bb ) return -1;
if ( aa > bb ) return 1;
if ( !aa ) break; /* have reached both nulls */
}
return 0; /* equal strings */
}
int kb_strnicmp(a,b,n)
char *a,*b;
int n; /* maximum characters to compare */
{ register char aa,bb; /* lower case versions of characters */
for(;n;n--,a++,b++)
{ aa = tolower(*a);
bb = tolower(*b);
if ( aa < bb ) return -1;
if ( aa > bb ) return 1;
if ( !aa ) break; /* have reached both nulls */
}
return 0; /* equal strings */
}
void kb_strupr(s)
char *s;
{
while ( *s )
{ *s = (char)toupper(*s);
s++;
}
}
/* finds string b in string a */
char *kb_strstr(a,b)
char *a;
char *b;
{
char *ptr,*ch;
for ( ; *a ; a++ )
{ for ( ptr = a, ch = b; *ch && (*ptr == *ch) ; ptr++,ch++ ) ;
if ( *ch == '\0' ) return a;
}
return NULL;
}
void kb_memmove(dest,src,n)
char *dest;
char *src;
size_t n;
{
/* crude bytewise move */
if ( (dest - src) > 0 ) /* move from top down */
{
src += n; dest += n;
for ( ; n ; n-- ) *(--dest) = *(--src);
}
else /* move from bottom up */
{
for ( ; n ; n-- ) *(dest++) = *(src++);
}
}
evolver-2.30c.dfsg/src/skeleton.c 0000644 0001753 0001753 00000143447 11410765113 017222 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: skeleton.c
*
* Purpose: Variables and functions for skeleton element handling
*/
#include "include.h"
/* non-inlined versions of inlinable functions */
#ifndef INLINE
#define INLINE
#include "inline.h"
#endif
/* extra attribute type sizes, matching order in skeleton.h */
int datatype_size[NUMDATATYPES] =
{0,sizeof(REAL),sizeof(int),sizeof(unsigned long), sizeof(unsigned char),
sizeof(unsigned short), sizeof(unsigned int),
sizeof(long int),sizeof(char),sizeof(short),0,sizeof(char*),sizeof(char*),
sizeof(vertex_id),sizeof(edge_id),sizeof(facet_id),sizeof(body_id),
sizeof(facetedge_id),sizeof(element_id),sizeof(int),sizeof(int),sizeof(int),sizeof(int),
sizeof(int)
};
char *datatype_name[NUMDATATYPES] =
{ " ","real","integer","ulong_int","uchar","ushort_int","uint",
"long_int","char","short_int"," ","string","pointer", "vertex_type",
"edge_type","facet_type","body_type","facetedge_type", "element_id",
"boundary_type","constraint_type","quantity_type","method_instance_type",
"procedure"
};
/* quadratic interpolation coefficients */
/* partials of interpolation polynomials at midpoints of patch edges */
/* control points are numbered 0 to 5 counterclockwise */
/* midpoints are numbered 0 to 2 counterclockwise after control pt 0 */
/* dip[midpoint][control point][partial] */
REAL dip[FACET_EDGES][FACET_CTRL][2] = {
{ { -0.5, -0.5 }, { 0.0, -1.0 }, { 0.5, 0.0 }, { 0.0, 1.0 },
{ 0.0, -0.5 }, { 0.0, 1.0 } },
{ { 0.5, 0.5 }, { -1.0, -1.0 }, { 0.5, 0.0 }, { 1.0, 1.0 },
{ 0.0, 0.5 }, { -1.0, -1.0 } },
{ { -0.5, -0.5 }, { 1.0, 0.0 }, { -0.5, 0.0 }, { 1.0, 0.0 },
{ 0.0, 0.5 }, { -1.0, 0.0 } }
};
int Ord(id) /* useful in debugger */
element_id id;
{ return loc_ordinal(id); }
void vloop ARGS((vertex_id));
void vloop(v_id) /* prints vertex edge loop; useful in debugger */
element_id v_id;
{ edge_id e_id,ee_id;
int n = 0;
e_id = get_vertex_edge(v_id);
if ( !valid_id(e_id) )
{ puts("No valid edge on vertex."); return; }
ee_id = e_id;
do { printf("%d ",inverted(ee_id)?-(Ord(ee_id)+1): (Ord(ee_id)+1));
ee_id = get_next_tail_edge(ee_id);
if ( ++n > web.skel[EDGE].count )
{ puts("Unclosed loop."); break;}
} while ( ee_id != e_id );
printf("\n");
}
void set_facet_body(f_id,b_id)
facet_id f_id;
body_id b_id; /* may be invalid for unsetting */
{ body_id bb_id;
if ( web.skel[BODY].count == 0 ) return;
if ( !valid_id(f_id) ) return;
#ifdef MPI_EVOLVER
if ( id_task(f_id) != this_task )
return; /* imported facets not part of local body chains */
#endif
bb_id = get_facet_body(f_id);
if ( equal_id(bb_id,b_id) ) return;
/* check if old body of this facet links to this facet */
if ( valid_id(bb_id) )
{
facet_id ff_id = get_body_facet(bb_id);
facet_id next_f,prev_f;
if ( valid_id(ff_id) )
{
if ( equal_id(f_id,ff_id) ) /* need to give body new link */
{
prev_f = get_prev_body_facet(f_id);
if ( equal_id(prev_f,f_id) || !valid_id(prev_f) ||
!equal_id(bb_id,get_facet_body(prev_f)) )
set_body_facet(bb_id,NULLID);
else
set_body_facet(bb_id,prev_f);
}
/* remove from old body facet list */
next_f = get_next_body_facet(f_id);
prev_f = get_prev_body_facet(f_id);
set_next_body_facet(prev_f,next_f);
set_prev_body_facet(next_f,prev_f);
}
}
/* insert in new body list */
if ( valid_id(b_id) )
{
facet_id nextf = get_body_facet(b_id);
if ( valid_id(nextf) )
{ facet_id prevf = get_prev_body_facet(nextf);
set_next_body_facet(f_id,nextf);
set_prev_body_facet(nextf,f_id);
set_next_body_facet(prevf,f_id);
set_prev_body_facet(f_id,prevf);
}
else /* first facet for body */
{
set_next_body_facet(f_id,f_id);
set_prev_body_facet(f_id,f_id);
set_body_facet(b_id,f_id);
}
}
if ( everything_quantities_flag )
{
if ( inverted(f_id) ) /* back facet */
{
body_id bb_id = F_ELID(f_id,F_BODY_LIST_ATTR)[1];
if ( equal_id(bb_id,b_id) ) return;
if ( valid_id(bb_id) ) /* cancel out if already there */
apply_method_num(inverse_id(f_id),get_body_volmeth(bb_id));
F_ELID(f_id,F_BODY_LIST_ATTR)[1] = b_id;
if ( valid_id(b_id) )
apply_method_num(f_id,get_body_volmeth(b_id));
}
else /* front facet */
{
body_id bb_id = F_ELID(f_id,F_BODY_LIST_ATTR)[0];
if ( equal_id(bb_id,b_id) ) return;
if ( valid_id(bb_id) )
apply_method_num(inverse_id(f_id),get_body_volmeth(bb_id));
F_ELID(f_id,F_BODY_LIST_ATTR)[0] = b_id;
if ( valid_id(b_id) )
apply_method_num(f_id,get_body_volmeth(b_id));
}
/* and content integrands on edges */
if ( web.representation == SOAPFILM )
{ facetedge_id fe = get_facet_fe(f_id);
edge_id e_id;
int i;
unsigned int k;
conmap_t *map;
char name[100];
for ( i = 0 ; i < FACET_EDGES ; i++, fe = get_next_edge(fe))
{ e_id = get_fe_edge(fe);
if ( !get_eattr(e_id) & BDRY_CONTENT ) continue;
map = get_e_constraint_map(e_id);
for ( k = 1 ; k <= map[0] ; k++ )
{ struct constraint *con = get_constraint(map[k]);
int inst_num;
if ( con->attr & CON_CONTENT )
{ if ( valid_id(bb_id) )
{ if ( con->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(bb_id)+1,con->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(bb_id)+1,map[k]);
inst_num = find_method_instance(name);
if ( inst_num < 0 )
inst_num = create_body_constraint_content_method(bb_id,map[k]);
apply_method_num(inverse_id(e_id),inst_num); /* cancel */
}
if ( valid_id(b_id) )
{ if ( con->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,con->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,map[k]);
inst_num = find_method_instance(name);
if ( inst_num < 0 )
inst_num = create_body_constraint_content_method(b_id,map[k]);
apply_method_num(e_id,inst_num);
}
}
}
}
}
}
else
{
if ( inverted(f_id) )
F_ELID(f_id,F_BODY_LIST_ATTR)[1] = b_id;
else
F_ELID(f_id,F_BODY_LIST_ATTR)[0] = b_id;
}
top_timestamp = ++global_timestamp;
}
/**************************************************************************
*
* Function: set_facet_fe()
*
* Purpose: Link facet to facetedge.
*
*/
void set_facet_fe(f_id,fe)
facet_id f_id;
facetedge_id fe;
{
if ( inverted(f_id) ) { invert(fe); invert(f_id); }
fptr(f_id)->fe_id = fe;
if ( web.representation == STRING )
{ body_id b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
set_body_facet(b_id,f_id);
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
set_body_facet(b_id,inverse_id(f_id));
}
top_timestamp = ++global_timestamp;
}
REAL get_vertex_length_star(v_id) vertex_id v_id;
{ edge_id e_id = get_vertex_edge(v_id);
edge_id firste = e_id;
REAL star = 0.0;
if ( get_vattr(v_id) & (Q_MIDPOINT|Q_MIDEDGE) ) return get_edge_length(e_id);
if ( !valid_id(e_id) ) return 0.0;
do { star += get_edge_length(e_id); e_id = get_next_tail_edge(e_id);}
while ( !equal_element(e_id,firste) );
return star;
}
REAL get_vertex_area_star(v_id) vertex_id v_id;
{
REAL star = 0.0;
if ( web.representation == STRING )
return get_vertex_length_star(v_id);
else if ( web.representation == SOAPFILM )
{
facetedge_id fe_id = get_vertex_first_facet(v_id);
facetedge_id firstfe = fe_id;
facet_id f_id;
if ( !valid_id(fe_id) ) return 0.0;
do
{ f_id = get_fe_facet(fe_id);
star += get_facet_area(f_id);
fe_id = get_next_vertex_facet(v_id,fe_id);
}
while ( !equal_element(fe_id,firstfe) );
}
else /* SIMPLEX */
{
facet_id f_id = get_vertex_first_facet(v_id);
facet_id firstf = f_id;
if ( !valid_id(f_id) ) return 0.0;
do
{ star += get_facet_area(f_id);
f_id = get_next_vertex_facet(v_id,f_id);
}
while ( !equal_element(f_id,firstf) );
}
return star;
}
int get_vertex_fvalence(v_id) vertex_id v_id;
{
int valence = 0;
facet_id f_id = get_vertex_first_facet(v_id);
facet_id firstf = f_id;
if ( !valid_id(f_id) ) return 0;
do
{ valence++; f_id = get_next_vertex_facet(v_id,f_id);}
while ( !equal_element(f_id,firstf) );
return valence;
}
void set_next_body_facet(f_id,ff_id) facet_id f_id,ff_id;
{ F_ELID(f_id,F_NEXT_BFACET_ATTR)[inverted(f_id)?1:0] = (ff_id) ; }
void set_prev_body_facet(f_id,ff_id) facet_id f_id,ff_id;
{ F_ELID(f_id,F_NEXT_BFACET_ATTR)[inverted(f_id)?3:2] = (ff_id) ; }
facet_id get_next_body_facet(f_id) facet_id f_id;
{ return F_ELID(f_id,F_NEXT_BFACET_ATTR)[inverted(f_id)?1:0]; }
facet_id get_prev_body_facet(f_id) facet_id f_id;
{ return F_ELID(f_id,F_NEXT_BFACET_ATTR)[inverted(f_id)?3:2]; }
void set_body_volume(b_id,v,mode)
body_id b_id;
REAL v;
int mode; /* NOSETSTAMP or SETSTAMP */
{ struct body *b = bptr(b_id);
if ( !valid_id(b_id) ) return;
b->volume = v;
b->abstotal = fabs(v);
if ( mode == SETSTAMP )
b->voltimestamp = global_timestamp;
/*
if ( web.representation == STRING)
{ facet_id f_id = get_body_facet(b_id));
if ( valid_id(f_id) ) set_facet_area(f_id,v);
}
*/
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(b->volquant);
q->value = v;
}
}
void add_body_volume(b_id,v) /* uses binary tree add */
body_id b_id; REAL v;
{ struct body *b;
if ( !valid_id(b_id) ) return;
b = bptr(b_id);
binary_tree_add(b->volume_addends,v);
b->abstotal += fabs(v);
}
void add_body_volume_plain(b_id,v) /* with updates of related quantities */
body_id b_id; REAL v;
{ struct body *b;
if ( !valid_id(b_id) ) return;
b = bptr(b_id);
b->volume += v;
b->abstotal += fabs(v);
b->voltimestamp = global_timestamp;
/*
if ( web.representation == STRING)
{ facet_id f_id = get_fe_facet(b->fe_id);
if ( valid_id(f_id) ) set_facet_area(f_id,b->volume);
}
*/
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(b->volquant);
q->value = b->volume;
}
}
void add_body_abstotal(b_id,v)
body_id b_id; REAL v;
{ struct body *b;
if ( !valid_id(b_id) ) return;
b = bptr(b_id);
b->abstotal += fabs(v);
}
void set_body_fixvol(b_id,v)
body_id b_id;
REAL v;
{ if ( valid_id(b_id) )
{ bptr(b_id)->fixvol = (v);
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(b_id));
q->target = v;
if ( !(q->flags & Q_FIXED) )
{ q->flags &= ~(Q_INFO|Q_ENERGY|Q_CONSERVED);
q->flags |= Q_FIXED;
}
if ( web.pressure_flag )
{ q = GEN_QUANT(get_body_ambquant(b_id));
q->flags &= ~(Q_INFO|Q_FIXED|Q_CONSERVED);
q->flags |= Q_ENERGY;
}
}
}
else
{ sprintf(errmsg,"fix body volume: illegal body %s.\n",ELNAME(b_id));
kb_error(1307,errmsg,RECOVERABLE);
}
}
vertex_id new_vertex(x,parent)
REAL *x;
element_id parent; /* for inherited stuff */
{
int i;
vertex_id v_id;
REAL *y;
v_id = new_element(VERTEX,parent,NULLID);
if ( x )
{ y = get_coord(v_id);
for ( i = 0 ; i < SDIM ; i++ ) y[i] = x[i];
}
set_vertex_edge(v_id,NULLID);
set_vertex_facet(v_id,NULLID);
set_v_global(v_id);
/* interrupt conjugate gradient */
if ( cg_hvector ) { myfree((char *)cg_hvector); cg_hvector = NULL; }
return v_id;
}
vertex_id dup_vertex(old_v)
vertex_id old_v;
{
vertex_id v_id;
struct vertex *v_id_p;
v_id = new_element(VERTEX,NULLID,NULLID);
v_id_p = vptr(v_id);
memcpy((char *)&(v_id_p->attr),(char *)&(elptr(old_v)->attr),
web.sizes[VERTEX] - ((char*)&(v_id_p->attr)-(char*)v_id_p));
v_id_p->self_id = v_id; /* restore new id */
v_id_p->e_id = NULLID;
return v_id;
}
edge_id new_edge(tail_id,head_id,parent)
vertex_id tail_id,head_id;
element_id parent; /* for inherited stuff */
{
edge_id e_id;
vertex_id v_id;
REAL *x,*h,*t;
int i,k;
e_id = new_element(EDGE,parent,NULLID);
set_edge_fe(e_id,NULLFACETEDGE);
set_edge_color(e_id,DEFAULT_EDGE_COLOR);
if ( valid_id(tail_id) && valid_id(head_id) )
{ set_edge_tailv(e_id,tail_id);
set_edge_headv(e_id,head_id);
if ( (web.modeltype == QUADRATIC) && valid_id(head_id) )
{ /* quadratic version; linear interpolation of midpoint */
v_id = new_element(VERTEX,parent,NULLID);
set_edge_midv(e_id,v_id);
h = get_coord(head_id);
t = get_coord(tail_id);
x = get_coord(v_id);
for ( i = 0 ; i < SDIM ; i++ )
x[i] = (h[i] + t[i])/2.0;
}
else if ( (web.modeltype == LAGRANGE) && valid_id(head_id) )
{ /* Lagrange version; linear interpolation of points */
vertex_id *v = get_edge_vertices(e_id);
h = get_coord(head_id);
t = get_coord(tail_id);
for ( k = 1 ; k < web.lagrange_order ; k++ )
{ v[k] = new_element(VERTEX,parent,NULLID);
set_attr(v[k],Q_MIDEDGE);
set_vertex_edge(v[k],e_id);
x = get_coord(v[k]);
for ( i = 0 ; i < SDIM ; i++ )
x[i] = (k*h[i] + (web.lagrange_order-k)*t[i])/web.lagrange_order;
}
}
}
return e_id;
}
edge_id dup_edge(old_e)
edge_id old_e;
{
edge_id e_id;
struct edge *e_id_p,*old_e_p;
vertex_id newmid;
e_id = new_element(EDGE,NULLID,NULLID);
e_id_p = eptr(e_id);
old_e_p = eptr(old_e);
memcpy((char *)&(e_id_p->attr),(char *)&(old_e_p->attr),
web.sizes[EDGE] - ((char*)&(e_id_p->attr)-(char*)e_id_p));
e_id_p->self_id = e_id; /* restore new id */
e_id_p->next_vedge[0] = NULLID;
e_id_p->next_vedge[1] = NULLID;
if ( web.modeltype == QUADRATIC )
{ newmid = new_vertex(NULL,old_e);
set_edge_midv(e_id,newmid);
set_attr(newmid,Q_MIDPOINT);
set_vertex_edge(newmid,e_id);
}
else if ( web.modeltype == LAGRANGE )
{ int i;
vertex_id *v = get_edge_vertices(e_id);
for ( i = 1 ; i < web.lagrange_order ; i++ )
v[i] = new_vertex(NULL,e_id);
}
if ( inverted(old_e) ) return inverse_id(e_id);
return e_id;
}
void recalc_facet_area(f_id)
facet_id f_id;
{
if ( everything_quantities_flag )
quantity_attribute(f_id,default_area_quant_num);
else
(*calc_facet_energy)(f_id,AREA_ONLY);
}
facet_id new_facet ()
{
facet_id f_id;
f_id = new_element(FACET,NULLID,NULLID);
set_facet_color(f_id,DEFAULT_FACET_COLOR);
set_facet_density(f_id,1.0);
return f_id;
}
facet_id dup_facet(old_f)
facet_id old_f;
{
facet_id f_id;
struct facet *f_id_p;
body_id b_id,*fb;
int sign = inverted(old_f);
old_f = positive_id(old_f); /* since new facet id will be positive */
f_id = new_element(FACET,NULLID,NULLID);
f_id_p = fptr(f_id);
memcpy((char *)&(f_id_p->attr),(char *)&(elptr(old_f)->attr),
web.sizes[FACET] - ((char*)&(f_id_p->attr)-(char*)f_id_p));
f_id_p->self_id = f_id; /* restore new id */
set_attr(f_id,NEWELEMENT);
/* update body facet lists */
if ( web.skel[BODY].count )
{ fb = F_ELID(f_id,F_BODY_LIST_ATTR);
fb[0] = fb[1] = NULLID; /* so set_facet_body works */
fb = F_ELID(f_id,F_NEXT_BFACET_ATTR);
fb[0] = fb[1] = fb[2] = fb[3] = NULLID;
b_id = get_facet_body(old_f);
if ( valid_id(b_id) )
set_facet_body(f_id,b_id);
b_id = get_facet_body(inverse_id(old_f));
if ( valid_id(b_id) )
set_facet_body(inverse_id(f_id),b_id);
}
return sign ? inverse_id(f_id) : f_id;
}
body_id new_body()
{ int two = 2;
int four = 4;
body_id b_id;
expand_attribute(FACET,F_BODY_LIST_ATTR,&two);
expand_attribute(FACET,F_NEXT_BFACET_ATTR,&four);
b_id = new_element(BODY,NULLID,NULLID);
set_body_facet(b_id,NULLID);
if ( everything_quantities_flag )
convert_new_body_to_quantity(b_id);
web.bodycount++;
return b_id;
}
body_id dup_body(old_b)
body_id old_b;
{
body_id b_id;
struct body *b_id_p;
b_id = new_element(BODY,NULLID,NULLID);
b_id_p = bptr(b_id);
memcpy((char *)&(b_id_p->attr),(char *)&(elptr(old_b)->attr),
web.sizes[BODY] - ((char*)&(b_id_p->attr)-(char*)b_id_p));
b_id_p->self_id = b_id; /* restore new id */
set_body_facet(b_id,NULLID);
if ( everything_quantities_flag )
convert_new_body_to_quantity(b_id);
web.bodycount++;
return b_id;
}
facetedge_id new_facetedge(f_id,e_id)
facet_id f_id;
edge_id e_id;
{
facetedge_id fe_id;
fe_id = new_element(FACETEDGE,NULLID,NULLID);
set_fe_edge(fe_id,e_id);
set_fe_facet(fe_id,f_id);
set_prev_edge(fe_id,NULLFACETEDGE);
set_next_edge(fe_id,NULLFACETEDGE);
set_prev_facet(fe_id,NULLFACETEDGE);
set_prev_facet(fe_id,NULLFACETEDGE);
#ifndef MPI_EVOLVER
{ vertex_id headv,tailv;
tailv = get_edge_tailv(e_id);
headv = get_edge_headv(e_id);
if ( !valid_id(get_vertex_edge(tailv)) )
set_vertex_edge(tailv,e_id);
if ( !valid_id(get_vertex_edge(headv)) )
set_vertex_edge(headv,e_id);
}
#endif
if ( web.representation==STRING && everything_quantities_flag )
{ /* attach volume quantities */
body_id b_id;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
{ if ( same_sign(f_id,e_id) )
apply_method_num(e_id,get_body_volmeth(b_id));
else
apply_method_num(inverse_id(e_id),get_body_volmeth(b_id));
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
{ if ( same_sign(f_id,e_id) )
apply_method_num(inverse_id(e_id),get_body_volmeth(b_id));
else
apply_method_num(e_id,get_body_volmeth(b_id));
}
}
return fe_id;
}
void set_fe_facet(fe_id,f_id)
facetedge_id fe_id;
facet_id f_id;
{ facet_id oldf = get_fe_facet(fe_id);
feptr(fe_id)->fe_facet_id = inverted(fe_id) ? inverse_id(f_id) : f_id;
if ( web.representation==STRING && everything_quantities_flag &&
!equal_id(oldf,f_id) )
{ /* detach old volume quantity and attach new volume quantity */
body_id b_id, old_b_id;
edge_id e_id = get_fe_edge(fe_id);
b_id = get_facet_body(f_id);
old_b_id = valid_id(oldf) ? get_facet_body(oldf) : NULLID;
if ( valid_id(old_b_id) )
unapply_method(e_id,get_body_volmeth(old_b_id));
old_b_id = valid_id(oldf) ? get_facet_body(inverse_id(oldf)) : NULLID;
if ( valid_id(old_b_id) )
unapply_method(e_id,get_body_volmeth(old_b_id));
if ( valid_id(b_id) )
{ if ( same_sign(f_id,e_id) )
apply_method_num(e_id,get_body_volmeth(b_id));
else
apply_method_num(inverse_id(e_id),get_body_volmeth(b_id));
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) )
{ if ( same_sign(f_id,e_id) )
apply_method_num(inverse_id(e_id),get_body_volmeth(b_id));
else
apply_method_num(e_id,get_body_volmeth(b_id));
}
}
}
REAL get_edge_length(e_id)
edge_id e_id;
{
return (eptr(e_id)->length);
}
REAL get_facet_pressure(f_id)
facet_id f_id;
{
return (get_body_pressure(get_facet_body(f_id)) -
get_body_pressure(get_facet_body(facet_inverse(f_id))));
}
/********************************************************************
*
* Function: compare_vertex_attr(va,vb)
*
* Purpose: Compare constraints of vertex and vertex.
*
* Return value: 0 INCOMPARABLE Incomparable
* 1 A_SUB_B Vertex proper subset of vertex
* 2 A_EQ_B Vertex equal vertex
* 3 A_SUPER_B Vertex superset of vertex
*/
int compare_vertex_attr(va,vb)
vertex_id va,vb;
{ int i,j;
conmap_t * con1,*con2;
int same = 0;
/* check constraints */
con1 = get_v_constraint_map(va);
con2 = get_v_constraint_map(vb);
for ( i = 1 ; i <= (int)con2[0] ; i++ )
{ for ( j = 1 ; j <= (int)con1[0] ; j++ )
if ( (con1[j]&CONMASK) == (con2[i]&CONMASK) )
{ same++;
break;
}
}
if ( (same==(int)con1[0]) && (same==(int)con2[0]) )
return A_EQ_B;
if ( (same==(int)con1[0]) && (same < (int)con2[0]) )
return A_SUB_B;
if ( (same < (int)con1[0]) && (same==(int)con2[0]) )
return A_SUPER_B;
return INCOMPARABLE;
}
/********************************************************************
*
* Function: compare_vertex_edge_attr(va,eb)
*
* Purpose: Compare constraints of vertex and edge.
*
* Return value: 0 INCOMPARABLE Incomparable
* 1 A_SUB_B Vertex proper subset of edge
* 2 A_EQ_B Vertex equal edge
* 3 A_SUPER_B Vertex superset of edge
*/
int compare_vertex_edge_attr(va,eb)
vertex_id va;
edge_id eb;
{ int i,j;
conmap_t * con1,*con2;
int same = 0;
/* check constraints */
con1 = get_v_constraint_map(va);
con2 = get_e_constraint_map(eb);
for ( i = 1 ; i <= (int)con2[0] ; i++ )
{ for ( j = 1 ; j <= (int)con1[0] ; j++ )
if ( (con1[j]&CONMASK) == (con2[i]&CONMASK) )
{ same++;
break;
}
}
if ( (same==(int)con1[0]) && (same==(int)con2[0]) )
return A_EQ_B;
if ( (same==(int)con1[0]) && (same < (int)con2[0]) )
return A_SUB_B;
if ( (same < (int)con1[0]) && (same==(int)con2[0]) )
return A_SUPER_B;
return INCOMPARABLE;
}
/********************************************************************
*
* Function: compare_edge_attr(ea,eb)
*
* Purpose: Compare constraints of edge and edge.
*
* Return value: 0 INCOMPARABLE Incomparable
* 1 A_SUB_B edge proper subset of edge
* 2 A_EQ_B edge equal edge
* 3 A_SUPER_B edge superset of edge
*/
int compare_edge_attr(ea,eb)
edge_id ea,eb;
{ int i,j;
int fixa = get_eattr(ea) & FIXED;
int fixb = get_eattr(eb) & FIXED;
conmap_t * con1,*con2;
int same = 0;
/* check constraints */
con1 = get_e_constraint_map(ea);
con2 = get_e_constraint_map(eb);
for ( i = 1 ; i <= (int)con2[0] ; i++ )
{ for ( j = 1 ; j <= (int)con1[0] ; j++ )
if ( (con1[j]&CONMASK) == (con2[i]&CONMASK) )
{ same++;
break;
}
}
if ( (same==(int)con1[0]) && (same==(int)con2[0]) && !fixa && !fixb )
return A_EQ_B;
if ( (same==(int)con1[0]) && (same < (int)con2[0]) && !fixa )
return A_SUB_B;
if ( (same < (int)con1[0]) && (same==(int)con2[0]) && !fixb )
return A_SUPER_B;
return INCOMPARABLE;
}
/********************************************************************
*
* Function: compare_edge_facet_attr(ea,fb)
*
* Purpose: Compare constraints of edge and facet.
*
* Return value: 0 INCOMPARABLE Incomparable
* 1 A_SUB_B Edge proper subset of facet
* 2 A_EQ_B Edge equal facet
* 3 A_SUPER_B Edge superset of facet
*/
int compare_edge_facet_attr(ea,fb)
edge_id ea;
facet_id fb;
{ int i,j;
conmap_t * con1,*con2;
int fixa = get_eattr(ea) & FIXED;
int fixb = get_fattr(fb) & FIXED;
int same = 0;
/* check constraints */
con1 = get_e_constraint_map(ea);
con2 = get_f_constraint_map(fb);
for ( i = 1 ; i <= (int)con2[0] ; i++ )
{ for ( j = 1 ; j <= (int)con1[0] ; j++ )
if ( (con1[j]&CONMASK) == (con2[i]&CONMASK) )
{ same++;
break;
}
}
if ( (same==(int)con1[0]) && (same==(int)con2[0])&& !fixa && !fixb )
return A_EQ_B;
if ( (same==(int)con1[0]) && (same < (int)con2[0]) && !fixa )
return A_SUB_B;
if ( (same < (int)con1[0]) && (same==(int)con2[0]) && !fixb )
return A_SUPER_B;
return INCOMPARABLE;
}
/**************************************************************
*
* Function: equal_constr()
*
* Purpose: See if two elements have the same set of constraints.
*
*/
int equal_constr(id1,id2)
element_id id1,id2;
{ int i,j;
conmap_t * con1=NULL,*con2=NULL;
switch ( id_type(id1) )
{
case VERTEX:
con1 = get_v_constraint_map(id1);
break;
case EDGE :
con1 = get_e_constraint_map(id1);
break;
case FACET :
con1 = get_f_constraint_map(id1);
break;
}
switch ( id_type(id2) )
{
case VERTEX:
con2 = get_v_constraint_map(id2);
break;
case EDGE :
con2 = get_e_constraint_map(id2);
break;
case FACET :
con2 = get_f_constraint_map(id2);
break;
}
if ( con2[0] != con1[0] ) return 0;
for ( i = 1 ; i <= (int)con1[0] ; i++ )
{ for ( j = 1 ; j <= (int)con2[0] ; j++ )
if ( (con1[i]&CONMASK) == (con2[j]&CONMASK) ) break;
if ( j > (int)con2[0] ) return 0;
}
return 1;
}
/*************************************************************************
*
* function: add_attribute()
*
* purpose: add extra attribute to an element type
*
* return: index of attribute
*/
int add_attribute(e_type,name,attr_type,dim,dims,dumpflag,code)
int e_type; /* VERTEX ,... */
char *name;
int attr_type; /* REAL_TYPE or INTEGER_TYPE or ULONG_TYPE etc */
int dim; /* number of dimensions, 0 for scalar */
int *dims; /* sizes of dimensions, NULL for all sizes 0 */
/* Note: scalar still needs size of 0 or 1 */
int dumpflag; /* whether appears in dump file */
struct expnode *code; /* nonnull for function attribute */
{ int newsize,newcount=0;
struct extra *ex;
int oldsize;
int att_inx;
att_inx = find_attribute(e_type,name);
if ( att_inx >= 0 )
return att_inx;
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ struct mpi_command message;
int i;
if ( code )
{ kb_error(4525,"MPI Evolver doesn't do code attributes yet.\n",
RECOVERABLE);
}
message.cmd = mpi_ADD_ATTRIBUTE;
strncpy(message.name,name,MPI_NAME_SIZE);
message.i = attr_type;
message.type = e_type;
message.mode = dumpflag;
message.size = dims ? 1 : 0; /* just using as indicator */
message.count = dim;
if ( dim )
for (i = 0 ; i < dim ; i++ )
message.data[i] = dims ? dims[i] : 0;
else
message.data[0] = dims ? dims[0] : 0;
MPI_Bcast(&message,sizeof(struct mpi_command),MPI_BYTE,MASTER_TASK,
MPI_COMM_WORLD);
}
#endif
if ( web.skel[e_type].extra_count >= web.skel[e_type].maxextra-1 )
{ web.skel[e_type].dy_extras =
dy_realloc(web.skel[e_type].dy_extras,
(web.skel[e_type].maxextra+10),sizeof(struct extra));
web.skel[e_type].maxextra += 10;
}
/* expand space */
/* get old used space, minus any padding, and pad to proper size */
if ( web.skel[e_type].extra_count > 0 )
{ ex = EXTRAS(e_type) + web.skel[e_type].extra_count-1;
oldsize = ex->offset + ex->array_spec.datacount*datatype_size[ex->type];
}
else oldsize = web.sizes[e_type];
if (oldsize % datatype_size[attr_type])
oldsize += datatype_size[attr_type] - (oldsize % datatype_size[attr_type]);
ex = EXTRAS(e_type) + web.skel[e_type].extra_count;
if ( dim == 0 ) newcount = dims ? dims[0] : 0;
else if ( dim > MAXARRAYDIMS )
{ sprintf(errmsg,"Extra attribute \"%s\" has %d dimensions, exceeding limit of %d.\n", name,dim,MAXARRAYDIMS);
kb_error(2510,errmsg,RECOVERABLE);
}
else if ( dims == NULL ) newcount = 0;
else
{ int i;
for ( i = 0, newcount = 1 ; i < dim ; i++ )
{ newcount *= dims[i];
ex->array_spec.sizes[i] = dims[i];
}
}
if ( (newcount > 0) || (oldsize > web.sizes[e_type]) )
{ newsize = newcount*datatype_size[attr_type];
expand(e_type,oldsize + newsize);
}
strncpy(ex->name,name,ATTR_NAME_SIZE);
ex->type = attr_type;
ex->array_spec.datatype = attr_type;
ex->array_spec.itemsize = datatype_size[attr_type];
ex->offset = oldsize;
ex->array_spec.datacount = newcount;
ex->array_spec.dim = dim;
if ( dim > 0 ) ex->flags |= DIMENSIONED_ATTR;
if ( code ) ex->code = *code;
if ( dumpflag ) ex->flags |= DUMP_ATTR;
if ( stricmp(name,EXTRA_BDRY_NAME) == 0 )
{ extra_bdry_attr = web.skel[e_type].extra_count;
if ( ex->type != INTEGER_TYPE )
kb_error(2842,"Attribute extra_boundary must be of type integer.\n",
RECOVERABLE);
if ( e_type != VERTEX )
kb_error(2843,"Attribute extra_boundary should be vertex attribute.\n",
RECOVERABLE);
}
else if ( stricmp(name,EXTRA_BDRY_PARAM_NAME) == 0 )
{ extra_bdry_param_attr = web.skel[e_type].extra_count;
if ( ex->type != REAL_TYPE )
kb_error(3369,"Attribute extra_boundary_param must be of type real.\n",
RECOVERABLE);
if ( e_type != VERTEX )
kb_error(2845,
"Attribute extra_boundary_param should be vertex attribute.\n",
RECOVERABLE);
}
web.skel[e_type].extra_count++;
return web.skel[e_type].extra_count - 1; /* index */
}
/*************************************************************************
*
* function: expand_attribute()
*
* purpose: enlarge space for attribute of an element type
* or shrink it.
*/
void expand_attribute(e_type,attr_num,newsizes)
int e_type; /* VERTEX ,... */
int attr_num; /* number of attribute */
int *newsizes; /* new numbers of components, even for scalar */
{ int newsize;
int diff; /* difference between old and new total sizes */
struct extra *ex;
int chunksize,offset,available,needed;
int pointercount=0;
char *spot;
element_id id;
int k,d,n,dsize,dest,inx,blocksize;
char *temp=NULL; /* for shuffling higher dim entries */
ex = EXTRAS(e_type) + attr_num;
#ifdef MPI_EVOLVER
if ( this_task == MASTER_TASK )
{ struct mpi_command message;
int i;
message.cmd = mpi_EXPAND_ATTRIBUTE;
message.i = attr_num;
message.type = e_type;
message.count = ex->adim;
if ( ex->adim )
for (i = 0 ; i < ex->adim ; i++ )
message.data[i] = newsizes[i];
else message.data[0] = newsizes[0];
MPI_Bcast(&message,sizeof(struct mpi_command),MPI_BYTE,MASTER_TASK,
MPI_COMM_WORLD);
}
#endif
dsize = ex->array_spec.itemsize;
if ( ex->array_spec.dim == 0 ) newsize = newsizes[0];
else
{ pointercount = 1;
for ( newsize = 1, k = 0 ; k < ex->array_spec.dim ; k++ )
{ newsize *= newsizes[k];
if ( k < ex->array_spec.dim - 1 )
pointercount *= newsizes[k];
}
}
if ( (ex->array_spec.dim <= 1) && (newsize == ex->array_spec.datacount) )
return;
/* expand or contract space */
/* see how much extra space is needed */
if ( attr_num < web.skel[e_type].extra_count-1 )
available = ex[1].offset - ex[0].offset;
else available = web.sizes[e_type] - ex->offset;
needed = newsize*datatype_size[ex->type]+pointercount*sizeof(REAL*);
if ( ex->array_spec.dim >= 2 )
temp = (char*)temp_calloc(needed,1);
if ( needed > available )
{ /* expand */
/* check alignment of following fields */
diff = needed - available;
for ( k = attr_num+1 ; k < web.skel[e_type].extra_count ; k++ )
while ( diff % datatype_size[EXTRAS(e_type)[k].type] )
diff++;
expand(e_type,web.sizes[e_type] + diff);
/* move stuff above */
if ( attr_num < web.skel[e_type].extra_count-1 )
offset = EXTRAS(e_type)[attr_num+1].offset;
else offset = web.sizes[e_type] - diff;
chunksize = web.sizes[e_type] - offset - diff;
if ( chunksize || ( ex->array_spec.dim >= 2) )
{ element_id sentinel;
id = NULLID;
if ( web.skel[e_type].count > 0 )
while ( generate_all(e_type,&id,&sentinel) )
{
spot = (char*)elptr(id) + offset;
kb_memmove(spot + diff,spot,chunksize);
if ( ex->array_spec.dim >= 2 )
{ /* entry shuffle via temp */
char *old = (char*)elptr(id) + EXTRAS(e_type)[attr_num].offset;
for ( n = 0 ; n < ex->array_spec.datacount ; n++ )
{ /* figure out indices and new spot */
int oldinx = n;
for ( d = ex->array_spec.dim-1, dest = 0, blocksize = 1 ; d >= 0 ; d-- )
{ inx = oldinx % ex->array_spec.sizes[d];
if ( inx >= newsizes[d] ) goto skipentry;
dest += blocksize*inx;
blocksize *= newsizes[d];
oldinx = oldinx/ex->array_spec.sizes[d];
}
kb_memmove(temp+dest*dsize,old+n*dsize,dsize);
skipentry: ;
}
kb_memmove(old,temp,needed);
}
else
memset(spot,0,diff);
}
}
for ( k = attr_num+1 ; k < web.skel[e_type].extra_count ; k++ )
EXTRAS(e_type)[k].offset += diff;
}
else if ( needed < available )
{ /* maybe shrink */
/* check alignment of following fields */
diff = available - needed;
for ( k = attr_num+1 ; k < web.skel[e_type].extra_count ; k++ )
while ( diff % datatype_size[EXTRAS(e_type)[k].type] )
diff--;
/* move stuff above */
if ( attr_num < web.skel[e_type].extra_count-1 )
offset = EXTRAS(e_type)[attr_num+1].offset;
else offset = web.sizes[e_type];
chunksize = web.sizes[e_type] - offset;
if ( chunksize || (ex->array_spec.dim >= 2) )
{ element_id sentinel;
id = NULLID;
if ( web.skel[e_type].count > 0 )
while ( generate_all(e_type,&id,&sentinel) )
{
if ( ex->array_spec.dim >= 2 )
{ /* entry shuffle via temp */
char *old = (char*)elptr(id)+EXTRAS(e_type)[attr_num].offset;
for ( n = 0 ; n < ex->array_spec.datacount ; n++ )
{ /* figure out indices and new spot */
int oldinx = n;
for ( d = ex->array_spec.dim-1, dest = 0, blocksize = 1 ; d >= 0 ; d-- )
{ inx = oldinx % ex->array_spec.sizes[d];
if ( inx >= newsizes[d] ) goto skipentry2;
dest += blocksize*inx;
blocksize *= newsizes[d];
oldinx = oldinx/ex->array_spec.sizes[d];
}
kb_memmove(temp+dest*dsize,old+n*dsize,dsize);
skipentry2: ;
}
kb_memmove(old,temp,needed);
}
spot = (char*)elptr(id) + offset;
kb_memmove(spot - diff,spot,chunksize);
}
}
for ( k = attr_num+1 ; k < web.skel[e_type].extra_count ; k++ )
EXTRAS(e_type)[k].offset -= diff;
expand(e_type,web.sizes[e_type] - diff);
}
if ( ex->array_spec.dim >= 2 ) temp_free(temp);
ex->array_spec.datacount = newsize;
for ( n = 0 ; n < ex->array_spec.dim ; n++ )
ex->array_spec.sizes[n] = newsizes[n];
parallel_update_flag[e_type] = 1;
#ifdef MPI_EVOLVER
mpi_export_voffset = EXTRAS(VERTEX)[web.mpi_export_attr[VERTEX]].offset;
mpi_export_eoffset = EXTRAS(EDGE)[web.mpi_export_attr[EDGE]].offset;
mpi_export_foffset = EXTRAS(FACET)[web.mpi_export_attr[FACET]].offset;
mpi_export_boffset = EXTRAS(BODY)[web.mpi_export_attr[BODY]].offset;
mpi_export_feoffset =
EXTRAS(FACETEDGE)[web.mpi_export_attr[FACETEDGE]].offset;
#endif
}
/*************************************************************************
*
* function: find_attribute()
*
* purpose: find extra attribute by name, if it exists.
* return: index number if found, -1 if not.
*/
int find_attribute(etype,name)
int etype;
char *name;
{ struct extra *ex;
int n;
ex = EXTRAS(etype);
for ( n = 0 ; n < web.skel[etype].extra_count ; n++,ex++ )
if ( stricmp(ex->name,name) == 0 ) break;
if ( n == web.skel[etype].extra_count )
return -1;
return n;
}
/**************************************************************************
*
* function: find_extra()
*
* purpose: return index of named attribute, searching all element types.
* return -1 if not found.
*/
int find_extra(name,etype)
char *name;
int *etype; /* for returning element type */
{ int el_type,qnum,n;
struct extra *ex;
for ( el_type = VERTEX, qnum = -1 ; el_type <= FACETEDGE ; el_type++ )
{ ex = EXTRAS(el_type);
for ( n = 0 ; n < web.skel[el_type].extra_count ; n++,ex++ )
if ( stricmp(ex->name,name) == 0 )
{*etype = el_type;qnum = n;break;}
}
return qnum;
}
/***************************************************************************
Constraint handling routines
****************************************************************************/
/* Methodology:
Constraint map is array of conmap_t.
First entry is number of constraints.
Then follow constraint numbers, with high bit CON_HIT_BIT set
if constraint is hit.
Allocated as an extra attribute if needed.
*/
conmap_t nullcon[2]; /* default empty list */
void set_v_global(v_id)
vertex_id v_id;
{ int k;
for ( k = 0 ; k < web.con_global_count ; k++ )
set_v_constraint_map(v_id,web.con_global_map[k]);
}
void set_v_conmap(v_id,map)
vertex_id v_id;
conmap_t *map;
{ int k, m=(int)map[0];
for ( k = 1 ; k <= m ; k++ )
set_v_constraint_map(v_id,map[k]);
map = get_v_constraint_map(v_id);
if ( map[0] == 0 ) unset_attr(v_id,CONSTRAINT);
}
void set_e_conmap(e_id,map)
edge_id e_id;
conmap_t *map;
{ int k, m=(int)map[0];
for ( k = 1 ; k <= m ; k++ )
set_e_constraint_map(e_id,map[k]);
map = get_e_constraint_map(e_id);
if ( map[0] == 0 ) unset_attr(e_id,CONSTRAINT);
}
void set_f_conmap(f_id,map)
facet_id f_id;
conmap_t *map;
{ int k, m=(int)map[0];
for ( k = 1 ; k <= m ; k++ )
set_f_constraint_map(f_id,map[k]);
map = get_f_constraint_map(f_id);
if ( map[0] == 0 ) unset_attr(f_id,CONSTRAINT);
}
void set_v_constraint_map(v_id,n)
vertex_id v_id;
int n; /* constraint number */
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
struct constraint *constr;
int k,j;
int four = 4;
n &= CONMASK;
if ( maxcon == 0 )
expand_attribute(VERTEX,V_CONSTR_LIST_ATTR,&four);
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == ((conmap_t)n & CONMASK) ) return;
if ( k >= maxcon )
{ int newmax = maxcon+4;
expand_attribute(VERTEX,V_CONSTR_LIST_ATTR,&newmax);
map = get_v_constraint_map(v_id);
}
constr = get_constraint(n);
map[k] = (conmap_t)n;
if ( !(constr->attr & (NONPOSITIVE|NONNEGATIVE) ))
map[k] |= CON_HIT_BIT;
map[0]++; /* counter */
set_attr(v_id,CONSTRAINT);
if ( (constr->attr & CON_ENERGY) && (web.representation == STRING) )
{ set_attr(v_id, BDRY_ENERGY);
if ( everything_quantities_flag )
apply_method_num(v_id,constr->energy_method);
}
if ( (constr->attr & CON_CONTENT) && (web.representation == STRING) )
{
set_attr(v_id, BDRY_CONTENT);
if ( everything_quantities_flag )
{ edge_id e_id,first_e;
int max_rank,min_rank;
min_rank = MAXINT; max_rank = 0;
for ( j = 1 ; j <= (int)map[0] ; j++ )
{ struct constraint *c;
if ( !(map[j] & CON_HIT_BIT) ) continue;
c = get_constraint(map[j]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
first_e = e_id = get_vertex_edge(v_id);
if ( valid_id(e_id) && !(get_eattr(e_id) & NONCONTENT) )
do
{ char name[100];
body_id b_id;
facetedge_id first_fe,fe;
first_fe = fe = get_edge_fe(e_id);
if ( valid_id(fe) ) do
{ facet_id f_id = get_fe_facet(fe);
fe = get_next_facet(fe);
if ( !valid_id(f_id) ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) &&
( (!inverted(f_id) && constr->content_rank >= max_rank)
|| (inverted(f_id) && constr->content_rank <= min_rank)))
{ if ( constr->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,constr->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,n);
attach_method(get_body_volquant(b_id),name);
apply_method(inverse_id(v_id),name);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) &&
( (!inverted(f_id) && constr->content_rank >= max_rank)
|| (inverted(f_id) && constr->content_rank <= min_rank)) )
{ if ( constr->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,constr->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,n);
attach_method(get_body_volquant(b_id),name);
apply_method(v_id,name);
}
} while ( !equal_id(fe,first_fe) );
e_id = get_next_tail_edge(e_id);
} while ( !equal_id(first_e,e_id));
}
}
}
void unset_v_constraint_map(v_id,n)
vertex_id v_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k,j;
n &= CONMASK;
if ( maxcon == 0 ) return;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == (conmap_t)n ) break;
if ( k > (int)*map ) return;
map[0]--;
for ( j = k ; j <= (int)*map ; j++ ) map[j] = map[j+1];
map[j] = 0;
if ( map[0] == 0 ) unset_attr(v_id,CONSTRAINT);
if ( everything_quantities_flag )
{ struct constraint *con = get_constraint(n);
int i;
if ( con->attr & CON_ENERGY )
unapply_method(v_id,con->energy_method);
if ( con->attr & CON_CONTENT )
{ int meth_offset = get_meth_offset(VERTEX);
int *instlist = (int*)((char*)elptr(v_id) + meth_offset);
int mcount = elptr(v_id)->method_count;
for ( i = 0 ; i < mcount ; i++ )
if ( METH_INSTANCE(abs(instlist[i]))->connum == n )
unapply_method(v_id,instlist[i]);
}
}
}
int v_on_constraint(v_id,n)
vertex_id v_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return 0;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
return 1;
}
return 0;
}
int v_hit_constraint_count(v_id)
vertex_id v_id;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int count = 0;
int k;
if ( maxcon == 0 ) return 0;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CON_HIT_BIT) )
count++;
}
return count;
}
void get_v_common_conmap(v1,v2,conmap)
vertex_id v1,v2;
conmap_t *conmap;
{ conmap_t *map1 = get_v_constraint_map(v1);
unsigned int k;
conmap[0] = 0;
for ( k = 1; k <= map1[0] ; k++ )
if ( v_on_constraint(v2,map1[k]) )
conmap[++conmap[0]] = map1[k] & (conmap_t)CONMASK;
}
int get_v_constraint_status(v_id,n)
vertex_id v_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return 0;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
return (map[k] & CON_HIT_BIT) ? 1 : 0;
}
return 0;
}
void clear_v_conmap(v_id)
vertex_id v_id;
{ conmap_t *map = get_v_constraint_map(v_id);
unsigned int k;
for ( k = 1 ; k <= map[0] ; k++ )
map[k] = 0;
map[0] = 0;
}
void set_v_constraint_status(v_id,n)
vertex_id v_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
{ map[k] |= CON_HIT_BIT;
set_attr(v_id,HIT_WALL);
return;
}
}
}
void unset_v_constraint_status(v_id,n)
vertex_id v_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
{ map[k] &= ~CON_HIT_BIT;
return;
}
}
}
void clear_v_constraint_status(v_id)
vertex_id v_id;
{ conmap_t *map;
int maxcon = EXTRAS(VERTEX)[V_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
if ( maxcon == 0 ) return;
map = get_v_constraint_map(v_id);
for ( k = 1; k <= (int)*map ; k++ )
{ map[k] &= ~CON_HIT_BIT;
}
}
void set_e_constraint_map(e_id,n)
edge_id e_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(EDGE)[E_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
struct constraint *constr;
int four = 4;
n &= CONMASK;
if ( maxcon == 0 )
expand_attribute(EDGE,E_CONSTR_LIST_ATTR,&four);
map = get_e_constraint_map(e_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == (conmap_t)n ) return;
if ( k >= maxcon )
{ int newmax = maxcon+4;
expand_attribute(EDGE,E_CONSTR_LIST_ATTR,&newmax);
map = get_e_constraint_map(e_id);
}
map[k] = (conmap_t)n;
map[0]++; /* counter */
set_attr(e_id,CONSTRAINT);
constr = get_constraint(n);
if ( constr->attr & CON_ENERGY )
{ set_attr(e_id, BDRY_ENERGY);
if ( everything_quantities_flag )
apply_method_num(positive_id(e_id),constr->energy_method);
/* positive_id() to agree with old way */
}
if ( constr->attr & CON_CONTENT )
{ set_attr(e_id, BDRY_CONTENT); /* BIG PROBLEM HERE GETTING RIGHT BODY!!! */
if ( everything_quantities_flag )
{ facetedge_id fe,first_fe = get_edge_fe(e_id);
int min_rank, max_rank,j;
min_rank = MAXINT; max_rank = 0;
for ( j = 1 ; j <= (int)map[0] ; j++ )
{
struct constraint *c = get_constraint(map[j]);
if ( c->content_rank < min_rank ) min_rank = c->content_rank;
if ( c->content_rank > max_rank ) max_rank = c->content_rank;
}
fe = first_fe;
if ( valid_id(first_fe) )
do
{ char name[100];
body_id b_id;
facet_id f_id;
f_id = get_fe_facet(fe);
fe = get_next_facet(fe);
if ( !valid_id(f_id) ) continue;
if ( get_fattr(f_id) & NONCONTENT ) continue;
b_id = get_facet_body(f_id);
if ( valid_id(b_id) && (constr->content_rank >= max_rank))
{ if ( constr->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,constr->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,n);
attach_method(get_body_volquant(b_id),name);
apply_method(e_id,name);
}
b_id = get_facet_body(inverse_id(f_id));
if ( valid_id(b_id) && (constr->content_rank <= min_rank))
{ if ( constr->attr & NAMED_THING )
sprintf(name,"body_%d_%s_meth",ordinal(b_id)+1,constr->name);
else
sprintf(name,"body_%d_con_%d_meth",ordinal(b_id)+1,n);
attach_method(get_body_volquant(b_id),name);
apply_method(inverse_id(e_id),name);
}
} while ( !equal_id(fe,first_fe) );
}
}
}
int e_on_constraint(e_id,n)
edge_id e_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(EDGE)[E_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return 0;
map = get_e_constraint_map(e_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
return 1;
}
return 0;
}
void unset_e_constraint_map(e_id,n)
edge_id e_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(EDGE)[E_CONSTR_LIST_ATTR].array_spec.datacount;
int j,k;
n &= CONMASK;
if ( maxcon == 0 ) return;
map = get_e_constraint_map(e_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == (conmap_t)n ) break;
if ( k > (int)*map ) return;
map[0]--;
for ( j = k ; j <= (int)*map ; j++ ) map[j] = map[j+1];
map[j] = 0;
if ( map[0] == 0 ) unset_attr(e_id,CONSTRAINT);
if ( everything_quantities_flag )
{ struct constraint *con = get_constraint(n);
if ( con->attr & CON_ENERGY )
unapply_method(e_id,con->energy_method);
if ( con->attr & CON_CONTENT )
{ int meth_offset = get_meth_offset(EDGE);
int i;
int *instlist = (int*)((char*)elptr(e_id) + meth_offset);
int mcount = elptr(e_id)->method_count;
for ( i = 0 ; i < mcount ; i++ )
if ( METH_INSTANCE(abs(instlist[i]))->flags & BODY_INSTANCE )
unapply_method(e_id,instlist[i]);
}
}
}
void set_f_constraint_map(f_id,n)
facet_id f_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(FACET)[F_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
int four = 4;
n &= CONMASK; /* get rid of hit bit */
if ( maxcon == 0 )
expand_attribute(FACET,F_CONSTR_LIST_ATTR,&four);
map = get_f_constraint_map(f_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == (conmap_t)n ) return;
if ( k >= maxcon )
{ int newmax = maxcon+4;
expand_attribute(FACET,F_CONSTR_LIST_ATTR,&newmax);
map = get_f_constraint_map(f_id);
}
map[k] = (conmap_t)n;
map[0]++; /* counter */
}
int f_on_constraint(f_id,n)
facet_id f_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(FACET)[F_CONSTR_LIST_ATTR].array_spec.datacount;
int k;
n &= CONMASK;
if ( maxcon == 0 ) return 0;
map = get_f_constraint_map(f_id);
for ( k = 1; k <= (int)*map ; k++ )
{ if ( (map[k] & CONMASK) == (conmap_t)n )
return 1;
}
return 0;
}
void unset_f_constraint_map(f_id,n)
facet_id f_id;
int n;
{ conmap_t *map;
int maxcon = EXTRAS(FACET)[F_CONSTR_LIST_ATTR].array_spec.datacount;
int k,j;
n &= CONMASK;
if ( maxcon == 0 ) return;
map = get_f_constraint_map(f_id);
for ( k = 1; k <= (int)*map ; k++ )
if ( (map[k] & CONMASK) == (conmap_t)n ) break;
if ( k > (int)*map ) return;
map[0]--;
for ( j = k ; j <= (int)*map ; j++ ) map[j] = map[j+1];
map[j] = 0;
if ( map[0] == 0 ) unset_attr(f_id,CONSTRAINT);
if ( everything_quantities_flag )
{ struct constraint *con = get_constraint(n);
if ( con->attr & CON_ENERGY )
unapply_method(f_id,con->energy_method);
}
}
int get_tag(f_id)
facet_id f_id;
{ if ( F_TAG_ATTR == 0 ) return 0;
if ( EXTRAS(FACET)[F_TAG_ATTR].array_spec.datacount > 0 )
return (*FINT(f_id,F_TAG_ATTR));
else return 0;
}
void set_tag(f_id,t)
facet_id f_id;
int t;
{ int one=1;
if ( EXTRAS(FACET)[F_TAG_ATTR].array_spec.datacount == 0 )
expand_attribute(FACET,F_TAG_ATTR,&one);
*FINT(f_id,F_TAG_ATTR) = t;
}
evolver-2.30c.dfsg/src/method4.c 0000644 0001753 0001753 00000304605 11410765113 016735 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*********************************************************************
*
* file: method4.c
*
* contents: miscellaneous named methods
*/
#include "include.h"
/*****************************************************************
*
* function: johndust_energy()
*
* purpose: Energy request of John Sullivan, for point pairs on
* sphere. E = (pi - asin(d/2))/d, where d is chord distance.
*
*/
REAL johndust_energy(v_info)
struct qinfo *v_info;
{ vertex_id v_id;
int i;
REAL energy = 0.0;
REAL d,r[MAXCOORD];
REAL *x = get_coord(v_info->id);
FOR_ALL_VERTICES(v_id)
{ REAL *y = get_coord(v_id);
if ( v_id <= v_info->id ) continue; /* each pair once */
for ( i = 0 ; i < SDIM ; i++ ) r[i] = x[i] - y[i];
d = sqrt(SDIM_dot(r,r));
if ( d >= 2.0 ) energy += M_PI/4; /* antipodes */
else energy += (M_PI - asin(d/2))/d;
}
return energy;
}
/**************************************************************
*
* function: johndust_gradient()
*
* purpose: calculates energy of one vertex due to others
*
* input: info about vertex is in global qinfo structure.
*
*/
REAL johndust_gradient(v_info)
struct qinfo *v_info;
{ REAL *x = get_coord(v_info->id);
REAL energy = 0.0; /* for this vertex */
vertex_id v_id;
int i;
REAL r[MAXCOORD]; /* difference vector between vertices */
REAL d,p,dp;
for ( i = 0 ; i < SDIM ; i++ )
v_info->grad[0][i] = 0.0; /* intialize gradient */
FOR_ALL_VERTICES(v_id)
{ REAL *y = get_coord(v_id);
if ( equal_id(v_info->id,v_id) ) continue;
for ( i = 0 ; i < SDIM ; i++ ) r[i] = x[i] - y[i];
d = sqrt(SDIM_dot(r,r));
if ( d >= 2.0 ) continue; /* antipodes have no force */
p = (M_PI - asin(d/2))/d;
energy += p;
dp = -p/d - 0.5/d/sqrt(1 - d*d/4);
for ( i = 0 ; i < SDIM ; i++ )
v_info->grad[0][i] += dp/d*r[i];
}
return energy;
}
/******************************************************************************
String Gravity quantity stuff
******************************************************************************/
/***************************************************************
*
* function: string_gravity_init()
*
* purpose: initialization for gravity method
*/
void string_gravity_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
/* method modulus is gravitation constant */
if ( gravity_quantity_num >= 0 )
GEN_QUANT(gravity_quantity_num)->modulus =
web.gravflag ? web.grav_const : 0.0;
}
/**************************************************************
*
* function: string_gravity_all()
*
* purpose: calculates value, gradient, and hessian of one
* facet due to gravitational potential.
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_all_q ARGS((struct qinfo *,int));
REAL string_gravity_all_lagrange ARGS((struct qinfo *,int));
REAL get_edge_gdensity ARGS((edge_id));
REAL string_gravity_all ARGS((struct qinfo *,int));
REAL get_edge_gdensity(e_id)
edge_id e_id;
{ REAL gdensity;
facetedge_id fe,ffe;
facet_id f_id;
body_id b_id;
gdensity = 0.0;
fe = get_edge_fe(e_id);
f_id = get_fe_facet(fe);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
gdensity += get_body_density(b_id);
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
gdensity -= get_body_density(b_id);
ffe = get_next_facet(fe);
if ( !equal_id(fe,ffe) )
{ f_id = get_fe_facet(ffe);
b_id = get_facet_body(f_id);
if ( valid_id(b_id) )
gdensity += get_body_density(b_id);
b_id = get_facet_body(facet_inverse(f_id));
if ( valid_id(b_id) )
gdensity -= get_body_density(b_id);
}
return gdensity;
}
REAL string_gravity_all(e_info,mode)
struct qinfo *e_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
int i,j;
REAL jac; /* jacobian */
REAL sum = 0.0; /* quadratic z sum of facet */
REAL djdx[MAXCOORD],dsdz[MAXCOORD];
REAL c = 1/6.; /* coefficient */
REAL gdensity;
if ( web.modeltype == QUADRATIC ) return string_gravity_all_q(e_info,mode);
if ( web.modeltype == LAGRANGE )
return string_gravity_all_lagrange(e_info,mode);
gdensity = get_edge_gdensity(e_info->id);
if ( gdensity == 0.0 )
{
return 0.0;
}
c *= gdensity;
jac = -e_info->sides[0][0][0];
for ( i = 0 ; i < e_info->vcount ; i++ )
for ( j = 0 ; j <= i ; j++ )
sum += e_info->x[i][1]*e_info->x[j][1];
if ( mode == METHOD_VALUE ) return jac*sum*c;
djdx[0] = 1.0;
djdx[1] = -1.0;
dsdz[0] = 2*e_info->x[0][1]+e_info->x[1][1];
dsdz[1] = e_info->x[0][1]+2*e_info->x[1][1];
for ( i = 0 ; i < ctrl_num; i++ )
{ e_info->grad[i][0] = djdx[i]*sum*c;
e_info->grad[i][1] = dsdz[i]*jac*c;
}
if ( mode == METHOD_GRADIENT ) return jac*sum*c;
/* second partials, self */
for ( i = 0 ; i < ctrl_num; i++ )
{ e_info->hess[i][i][0][1] = e_info->hess[i][i][1][0] = djdx[i]*dsdz[i]*c;
e_info->hess[i][i][1][1] = 2*jac*c;
e_info->hess[i][i][0][0] = 0.0;
}
/* second partials, mixed */
for ( i = 0 ; i < ctrl_num ; i++ )
for ( j = 0 ; j < ctrl_num ; j++ )
{ if ( j == i ) continue;
e_info->hess[i][j][0][0] = 0.0;
e_info->hess[i][j][0][1] = djdx[i]*dsdz[j]*c;
e_info->hess[i][j][1][0] = djdx[j]*dsdz[i]*c;
e_info->hess[i][j][1][1] = jac*c;
}
return jac*sum*c;
}
/**************************************************************
*
* function: string_gravity_all_q()
*
* purpose: calculates value, gradient, and hessian of one
* facet due to gravitational potential. Quadratic model.
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_all_q(e_info,mode)
struct qinfo *e_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
int i,k,kk,m;
REAL **g=NULL,****h=NULL;
REAL value = 0.0;
REAL gdensity,w,z;
REAL tang,sum;
if ( mode == METHOD_GRADIENT )
{ g = e_info->grad;
}
else if ( mode == METHOD_HESSIAN )
{ g = e_info->grad;
h = e_info->hess;
}
gdensity = get_edge_gdensity(e_info->id);
if ( gdensity == 0.0 ) return 0.0;
for ( m = 0 ; m < gauss1D_num ; m++ )
{ z = e_info->gauss_pt[m][1];
w = gdensity*gauss1Dwt[m];
tang = 0.0;
for ( k = 0 ; k < edge_ctrl ; k++ )
tang += gauss1polyd[k][m]*e_info->x[k][0];
value += w*tang*(-z*z/2);
if ( mode == METHOD_VALUE ) continue;
sum = (-z)*tang;
for ( i = 0 ; i < edge_ctrl ; i++ )
{ g[i][0] += w*gauss1polyd[i][m]*(-z*z/2);
g[i][1] += w*gauss1poly[i][m]*sum;
}
if ( mode == METHOD_GRADIENT ) continue;
sum = -tang;
for ( k = 0 ; k < edge_ctrl ; k++ )
for ( kk = 0 ; kk < edge_ctrl ; kk++ )
{
h[k][kk][1][1] += w*sum*gauss1poly[k][m]*gauss1poly[kk][m];
h[k][kk][0][1] += w*gauss1polyd[k][m]*(-z)*gauss1poly[kk][m];
h[k][kk][1][0] += w*gauss1polyd[kk][m]*(-z)*gauss1poly[k][m];
}
}
return value;
}
/**************************************************************
*
* function: string_gravity_all_lagrange()
*
* purpose: calculates value, gradient, and hessian of one
* facet due to gravitational potential. Lagrange model.
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_all_lagrange(e_info,mode)
struct qinfo *e_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL gdensity;
REAL sum,y;
int m,i,k,kk;
REAL value = 0.0;
REAL val;
REAL tang;
REAL sign = (get_eattr(e_info->id) & NEGBOUNDARY) ? -1.0 : 1.0;
struct gauss_lag *gl = &gauss_lagrange[1][web.gauss1D_order];
gdensity = get_edge_gdensity(e_info->id);
if ( gdensity == 0.0 ) return 0.0;
for ( m = 0 ; m < gl->gnumpts ; m++ )
{ REAL weight = sign*gdensity*gl->gausswt[m];
tang = 0.0;
for ( k = 0 ; k < gl->lagpts ; k++ )
tang += gl->gpolypart[m][0][k]*e_info->x[k][0];
y = e_info->gauss_pt[m][1];
val = -y*y/2;
value += weight*val*tang;
if ( mode == METHOD_VALUE ) continue;
sum = -y*tang;
for ( i = 0 ; i < gl->lagpts ; i++ )
{ e_info->grad[i][0] += weight*gl->gpolypart[m][0][i]*val;
e_info->grad[i][1] += weight*gl->gpoly[m][i]*sum;
}
if ( mode == METHOD_GRADIENT ) continue;
sum = -tang;
for ( k = 0 ; k < gl->lagpts ; k++ )
for ( kk = 0 ; kk < gl->lagpts ; kk++ )
{ e_info->hess[k][kk][1][1] += weight*
sum*gl->gpoly[m][k]*gl->gpoly[m][kk];
e_info->hess[k][kk][0][1] += weight*
gl->gpolypart[m][0][k]*(-y)*gl->gpoly[m][kk];
e_info->hess[k][kk][1][0] += weight*
gl->gpolypart[m][0][kk]*(-y)*gl->gpoly[m][k];
}
}
return value;
}
/**************************************************************
*
* function: string_gravity_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_energy(e_info)
struct qinfo *e_info;
{
return string_gravity_all(e_info,METHOD_VALUE);
}
/**************************************************************
*
* function: string_gravity_grads()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_grads(e_info)
struct qinfo *e_info;
{
return string_gravity_all(e_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: string_gravity_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL string_gravity_hessian(e_info)
struct qinfo *e_info;
{
return string_gravity_all(e_info,METHOD_HESSIAN);
}
/*************************************************************************
Curvature rotated to binormal direction.
Localized Induction Equation.
For Ron Perline.
***************************************************************************/
void curvature_binormal_init(mode,mi)
int mode;
struct method_instance *mi;
{
}
REAL curvature_binormal_energy(v_info)
struct qinfo *v_info;
{ return 0.0;
}
REAL curvature_binormal_force(v_info)
struct qinfo *v_info;
{
vertex_id v_id = v_info->id;
edge_id e1,e2;
REAL s1[MAXCOORD],s2[MAXCOORD];
REAL l1,l2;
REAL denom;
int i;
int sign = 1; /* orientation correction */
e1 = get_vertex_edge(v_id);
e2 = get_next_tail_edge(e1);
if ( inverted(e1) ) { invert(e1); sign = -1; }
if ( inverted(e2) ) invert(e2);
get_edge_side(e1,s1);
get_edge_side(e2,s2);
cross_prod(s1,s2,v_info->grad[0]);
l1 = sqrt(SDIM_dot(s1,s1));
l2 = sqrt(SDIM_dot(s2,s2));
denom = sign*l1*l2*(l1+l2)/2;
for ( i = 0 ; i < SDIM ; i++ )
v_info->grad[0][i] /= denom;
return 0.0; /* energy */
}
/*************************************************************************
Various curve curvature quantities.
For Ron Perline.
***************************************************************************/
/**************************************************************************
quantity ddd_gamma_sq
Third deriv of curve position as function of arclength, squared.
****************************************************************************/
void ddd_gamma_sq_init(mode,mi)
int mode;
struct method_instance *mi;
{
}
REAL ddd_gamma_sq_energy(e_info)
struct qinfo *e_info;
{ REAL *side1,*side2,*side3;
REAL s1,s2,s3;
REAL dddgamma[MAXCOORD];
int i;
side1 = e_info->sides[0][1];
side2 = e_info->sides[0][0];
side3 = e_info->sides[0][2];
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s3 = sqrt(SDIM_dot(side3,side3));
for ( i = 0 ; i < SDIM ; i++ )
dddgamma[i] = side1[i]/s1/s2/(s2+s3)
- (side1[i]+side2[i])/s2/s3/(s1+s2)
+ (side1[i]+side2[i]+side3[i])/s3/(s2+s3)/(s1+s2+s3);
return 36*SDIM_dot(dddgamma,dddgamma)*s2;
}
REAL ddd_gamma_sq_gradient(e_info)
struct qinfo *e_info;
{ REAL *side1,*side2,*side3;
REAL s1,s2,s3;
REAL dddgamma[MAXCOORD];
REAL Ddddgamma[4][MAXCOORD][MAXCOORD];
REAL energy;
int i,j,k;
side1 = e_info->sides[0][1];
side2 = e_info->sides[0][0];
side3 = e_info->sides[0][2];
s1 = sqrt(SDIM_dot(side1,side1));
s2 = sqrt(SDIM_dot(side2,side2));
s3 = sqrt(SDIM_dot(side3,side3));
for ( i = 0 ; i < SDIM ; i++ )
dddgamma[i] = side1[i]/s1/s2/(s2+s3)
- (side1[i]+side2[i])/s2/s3/(s1+s2)
+ (side1[i]+side2[i]+side3[i])/s3/(s2+s3)/(s1+s2+s3);
energy = 36*SDIM_dot(dddgamma,dddgamma)*s2;
for ( k = 0 ; k < 4 ; k++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
Ddddgamma[k][i][j] = 0.0;
/* now the gradients on the four vertices */
/* recalling numbering order 2 0 1 3 */
for ( i = 0 ; i < SDIM ; i++ )
{
Ddddgamma[2][i][i] -= 1.0/s1/s2/(s2+s3) - 1.0/s2/s3/(s1+s2)
+ 1.0/s3/(s2+s3)/(s1+s2+s3);
Ddddgamma[0][i][i] += 1.0/s1/s2/(s2+s3) - 1.0/s2/s3/(s1+s2)
+ 1.0/s3/(s2+s3)/(s1+s2+s3);
Ddddgamma[0][i][i] -= -1/s2/s3/(s1+s2) + 1/s3/(s2+s3)/(s1+s2+s3);
Ddddgamma[1][i][i] += -1/s2/s3/(s1+s2) + 1/s3/(s2+s3)/(s1+s2+s3);
Ddddgamma[1][i][i] -= 1.0/s3/(s2+s3)/(s1+s2+s3);
Ddddgamma[3][i][i] += 1.0/s3/(s2+s3)/(s1+s2+s3);
for ( j = 0 ; j < SDIM ; j++ )
{ REAL d;
d = side1[i]/s1/s2/(s2+s3)*(-side1[j]/s1/s1)
- (side1[i]+side2[i])/s2/s3/(s1+s2)*(-side1[j]/s1/(s1+s2))
+ (side1[i]+side2[i]+side3[i])/s3/(s2+s3)/(s1+s2+s3)
*(-side1[j]/s1/(s1+s2+s3));
Ddddgamma[2][i][j] -= d;
Ddddgamma[0][i][j] += d;
d = side1[i]/s1/s2/(s2+s3)*(-side2[j]/s2/s2-side2[j]/s2/(s2+s3))
- (side1[i]+side2[i])/s2/s3/(s1+s2)*(-side2[j]/s2/s2-side2[j]/s2/(s1+s2))
+ (side1[i]+side2[i]+side3[i])/s3/(s2+s3)/(s1+s2+s3)*(-side2[j]/s2/(s2+s3)
- side2[j]/s2/(s1+s2+s3));
Ddddgamma[0][i][j] -= d;
Ddddgamma[1][i][j] += d;
d = side1[i]/s1/s2/(s2+s3)*(-side3[j]/s3/(s2+s3))
- (side1[i]+side2[i])/s2/s3/(s1+s2)*(-side3[j]/s3/s3)
+ (side1[i]+side2[i]+side3[i])/s3/(s2+s3)/(s1+s2+s3)
*(-side3[j]/s3/s3 - side3[j]/s3/(s2+s3) -side3[j]/s3/(s1+s2+s3));
Ddddgamma[1][i][j] -= d;
Ddddgamma[3][i][j] += d;
}
}
for ( k = 0 ; k < 4; k++ )
{ for ( j = 0 ; j < SDIM ; j++ )
{ REAL g;
for ( i = 0, g = 0.0 ; i < SDIM ; i++ )
g += 2*dddgamma[i]*Ddddgamma[k][i][j];
e_info->grad[k][j] = 36*g*s2;
}
}
for ( j = 0 ; j < SDIM ; j++ )
{ e_info->grad[0][j] -= energy*side2[j]/s2/s2;
e_info->grad[1][j] += energy*side2[j]/s2/s2;
}
return energy;
}
/*********************************************************************
Gap energy methods
**********************************************************************/
/*****************************************************************
*
* Function: gap_energy()
*
* Purpose: Calculate energy of kludge constraint force.
* Constant factor included to make it best approx
* of true area.
*/
REAL gap_energy(e_info)
struct qinfo *e_info;
{
edge_id e_id = e_info->id;
REAL sprenergy = 0.0;
REAL *s;
REAL ss;
struct constraint *constr[MAXCONPER];
int concount;
conmap_t * conmap;
int i,j;
if ( get_eattr(e_id) & FIXED ) return 0.0;
if ( !(get_eattr(e_id) & CONSTRAINT) ) return 0.0;
/* find which constraints have CONVEX attribute */
conmap = get_e_constraint_map(e_id);
for ( j = 1,i = 0 ; j <= (int)conmap[0] ; j++ )
{ constr[i] = get_constraint(conmap[j]);
if ( constr[i]->attr & B_CONVEX )
i++; /* keep this one */
}
if ( i == 0 ) return 0.0;
concount = i;
/* now the calculation */
s = e_info->sides[0][0];
ss = SDIM_dot(s,s);
for ( i = 0 ; i < concount ; i++ )
{ REAL *coord,ff,fs;
REAL fval,grad[MAXCOORD];
coord = e_info->x[0];
eval_all(constr[i]->formula,coord,SDIM,&fval,grad,e_id);
ff = SDIM_dot(grad,grad);
if ( ff <= 0.0 )
{ sprintf(errmsg,"Edge %s is on a CONVEX constraint at zero gradient.\n",
ELNAME(e_info->id));
kb_error(2148,errmsg,WARNING);
ff = 1.0;
}
fs = SDIM_dot(s,grad);
sprenergy += fabs(fs)*sqrt(ss/ff)/12;
coord = e_info->x[1];
eval_all(constr[i]->formula,coord,SDIM,&fval,grad,e_id);
ff = SDIM_dot(grad,grad);
if ( ff <= 0.0 )
{ sprintf(errmsg,"Edge %s is on a CONVEX constraint at zero gradient.\n",
ELNAME(e_info->id)+1);
kb_error(2149,errmsg,WARNING);
ff = 1.0;
}
fs = SDIM_dot(s,grad);
sprenergy += fabs(fs)*sqrt(ss/ff)/12;
}
sprenergy *= web.spring_constant;
return sprenergy;
}
/****************************************************************
*
* Function: gap_grads()
*
* Purpose: Since only vertices are actually confined to constraints,
* edges and faces supposedly on constraints can pull
* away from convex constraints, and in fact do, since
* a long edge short-cuts the constraints. To prevent
* this and encourage equal-length constraint edges, an
* energy penalty is inflicted for an edge angling away
* from its constraint.
* The energy penalty is 2/3 of the area of the right
* triangle whose base is half the side and whose hypoteneuse
* lies on the constraint tangent. This is done for both
* ends of the side.
*/
REAL gap_grads(e_info)
struct qinfo *e_info;
{
edge_id e_id = e_info->id;
REAL *s;
REAL ss; /* square lengths */
struct constraint *constr[MAXCONPER];
int concount;
conmap_t * conmap;
int i,j;
MAT2D(second,MAXCOORD,MAXCOORD); /* for second partials */
REAL sprenergy = 0.0;
if ( get_eattr(e_id) & FIXED ) return 0.0;
if ( !(get_eattr(e_id) & CONSTRAINT) ) return 0.0;
/* find which constraints have CONVEX attribute */
conmap = get_e_constraint_map(e_id);
for ( j = 1,i=0 ; j <= (int)conmap[0] ; j++ )
{
constr[i] = get_constraint(conmap[j]);
if ( constr[i]->attr & B_CONVEX ) i++; /* keep this one */
}
if ( i == 0 ) return 0.0;
concount = i;
/* now the calculation */
s = e_info->sides[0][0];
ss = SDIM_dot(s,s);
for ( i = 0 ; i < concount ; i++ )
{ REAL *coord;
REAL fval,grad[MAXCOORD];
REAL ff,fs,t;
coord = e_info->x[0];
eval_second(constr[i]->formula,coord,SDIM,&fval,grad,second,e_info->id);
ff = SDIM_dot(grad,grad);
if ( ff <= 0.0 ) ff = 1.0;
fs = SDIM_dot(s,grad);
t = sqrt(ss/ff);
sprenergy += fabs(fs)*sqrt(ss/ff)/12;
if ( fs < 0.0 ) t = -t; /* to take care of fabs() */
for ( j = 0 ; j < SDIM ; j++ )
{ REAL g;
g = -t*grad[j] + t*SDIM_dot(s,second[j])
+ fs/t*(-s[j]/ff - ss/ff/ff*SDIM_dot(grad,second[j]));
e_info->grad[0][j] += web.spring_constant*g/12;
g = t*grad[j] + fs/t/ff*s[j];
e_info->grad[1][j] += web.spring_constant*g/12;
}
coord = e_info->x[1];
eval_second(constr[i]->formula,coord,SDIM,&fval,grad,second,e_info->id);
ff = SDIM_dot(grad,grad);
if ( ff <= 0.0 ) ff = 1.0;
fs = SDIM_dot(s,grad);
sprenergy += fabs(fs)*sqrt(ss/ff)/12;
t = sqrt(ss/ff);
if ( fs < 0.0 ) t = -t; /* to take care of fabs() */
for ( j = 0 ; j < SDIM ; j++ )
{ REAL g;
g = t*grad[j] + t*SDIM_dot(s,second[j])
+ fs/t*(s[j]/ff - ss/ff/ff*SDIM_dot(grad,second[j]));
e_info->grad[1][j] += web.spring_constant*g/12;
g = -t*grad[j] - fs/t/ff*s[j];
e_info->grad[0][j] += web.spring_constant*g/12;
}
}
sprenergy *= web.spring_constant;
return sprenergy;
} /* end gap_grads() */
/***********************************************************************/
/************************************************************************
Named method: linear_elastic
Linear elastic strain energy on facets.
(for Frank Baginski's NASA balloon models)
Let S be Gram matrix of unstrained facet (dots of sides).
Let Q be the inverse of S.
Let F be Gram matrix of strained facet.
Let C = (FQ-I)/2, the Cauchy-Green strain tensor.
Let v be Poisson ratio.
Then energy density is
(1/2/(1+v))(Tr(C^2) + v*(Tr C)^2/(1-(dim-1)*v))
Each facet has extra attribute poisson_ratio and
extra attribute array form_factors[3] = {s11,s12,s22}
where sij = dot(si,sj) and s1 = (v1-v0), s2 = (v2-v0).
************************************************************************/
#define POISSON_NAME "poisson_ratio"
#define FORM_FACTORS_NAME "form_factors"
int poisson_attr; /* number of poisson_ratio extra attribute */
int form_factors_attr; /* number of form_factors extra attribute */
/***************************************************************
*
* function: linear_elastic_init()
*
* purpose: Make sure needed extra attributes are present.
*
*
*/
void linear_elastic_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2529,"linear_elastic method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(2150,"linear_elastic method only for SOAPFILM model.\n",
RECOVERABLE);
/* extra edge atribute */
poisson_attr = find_attribute(FACET,POISSON_NAME);
if ( poisson_attr < 0 ) /* not found */
kb_error(3200,"Facet extra attribute poisson_ratio missing. Needed by linear_elastic.\n",RECOVERABLE);
form_factors_attr = find_attribute(FACET,FORM_FACTORS_NAME);
if ( form_factors_attr < 0 ) /* not found */
kb_error(2152,"Facet extra attribute form_factors real[3] missing. Needed by linear_elastic.\n",RECOVERABLE);
if ( EXTRAS(FACET)[form_factors_attr].array_spec.datacount != 3 )
kb_error(2153,"Facet extra attribute form_factors must have size 3.\n",
RECOVERABLE);
}
/************************************************************************
*
* function: linear_elastic_all()
*
* purpose: energy, gradient, and hessian for linear_elastic method.
*/
REAL linear_elastic_all ARGS((struct qinfo *,int));
REAL linear_elastic_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL *s; /* pointer to extra attributes */
REAL **side;
REAL q11,q12,q22; /* Q entries */
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL poisson; /* poisson ratio */
REAL f11,f12,f22;
REAL c11,c12,c21,c22;
REAL energy;
REAL dc11dv[FACET_VERTS][MAXCOORD];
REAL dc12dv[FACET_VERTS][MAXCOORD];
REAL dc21dv[FACET_VERTS][MAXCOORD];
REAL dc22dv[FACET_VERTS][MAXCOORD];
REAL ddc11dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc12dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc21dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
REAL ddc22dv[FACET_VERTS][MAXCOORD][FACET_VERTS];
int i,j,ii,jj;
REAL coeff1,coeff2;
poisson = *(REAL*)get_extra(f_info->id,poisson_attr);
s = (REAL*)get_extra(f_info->id,form_factors_attr);
det = s[0]*s[2] - s[1]*s[1];
if ( det <= 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,"linear_elastic: Facet %s has unstrained area <= 0.\n",
ELNAME(f_info->id));
kb_error(2154,errmsg,RECOVERABLE);
}
area = sqrt(det)/2;
coeff1 = area/8/(1 + poisson);
coeff2 = coeff1*poisson/(1 - (web.dimension-1)*poisson);
q11 = s[2]/det; q12 = -s[1]/det; q22 = s[0]/det;
side = f_info->sides[0];
f11 = SDIM_dot(side[0],side[0]);
f12 = SDIM_dot(side[0],side[1]);
f22 = SDIM_dot(side[1],side[1]);
c11 = f11*q11 + f12*q12 - 1;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22 - 1;
energy = coeff1*(c11*c11+c12*c21+c12*c21+c22*c22)
+ coeff2*(c11+c22)*(c11+c22);
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < SDIM ; i++ )
{
dc11dv[1][i] = 2*side[0][i]*q11 + side[1][i]*q12;
dc11dv[2][i] = side[0][i]*q12;
dc12dv[1][i] = 2*side[0][i]*q12 + side[1][i]*q22;
dc12dv[2][i] = side[0][i]*q22;
dc21dv[1][i] = side[1][i]*q11;
dc21dv[2][i] = side[0][i]*q11 + 2*side[1][i]*q12;
dc22dv[1][i] = side[1][i]*q12;
dc22dv[2][i] = side[0][i]*q12 + 2*side[1][i]*q22;
dc11dv[0][i] = -(dc11dv[1][i] + dc11dv[2][i]);
dc12dv[0][i] = -(dc12dv[1][i] + dc12dv[2][i]);
dc21dv[0][i] = -(dc21dv[1][i] + dc21dv[2][i]);
dc22dv[0][i] = -(dc22dv[1][i] + dc22dv[2][i]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[j][i] = (coeff1*(2*c11*dc11dv[j][i]
+ 2*c12*dc21dv[j][i]
+ 2*c21*dc12dv[j][i]
+ 2*c22*dc22dv[j][i])
+ 2*coeff2*(c11+c22)*(dc11dv[j][i] +dc22dv[j][i]));
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
for ( i = 0 ; i < SDIM ; i++ )
{
ddc11dv[1][i][1] = 2*q11;
ddc11dv[1][i][2] = q12;
ddc11dv[2][i][1] = q12;
ddc11dv[2][i][2] = 0.0;
ddc12dv[1][i][1] = 2*q12;
ddc12dv[1][i][2] = q22;
ddc12dv[2][i][1] = q22;
ddc12dv[2][i][2] = 0.0;
ddc21dv[1][i][1] = 0.0;
ddc21dv[1][i][2] = q11;
ddc21dv[2][i][1] = q11;
ddc21dv[2][i][2] = 2*q12;
ddc22dv[1][i][1] = 0.0;
ddc22dv[1][i][2] = q12;
ddc22dv[2][i][1] = q12;
ddc22dv[2][i][2] = 2*q22;
for ( j = 1 ; j < FACET_VERTS; j++ )
{
ddc11dv[0][i][j] = -(ddc11dv[1][i][j] + ddc11dv[2][i][j]);
ddc12dv[0][i][j] = -(ddc12dv[1][i][j] + ddc12dv[2][i][j]);
ddc21dv[0][i][j] = -(ddc21dv[1][i][j] + ddc21dv[2][i][j]);
ddc22dv[0][i][j] = -(ddc22dv[1][i][j] + ddc22dv[2][i][j]);
ddc11dv[j][i][0] = -(ddc11dv[j][i][1] + ddc11dv[j][i][2]);
ddc12dv[j][i][0] = -(ddc12dv[j][i][1] + ddc12dv[j][i][2]);
ddc21dv[j][i][0] = -(ddc21dv[j][i][1] + ddc21dv[j][i][2]);
ddc22dv[j][i][0] = -(ddc22dv[j][i][1] + ddc22dv[j][i][2]);
}
ddc11dv[0][i][0] = -(ddc11dv[1][i][0] + ddc11dv[2][i][0]);
ddc12dv[0][i][0] = -(ddc12dv[1][i][0] + ddc12dv[2][i][0]);
ddc21dv[0][i][0] = -(ddc21dv[1][i][0] + ddc21dv[2][i][0]);
ddc22dv[0][i][0] = -(ddc22dv[1][i][0] + ddc22dv[2][i][0]);
}
for ( j = 0 ; j < FACET_VERTS ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
for ( jj = 0 ; jj < FACET_VERTS ; jj++ )
{
f_info->hess[j][jj][i][i] +=
(coeff1*( 2*c11*ddc11dv[j][i][jj]
+ 2*c12*ddc21dv[j][i][jj]
+ 2*c21*ddc12dv[j][i][jj]
+ 2*c22*ddc22dv[j][i][jj])
+ 2*coeff2*(c11+c22)*(ddc11dv[j][i][jj]+ddc22dv[j][i][jj]));
for ( ii = 0 ; ii < SDIM ; ii++ )
f_info->hess[j][jj][i][ii] +=
(coeff1*(2*dc11dv[jj][ii]*dc11dv[j][i]
+ 2*dc12dv[jj][ii]*dc21dv[j][i]
+ 2*dc21dv[jj][ii]*dc12dv[j][i]
+ 2*dc22dv[jj][ii]*dc22dv[j][i]
)
+ 2*coeff2*(dc11dv[jj][ii]+dc22dv[jj][ii])
*(dc11dv[j][i] +dc22dv[j][i]));
}
return energy;
}
/**************************************************************
*
* function: linear_elastic_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_energy(f_info)
struct qinfo *f_info;
{
return linear_elastic_all(f_info,METHOD_VALUE);
}
/**************************************************************
*
* function: linear_elastic_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_gradient(f_info)
struct qinfo *f_info;
{
return linear_elastic_all(f_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: linear_elastic_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_hessian(f_info)
struct qinfo *f_info;
{
return linear_elastic_all(f_info,METHOD_HESSIAN);
}
/************************************************************************
Named method: linear_elastic_B
Linear elastic strain energy on facets, with mobile reference
coordinates as two extra dimensions at each vertex. Hence 3D
balloon has to be set up as 5D surface. Does not use the
form_factors attribute of linear_elastic. Does use same poisson_ratio.
(for Frank Baginski's NASA balloon models)
Let S be Gram matrix of unstrained facet (dots of sides).
Let Q be the inverse of S.
Let F be Gram matrix of strained facet.
Let C = (FQ-I)/2, the Cauchy-Green strain tensor.
Let v be Poisson ratio.
Then energy density is
(1/2/(1+v))(Tr(C^2) + v*(Tr C)^2/(1-(dim-1)*v))
Each facet has extra attribute poisson_ratio.
************************************************************************/
#define POISSON_NAME "poisson_ratio"
#define FORM_FACTORS_NAME "form_factors"
#define LEBWEIGHT_NAME "LEBweight"
int LEBweight_attr; /* optional per-facet weight factor */
/************************************************************************
*
* function: linear_elastic_B_init()
*
* purpose: Make sure needed extra attributes are present.
*
*
*/
void linear_elastic_B_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2155,"linear_elastic_B method only for LINEAR model.\n",RECOVERABLE);
/* extra facet attribute for poisson_ratio */
poisson_attr = find_attribute(FACET,POISSON_NAME);
if ( poisson_attr < 0 ) /* not found */
kb_error(2156,"Facet extra attribute poisson_ratio missing. Needed by linear_elastic_B.\n",RECOVERABLE);
LEBweight_attr = find_attribute(FACET,LEBWEIGHT_NAME); /* optional */
if ( web.dimension != 2 )
kb_error(2157,"linear_elastic_B method only for SOAPFILM model.\n",RECOVERABLE);
}
/************************************************************************
*
* function: linear_elastic_B_all()
*
* purpose: energy, gradient, and hessian for linear_elastic_B method.
*/
REAL linear_elastic_B_all ARGS((struct qinfo *,int));
REAL linear_elastic_B_all(f_info,mode)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
{
REAL q11,q12,q22; /* Q entries */
REAL Q[2][2];
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL areasign; /* for reference area orientation */
REAL poisson; /* poisson ratio */
REAL f11,f12,f22;
REAL F[2][2];
REAL c11,c12,c21,c22;
REAL energy;
REAL stuff;
REAL dadv[FACET_VERTS][MAXCOORD];
REAL dstuff[FACET_VERTS][MAXCOORD];
REAL dCdv[2][2][FACET_VERTS][MAXCOORD];
REAL dFdv[2][2][FACET_VERTS][MAXCOORD];
REAL dQdv[2][2][FACET_VERTS][MAXCOORD];
REAL dSdv[2][2][FACET_VERTS][MAXCOORD];
REAL ddFdv[2][2][2][2];
REAL ddSdv[2][2][2][2];
REAL ddCdv[2][2][FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddQdv[2][2][FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddstuff[FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddadv[FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
int i,j,m,n,a,b,c,d,e;
REAL coeff1,coeff2;
REAL s[2][2]; /* form factors matrix */
int sdim = SDIM - web.dimension; /* true space dimension */
REAL combo; /* combination coeff for second edge orthogonality */
REAL weight; /* facet weighting factor */
REAL side[2][MAXCOORD];
poisson = *(REAL*)get_extra(f_info->id,poisson_attr);
if ( LEBweight_attr >= 0 )
weight = *(REAL*)get_extra(f_info->id,LEBweight_attr);
else weight = 1.0;
/* compute orthogonal second side */
for ( j = 0 ; j < 2 ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
side[j][i] = f_info->sides[0][j][i];
s[0][0] = dot(side[0]+sdim,side[0]+sdim,web.dimension); /* in ref */
if ( s[0][0] == 0.0 ) return 0.0;
s[0][1] = dot(side[0]+sdim,side[1]+sdim,web.dimension); /* in ref */
combo = s[0][1]/s[0][0];
for ( i = 0 ; i < SDIM ; i++ )
side[1][i] -= combo*side[0][i];
/* compute form factors */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < web.dimension ; j++ )
s[i][j] = dot(side[i]+sdim,side[j]+sdim,web.dimension);
det = s[0][0]*s[1][1] - s[0][1]*s[1][0];
if ( det <= 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,"linear_elastic_B: Facet %s has unstrained area 0.\n",
ELNAME(f_info->id));
kb_error(2158,errmsg,RECOVERABLE);
}
area = side[0][sdim]*side[1][sdim+1] - side[0][sdim+1]*side[1][sdim];
areasign = (area < 0.0) ? -0.5 : 0.5; /* triangle factor and orientation */
area *= areasign;
coeff1 = 1.0/8/(1 + poisson);
coeff2 = coeff1*poisson/(1 - (web.dimension-1)*poisson);
Q[0][0] = q11 = s[1][1]/det;
Q[0][1] = Q[1][0] = q12 = -s[0][1]/det;
Q[1][1] = q22 = s[0][0]/det;
F[0][0] = f11 = dot(side[0],side[0],sdim);
F[0][1] = F[1][0] = f12 = dot(side[0],side[1],sdim);
F[1][1] = f22 = dot(side[1],side[1],sdim);
c11 = f11*q11 + f12*q12 - 1;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22 - 1;
stuff = coeff1*(c11*c11+c12*c21+c12*c21+c22*c22)
+ coeff2*(c11+c22)*(c11+c22);
energy = weight*area*stuff;
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
dFdv[a][b][m][i] = (m==a ? side[b][i] : 0.0)
+ (m==b ? side[a][i] : 0.0);
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
dSdv[a][b][m][i] = (m==a ? side[b][i] : 0.0)
+ (m==b ? side[a][i] : 0.0);
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
for ( d = 0 ; d < web.dimension ; d++ )
sum -= Q[a][c]*dSdv[c][d][m][i]*Q[d][b];
dQdv[a][b][m][i] = sum;
}
}
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += dFdv[a][c][m][i]*Q[c][b];
dCdv[a][b][m][i] = sum;
}
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( e = 0 ; e < web.dimension ; e++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( b = 0 ; b < web.dimension ; b++ )
sum += F[a][b]*dQdv[b][e][m][i];
dCdv[a][e][m][i] = sum;
}
}
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dstuff[j][i] = (coeff1*(2*c11*dCdv[0][0][j][i]
+ 2*c12*dCdv[1][0][j][i]
+ 2*c21*dCdv[0][1][j][i]
+ 2*c22*dCdv[1][1][j][i])
+ 2*coeff2*(c11+c22)*(dCdv[0][0][j][i] +dCdv[1][1][j][i]));
}
/* reference area change */
for ( i = 0 ; i < SDIM ; i++ )
for ( a = 0 ; a < FACET_VERTS ; a++ ) dadv[a][i] = 0.0;
dadv[0][sdim] = side[1][sdim+1]*areasign;
dadv[1][sdim+1] = side[0][sdim]*areasign;
dadv[0][sdim+1] = -side[1][sdim]*areasign;
dadv[1][sdim] = -side[0][sdim+1]*areasign;
/* grand finale for gradient */
for ( a = 0 ; a < web.dimension ; a++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[a+1][i] = weight*(dadv[a][i]*stuff + area*dstuff[a][i]);
f_info->grad[0][i] -= weight*(dadv[a][i]*stuff + area*dstuff[a][i]);
}
/* combo correction */
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[1][i] -= combo*f_info->grad[2][i];
f_info->grad[0][i] += combo*f_info->grad[2][i];
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
/* calculate ddFdv and ddSdv, which are same and nonzero only for
like coordinates, so coordinate index not used */
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ ddFdv[a][b][m][n] = (a==m && b==n ? 1.0 : 0.0) + (a==n && b==m ? 1.0 : 0.0);
ddSdv[a][b][m][n] = (a==m && b==n ? 1.0 : 0.0) + (a==n && b==m ? 1.0 : 0.0);
}
/* calculate ddQdv */
for ( i = sdim ; i < SDIM ; i++ )
for ( j = sdim ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
for ( d = 0 ; d < web.dimension ; d++ )
sum += - dQdv[a][c][m][i]*dSdv[c][d][n][j]*Q[d][b]
- ( i==j ? Q[a][c]*ddSdv[c][d][m][n]*Q[d][b] : 0.0 )
- Q[a][c]*dSdv[c][d][m][i]*dQdv[d][b][n][j];
ddQdv[a][b][m][n][i][j] = sum;
}
/* calculate ddCdv */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += ( (i==j && i < sdim) ? ddFdv[a][c][m][n]*Q[c][b] : 0.0 )
+ ( (i < sdim && j >= sdim) ? dFdv[a][c][m][i]*dQdv[c][b][n][j] : 0.0)
+ ( (j < sdim && i >= sdim) ? dFdv[a][c][n][j]*dQdv[c][b][m][i] : 0.0)
+ ( (i >= sdim && j >= sdim) ? F[a][c]*ddQdv[c][b][m][n][i][j] : 0.0);
ddCdv[a][b][m][n][i][j] = sum;
}
}
/* calculate ddstuff */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term = (coeff1*( 2*c11*ddCdv[0][0][a][b][i][j]
+ 2*c12*ddCdv[1][0][a][b][i][j]
+ 2*c21*ddCdv[0][1][a][b][i][j]
+ 2*c22*ddCdv[1][1][a][b][i][j])
+ 2*coeff2*(c11+c22)*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j]))
+ (coeff1*(2*dCdv[0][0][a][i]*dCdv[0][0][b][j]
+ 2*dCdv[0][1][a][i]*dCdv[1][0][b][j]
+ 2*dCdv[1][0][a][i]*dCdv[0][1][b][j]
+ 2*dCdv[1][1][a][i]*dCdv[1][1][b][j]
)
+ 2*coeff2*(dCdv[0][0][a][i]+dCdv[1][1][a][i])
*(dCdv[0][0][b][j] +dCdv[1][1][b][j]));
ddstuff[a][b][i][j] = term;
}
/* area hessian */
for ( i = sdim ; i < SDIM ; i++ )
for ( j = sdim ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
ddadv[a][b][i][j] = 0.0;
ddadv[0][1][sdim][sdim+1] = areasign;
ddadv[1][0][sdim+1][sdim] = areasign;
ddadv[0][1][sdim+1][sdim] = -areasign;
ddadv[1][0][sdim][sdim+1] = -areasign;
/* big Hessian finale */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term =
( (i >= sdim && j >= sdim) ? ddadv[a][b][i][j]*stuff : 0.0)
+ dadv[a][i]*dstuff[b][j]
+ dadv[b][j]*dstuff[a][i]
+ area*ddstuff[a][b][i][j];
term *= weight;
f_info->hess[a+1][b+1][i][j] = term;
f_info->hess[a+1][0][i][j] -= term;
f_info->hess[0][b+1][i][j] -= term;
f_info->hess[0][0][i][j] += term;
}
/* combo correction */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL term;
term = combo*(combo*f_info->hess[2][2][i][j]-f_info->hess[1][2][i][j]
-f_info->hess[2][1][i][j]);
f_info->hess[1][1][i][j] += term;
f_info->hess[0][1][i][j] -= term;
f_info->hess[1][0][i][j] -= term;
f_info->hess[0][0][i][j] += term;
term = combo*f_info->hess[2][2][i][j];
f_info->hess[1][2][i][j] -= term;
f_info->hess[0][2][i][j] += term;
f_info->hess[1][0][i][j] += term;
f_info->hess[0][0][i][j] -= term;
term = combo*f_info->hess[2][2][i][j];
f_info->hess[2][1][i][j] -= term;
f_info->hess[0][1][i][j] += term;
f_info->hess[2][0][i][j] += term;
f_info->hess[0][0][i][j] -= term;
}
return energy;
}
/**************************************************************
*
* function: linear_elastic_B_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_B_energy(f_info)
struct qinfo *f_info;
{
return linear_elastic_B_all(f_info,METHOD_VALUE);
}
/**************************************************************
*
* function: linear_elastic_B_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_B_gradient(f_info)
struct qinfo *f_info;
{
return linear_elastic_B_all(f_info,METHOD_GRADIENT);
}
/**************************************************************
*
* function: linear_elastic_B_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL linear_elastic_B_hessian(f_info)
struct qinfo *f_info;
{
return linear_elastic_B_all(f_info,METHOD_HESSIAN);
}
/************************************************************************
*************************************************************************
Named method: relaxed_elastic
Linear elastic strain energy on facets, with mobile reference
coordinates as two extra dimensions at each vertex. Hence 3D
balloon has to be set up as 5D surface. Does not use the
form_factors attribute of linear_elastic. Does use same poisson_ratio.
Revised from linear_elastic_B to implement Bill Collier's
relaxed energy model. Basically, stress is set to 0 when stress
would be negative, to model wrinkling.
(for Frank Baginski's NASA balloon models)
Let S be Gram matrix of unstrained facet (dots of sides).
Let Q be the inverse of S.
Let F be Gram matrix of strained facet.
Let C = (FQ-I)/2, the Cauchy-Green strain tensor.
Let v be Poisson ratio.
Let eps1 and eps2 be the eigenvalues of C.
Let sigma1 = eps1+v*eps2 and sigma2 = eps2+v*eps1 be the stress
eigenvalues.
Then energy density is
(1/2/(1+v))(Tr(C^2) + v*(Tr C)^2/(1-(dim-1)*v)) sigma1,sigma2 >= 0
eps1^2/2 sigma2 < 0, eps1 > 0
eps2^2/2 sigma1 < 0, eps2 > 0
0 eps2 < 0, eps1 < 0.
Each facet has extra attribute poisson_ratio for v.
************************************************************************/
/************************************************************************
*
* function: relaxed_elastic_init()
*
* purpose: Make sure needed extra attributes are present.
*
*
*/
void relaxed_elastic_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2159,"relaxed_elastic method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(2160,"relaxed_elastic method only for SOAPFILM model.\n",RECOVERABLE);
/* extra facet attribute for poisson_ratio */
poisson_attr = find_attribute(FACET,POISSON_NAME);
if ( poisson_attr < 0 ) /* not found */
kb_error(2161,"Facet extra attribute poisson_ratio missing. Needed by relaxed_elastic.\n",RECOVERABLE);
LEBweight_attr = find_attribute(FACET,LEBWEIGHT_NAME); /* optional */
}
/************************************************************************
*
* function: relaxed_elastic_all()
*
* purpose: energy, gradient, and hessian for relaxed_elastic_method.
*/
REAL relaxed_elastic_all ARGS((struct qinfo *,int,int));
#define ONE_STRESS 1
#define TWO_STRESS 2
REAL relaxed_elastic_all(f_info,mode,part)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
int part; /* flag for one stress, two stress, or both parts */
{
REAL q11,q12,q22; /* Q entries */
REAL Q[2][2];
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL areasign; /* for reference area orientation */
REAL poisson; /* poisson ratio */
REAL f11,f12,f22;
REAL F[2][2];
REAL c11,c12,c21,c22;
REAL energy;
REAL stuff;
REAL dadv[FACET_VERTS][MAXCOORD];
REAL dstuff[FACET_VERTS][MAXCOORD];
REAL dCdv[2][2][FACET_VERTS][MAXCOORD];
REAL dFdv[2][2][FACET_VERTS][MAXCOORD];
REAL dQdv[2][2][FACET_VERTS][MAXCOORD];
REAL dSdv[2][2][FACET_VERTS][MAXCOORD];
REAL ddFdv[2][2][2][2];
REAL ddSdv[2][2][2][2];
REAL ddCdv[2][2][FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddQdv[2][2][FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddstuff[FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddadv[FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
int i,j,m,n,a,b,c,d,e;
REAL coeff1,coeff2;
REAL s[2][2]; /* form factors matrix */
int sdim = SDIM - web.dimension; /* true space dimension */
REAL combo; /* combination coeff for second edge orthogonality */
REAL weight; /* facet weighting factor */
REAL side[2][MAXCOORD];
REAL eps1,eps2; /* strain eigenvalues */
REAL TrC,DetC; /* trace and determinant of C */
poisson = *(REAL*)get_extra(f_info->id,poisson_attr);
if ( LEBweight_attr >= 0 )
weight = *(REAL*)get_extra(f_info->id,LEBweight_attr);
else weight = 1.0;
/* compute orthogonal second side */
for ( j = 0 ; j < 2 ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
side[j][i] = f_info->sides[0][j][i];
s[0][0] = dot(side[0]+sdim,side[0]+sdim,web.dimension); /* in ref */
if ( s[0][0] == 0.0 ) return 0.0;
s[0][1] = dot(side[0]+sdim,side[1]+sdim,web.dimension); /* in ref */
combo = s[0][1]/s[0][0];
for ( i = 0 ; i < SDIM ; i++ )
side[1][i] -= combo*side[0][i];
/* compute form factors */
for ( i = 0 ; i < web.dimension ; i++ )
for ( j = 0 ; j < web.dimension ; j++ )
s[i][j] = dot(side[i]+sdim,side[j]+sdim,web.dimension);
det = s[0][0]*s[1][1] - s[0][1]*s[1][0];
if ( det <= 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,"relaxed_elastic_ Facet %s has unstrained area 0.\n",
ELNAME(f_info->id));
kb_error(2162,errmsg,RECOVERABLE);
}
area = side[0][sdim]*side[1][sdim+1] - side[0][sdim+1]*side[1][sdim];
areasign = (area < 0.0) ? -0.5 : 0.5; /* triangle factor and orientation */
area *= areasign;
coeff1 = 1.0/8/(1 + poisson);
coeff2 = coeff1*poisson/(1 - (web.dimension-1)*poisson);
Q[0][0] = q11 = s[1][1]/det;
Q[0][1] = Q[1][0] = q12 = -s[0][1]/det;
Q[1][1] = q22 = s[0][0]/det;
F[0][0] = f11 = dot(side[0],side[0],sdim);
F[0][1] = F[1][0] = f12 = dot(side[0],side[1],sdim);
F[1][1] = f22 = dot(side[1],side[1],sdim);
c11 = f11*q11 + f12*q12 - 1;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22 - 1;
TrC = c11 + c22;
DetC = c11*c22 - c12*c21;
eps1 = (TrC + sqrt(TrC*TrC - 4*DetC))/2;
eps2 = (TrC - sqrt(TrC*TrC - 4*DetC))/2;
if ( eps1 <= 0.0 ) return 0.0; /* relaxed in both directions */
stuff = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
stuff = eps1*eps1/2/4; /* 1/4 fudge factor to agree with other */
}
else
{ /* stressed in both directions */
if ( part & TWO_STRESS )
stuff = coeff1*(c11*c11+c12*c21+c12*c21+c22*c22)
+ coeff2*(c11+c22)*(c11+c22);
}
energy = weight*area*stuff;
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
dFdv[a][b][m][i] = (m==a ? side[b][i] : 0.0)
+ (m==b ? side[a][i] : 0.0);
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
dSdv[a][b][m][i] = (m==a ? side[b][i] : 0.0)
+ (m==b ? side[a][i] : 0.0);
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
for ( d = 0 ; d < web.dimension ; d++ )
sum -= Q[a][c]*dSdv[c][d][m][i]*Q[d][b];
dQdv[a][b][m][i] = sum;
}
}
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += dFdv[a][c][m][i]*Q[c][b];
dCdv[a][b][m][i] = sum;
}
}
for ( i = sdim ; i < SDIM ; i++ ) /* with respect to ref coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( e = 0 ; e < web.dimension ; e++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( b = 0 ; b < web.dimension ; b++ )
sum += F[a][b]*dQdv[b][e][m][i];
dCdv[a][e][m][i] = sum;
}
}
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ ) dstuff[j][i] = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dstuff[j][i] = eps1*0.5/4*(dCdv[0][0][j][i]+dCdv[1][1][j][i]
+ 0.5/sqrt(TrC*TrC - 4*DetC)*(2*TrC*(dCdv[0][0][j][i]+dCdv[1][1][j][i])
- 4*(c11*dCdv[1][1][j][i] + dCdv[0][0][j][i]*c22
- c12*dCdv[1][0][j][i] - c21*dCdv[0][1][j][i])));
}
}
else /* stressed in both directions */
{
if ( part & TWO_STRESS )
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dstuff[j][i] = (coeff1*(2*c11*dCdv[0][0][j][i]
+ 2*c12*dCdv[1][0][j][i]
+ 2*c21*dCdv[0][1][j][i]
+ 2*c22*dCdv[1][1][j][i])
+ 2*coeff2*(c11+c22)*(dCdv[0][0][j][i] +dCdv[1][1][j][i]));
}
}
/* reference area change */
for ( i = 0 ; i < SDIM ; i++ )
for ( a = 0 ; a < FACET_VERTS ; a++ ) dadv[a][i] = 0.0;
dadv[0][sdim] = side[1][sdim+1]*areasign;
dadv[1][sdim+1] = side[0][sdim]*areasign;
dadv[0][sdim+1] = -side[1][sdim]*areasign;
dadv[1][sdim] = -side[0][sdim+1]*areasign;
/* grand finale for gradient */
for ( a = 0 ; a < web.dimension ; a++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[a+1][i] = weight*(dadv[a][i]*stuff + area*dstuff[a][i]);
f_info->grad[0][i] -= weight*(dadv[a][i]*stuff + area*dstuff[a][i]);
}
/* combo correction */
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[1][i] -= combo*f_info->grad[2][i];
f_info->grad[0][i] += combo*f_info->grad[2][i];
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
/* calculate ddFdv and ddSdv, which are same and nonzero only for
like coordinates, so coordinate index not used */
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ ddFdv[a][b][m][n] = (a==m && b==n ? 1.0 : 0.0) + (a==n && b==m ? 1.0 : 0.0);
ddSdv[a][b][m][n] = (a==m && b==n ? 1.0 : 0.0) + (a==n && b==m ? 1.0 : 0.0);
}
/* calculate ddQdv */
for ( i = sdim ; i < SDIM ; i++ )
for ( j = sdim ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
for ( d = 0 ; d < web.dimension ; d++ )
sum += - dQdv[a][c][m][i]*dSdv[c][d][n][j]*Q[d][b]
- ( i==j ? Q[a][c]*ddSdv[c][d][m][n]*Q[d][b] : 0.0 )
- Q[a][c]*dSdv[c][d][m][i]*dQdv[d][b][n][j];
ddQdv[a][b][m][n][i][j] = sum;
}
/* calculate ddCdv */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += ( (i==j && i < sdim) ? ddFdv[a][c][m][n]*Q[c][b] : 0.0 )
+ ( (i < sdim && j >= sdim) ? dFdv[a][c][m][i]*dQdv[c][b][n][j] : 0.0)
+ ( (j < sdim && i >= sdim) ? dFdv[a][c][n][j]*dQdv[c][b][m][i] : 0.0)
+ ( (i >= sdim && j >= sdim) ? F[a][c]*ddQdv[c][b][m][n][i][j] : 0.0);
ddCdv[a][b][m][n][i][j] = sum;
}
}
/* calculate ddstuff */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
ddstuff[a][b][i][j] = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL deps1a,deps1b,disc,ddisca,ddiscb,dddisc,ddeps;
REAL dTrCa,dTrCb,dDetCa,dDetCb;
dTrCa = dCdv[0][0][a][i]+dCdv[1][1][a][i];
dTrCb = dCdv[0][0][b][j]+dCdv[1][1][b][j];
dDetCa = c11*dCdv[1][1][a][i] + dCdv[0][0][a][i]*c22
- c12*dCdv[1][0][a][i] - c21*dCdv[0][1][a][i];
dDetCb = c11*dCdv[1][1][b][j] + dCdv[0][0][b][j]*c22
- c12*dCdv[1][0][b][j] - c21*dCdv[0][1][b][j];
disc = TrC*TrC - 4*DetC;
ddisca = 2*TrC*dTrCa - 4*dDetCa;
ddiscb = 2*TrC*dTrCb - 4*dDetCb;
deps1a = (dTrCa + 0.5/sqrt(disc)*ddisca)/2;
deps1b = (dTrCb + 0.5/sqrt(disc)*ddiscb)/2;
dddisc = 2*dTrCa*dTrCb +
+ 2*TrC*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j])
- 4*(dCdv[0][0][b][j]*dCdv[1][1][a][i] + dCdv[0][0][a][i]*dCdv[1][1][b][j]
- dCdv[0][1][b][j]*dCdv[1][0][a][i] - dCdv[1][0][b][j]*dCdv[0][1][a][i])
- 4*(c11*ddCdv[1][1][a][b][i][j] + ddCdv[0][0][a][b][i][j]*c22
- c12*ddCdv[1][0][a][b][i][j] - c21*ddCdv[0][1][a][b][i][j]);
ddeps = 0.5*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j]
-.25/sqrt(disc)/disc*ddisca*ddiscb + 0.5/sqrt(disc)*dddisc);
ddstuff[a][b][i][j] = (deps1a*deps1b + eps1*ddeps)/4;
}
}
else
{
if ( part & TWO_STRESS )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term = (coeff1*( 2*c11*ddCdv[0][0][a][b][i][j]
+ 2*c12*ddCdv[1][0][a][b][i][j]
+ 2*c21*ddCdv[0][1][a][b][i][j]
+ 2*c22*ddCdv[1][1][a][b][i][j])
+ 2*coeff2*(c11+c22)*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j]))
+ (coeff1*(2*dCdv[0][0][a][i]*dCdv[0][0][b][j]
+ 2*dCdv[0][1][a][i]*dCdv[1][0][b][j]
+ 2*dCdv[1][0][a][i]*dCdv[0][1][b][j]
+ 2*dCdv[1][1][a][i]*dCdv[1][1][b][j]
)
+ 2*coeff2*(dCdv[0][0][a][i]+dCdv[1][1][a][i])
*(dCdv[0][0][b][j] +dCdv[1][1][b][j]));
ddstuff[a][b][i][j] = term;
}
}
/* area hessian */
for ( i = sdim ; i < SDIM ; i++ )
for ( j = sdim ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
ddadv[a][b][i][j] = 0.0;
ddadv[0][1][sdim][sdim+1] = areasign;
ddadv[1][0][sdim+1][sdim] = areasign;
ddadv[0][1][sdim+1][sdim] = -areasign;
ddadv[1][0][sdim][sdim+1] = -areasign;
/* big Hessian finale */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term =
( (i >= sdim && j >= sdim) ? ddadv[a][b][i][j]*stuff : 0.0)
+ dadv[a][i]*dstuff[b][j]
+ dadv[b][j]*dstuff[a][i]
+ area*ddstuff[a][b][i][j];
term *= weight;
f_info->hess[a+1][b+1][i][j] = term;
f_info->hess[a+1][0][i][j] -= term;
f_info->hess[0][b+1][i][j] -= term;
f_info->hess[0][0][i][j] += term;
}
/* combo correction */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
{ REAL term;
term = combo*(combo*f_info->hess[2][2][i][j]-f_info->hess[1][2][i][j]
-f_info->hess[2][1][i][j]);
f_info->hess[1][1][i][j] += term;
f_info->hess[0][1][i][j] -= term;
f_info->hess[1][0][i][j] -= term;
f_info->hess[0][0][i][j] += term;
term = combo*f_info->hess[2][2][i][j];
f_info->hess[1][2][i][j] -= term;
f_info->hess[0][2][i][j] += term;
f_info->hess[1][0][i][j] += term;
f_info->hess[0][0][i][j] -= term;
term = combo*f_info->hess[2][2][i][j];
f_info->hess[2][1][i][j] -= term;
f_info->hess[0][1][i][j] += term;
f_info->hess[2][0][i][j] += term;
f_info->hess[0][0][i][j] -= term;
}
return energy;
}
/**************************************************************
*
* function: relaxed_elastic_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_energy(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_all(f_info,METHOD_VALUE,ONE_STRESS|TWO_STRESS);
}
/**************************************************************
*
* function: relaxed_elastic_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_gradient(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_all(f_info,METHOD_GRADIENT,ONE_STRESS|TWO_STRESS);
}
/**************************************************************
*
* function: relaxed_elastic_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_hessian(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_all(f_info,METHOD_HESSIAN,ONE_STRESS|TWO_STRESS);
}
/* Partial relaxed energy methods */
REAL relaxed_elastic1_energy(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_VALUE,ONE_STRESS); }
REAL relaxed_elastic1_gradient(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_GRADIENT,ONE_STRESS); }
REAL relaxed_elastic1_hessian(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_HESSIAN,ONE_STRESS); }
REAL relaxed_elastic2_energy(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_VALUE,TWO_STRESS); }
REAL relaxed_elastic2_gradient(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_GRADIENT,TWO_STRESS); }
REAL relaxed_elastic2_hessian(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_all(f_info,METHOD_HESSIAN,TWO_STRESS); }
/************************************************************************
*************************************************************************
Named method: relaxed_elastic_A
Linear elastic strain energy on facets, with fixed reference
coordinates manifested as form_factors for each facet.
This allows more flexibility in reference coordinates assigned
to vertices that are taped together.
Revised from linear_elastic to implement Bill Collier's
relaxed energy model. Basically, stress is set to 0 when stress
would be negative, to model wrinkling.
(for Frank Baginski's NASA balloon models)
Let S be Gram matrix of unstrained facet (form_factors, dots of sides).
Let Q be the inverse of S.
Let F be Gram matrix of strained facet.
Let C = (FQ-I)/2, the Cauchy-Green strain tensor.
Let v be Poisson ratio.
Let eps1 and eps2 be the eigenvalues of C.
Let sigma1 = eps1+v*eps2 and sigma2 = eps2+v*eps1 be the stress
eigenvalues.
Then energy density is
(1/2/(1+v))(Tr(C^2) + v*(Tr C)^2/(1-(dim-1)*v)) sigma1,sigma2 >= 0
eps1^2/2 sigma2 < 0, eps1 > 0
eps2^2/2 sigma1 < 0, eps2 > 0
0 eps2 < 0, eps1 < 0.
Each facet has extra attribute poisson_ratio for v.
************************************************************************/
/************************************************************************
*
* function: relaxed_elastic_A_init()
*
* purpose: Make sure needed extra attributes are present.
*
*
*/
void relaxed_elastic_A_init(mode,mi)
int mode; /* energy or gradient */
struct method_instance *mi;
{
if ( web.modeltype != LINEAR )
kb_error(2163,"relaxed_elastic_A method only for LINEAR model.\n",RECOVERABLE);
if ( web.dimension != 2 )
kb_error(2164,"relaxed_elastic_A method only for SOAPFILM model.\n",RECOVERABLE);
/* extra facet attribute for poisson_ratio */
poisson_attr = find_attribute(FACET,POISSON_NAME);
if ( poisson_attr < 0 ) /* not found */
kb_error(2165,"Facet extra attribute poisson_ratio missing. Needed by relaxed_elastic_A.\n",RECOVERABLE);
form_factors_attr = find_attribute(FACET,FORM_FACTORS_NAME);
if ( form_factors_attr < 0 ) /* not found */
kb_error(2166,"Facet extra attribute form_factors real[3] missing. Needed by relaxed_elastic_A.\n",RECOVERABLE);
if ( EXTRAS(FACET)[form_factors_attr].array_spec.datacount != 3 )
kb_error(2167,"Facet extra attribute form_factors must have size 3.\n",
RECOVERABLE);
LEBweight_attr = find_attribute(FACET,LEBWEIGHT_NAME); /* optional */
}
/************************************************************************
*
* function: relaxed_elastic_A_all()
*
* purpose: energy, gradient, and hessian for relaxed_elastic_A_method.
*/
REAL relaxed_elastic_A_all ARGS((struct qinfo *,int,int));
#define ONE_STRESS 1
#define TWO_STRESS 2
REAL relaxed_elastic_A_all(f_info,mode,part)
struct qinfo *f_info;
int mode; /* METHOD_VALUE, METHOD_GRADIENT, or METHOD_HESSIAN */
int part; /* flag for one stress, two stress, or both parts */
{
REAL q11,q12,q22; /* Q entries */
REAL Q[2][2];
REAL det; /* det S */
REAL area; /* reference area of facet */
REAL poisson; /* poisson ratio */
REAL f11,f12,f22;
REAL c11,c12,c21,c22;
REAL energy;
REAL stuff;
REAL dstuff[FACET_VERTS][MAXCOORD];
REAL dCdv[2][2][FACET_VERTS][MAXCOORD];
REAL dFdv[2][2][FACET_VERTS][MAXCOORD];
REAL ddFdv[2][2][2][2];
REAL ddCdv[2][2][FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
REAL ddstuff[FACET_VERTS][FACET_VERTS][MAXCOORD][MAXCOORD];
int i,j,m,n,a,b,c;
REAL coeff1,coeff2;
REAL *s; /* form factors */
int sdim = SDIM; /* true space dimension */
REAL weight; /* facet weighting factor */
REAL **side; /* sides of facet */
REAL eps1,eps2; /* strain eigenvalues */
REAL TrC,DetC; /* trace and determinant of C */
poisson = *(REAL*)get_extra(f_info->id,poisson_attr);
if ( LEBweight_attr >= 0 )
weight = *(REAL*)get_extra(f_info->id,LEBweight_attr);
else weight = 1.0;
s = (REAL*)get_extra(f_info->id,form_factors_attr);
det = s[0]*s[2] - s[1]*s[1];
if ( det <= 0.0 )
{ if ( mode == METHOD_VALUE ) return 0.0;
sprintf(errmsg,"relaxed_elastic_A: Facet %s has unstrained area 0.\n",
ELNAME(f_info->id));
kb_error(2168,errmsg,RECOVERABLE);
}
area = sqrt(det)/2;
coeff1 = 1.0/8/(1 + poisson);
coeff2 = coeff1*poisson/(1 - (web.dimension-1)*poisson);
Q[0][0] = q11 = s[2]/det;
Q[0][1] = Q[1][0] = q12 = -s[1]/det;
Q[1][1] = q22 = s[0]/det;
side = f_info->sides[0];
f11 = dot(side[0],side[0],sdim);
f12 = dot(side[0],side[1],sdim);
f22 = dot(side[1],side[1],sdim);
c11 = f11*q11 + f12*q12 - 1;
c12 = f11*q12 + f12*q22;
c21 = f12*q11 + f22*q12;
c22 = f12*q12 + f22*q22 - 1;
TrC = c11 + c22;
DetC = c11*c22 - c12*c21;
eps1 = (TrC + sqrt(TrC*TrC - 4*DetC))/2;
eps2 = (TrC - sqrt(TrC*TrC - 4*DetC))/2;
if ( eps1 <= 0.0 ) return 0.0; /* relaxed in both directions */
stuff = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
stuff = eps1*eps1/2/4; /* 1/4 fudge factor to agree with other */
}
else
{ /* stressed in both directions */
if ( part & TWO_STRESS )
stuff = coeff1*(c11*c11+c12*c21+c12*c21+c22*c22)
+ coeff2*(c11+c22)*(c11+c22);
}
energy = weight*area*stuff;
if ( mode == METHOD_VALUE ) return energy;
/* gradient */
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
dFdv[a][b][m][i] = (m==a ? side[b][i] : 0.0)
+ (m==b ? side[a][i] : 0.0);
}
for ( i = 0 ; i < sdim ; i++ ) /* with respect to space coord */
{
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += dFdv[a][c][m][i]*Q[c][b];
dCdv[a][b][m][i] = sum;
}
}
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ ) dstuff[j][i] = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dstuff[j][i] = eps1*0.5/4*(dCdv[0][0][j][i]+dCdv[1][1][j][i]
+ 0.5/sqrt(TrC*TrC - 4*DetC)*(2*TrC*(dCdv[0][0][j][i]+dCdv[1][1][j][i])
- 4*(c11*dCdv[1][1][j][i] + dCdv[0][0][j][i]*c22
- c12*dCdv[1][0][j][i] - c21*dCdv[0][1][j][i])));
}
}
else /* stressed in both directions */
{
if ( part & TWO_STRESS )
for ( j = 0 ; j < web.dimension ; j++ )
for ( i = 0 ; i < SDIM ; i++ )
{ dstuff[j][i] = (coeff1*(2*c11*dCdv[0][0][j][i]
+ 2*c12*dCdv[1][0][j][i]
+ 2*c21*dCdv[0][1][j][i]
+ 2*c22*dCdv[1][1][j][i])
+ 2*coeff2*(c11+c22)*(dCdv[0][0][j][i] +dCdv[1][1][j][i]));
}
}
/* grand finale for gradient */
for ( a = 0 ; a < web.dimension ; a++ )
for ( i = 0 ; i < SDIM ; i++ )
{ f_info->grad[a+1][i] = weight*area*dstuff[a][i];
f_info->grad[0][i] -= weight*area*dstuff[a][i];
}
if ( mode == METHOD_GRADIENT ) return energy;
/* hessian */
/* calculate ddFdv */
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ ddFdv[a][b][m][n] =
(a==m && b==n ? 1.0 : 0.0) + (a==n && b==m ? 1.0 : 0.0);
}
/* calculate ddCdv */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{
for ( m = 0 ; m < web.dimension ; m++ )
for ( n = 0 ; n < web.dimension ; n++ )
{ REAL sum = 0.0;
for ( c = 0 ; c < web.dimension ; c++ )
sum += ( i==j ? ddFdv[a][c][m][n]*Q[c][b] : 0.0 );
ddCdv[a][b][m][n][i][j] = sum;
}
}
/* calculate ddstuff */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
ddstuff[a][b][i][j] = 0.0;
if ( eps2 + poisson*eps1 <= 0.0 )
{ /* relaxed in one dimension */
if ( part & ONE_STRESS )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL deps1a,deps1b,disc,ddisca,ddiscb,dddisc,ddeps;
REAL dTrCa,dTrCb,dDetCa,dDetCb;
dTrCa = dCdv[0][0][a][i]+dCdv[1][1][a][i];
dTrCb = dCdv[0][0][b][j]+dCdv[1][1][b][j];
dDetCa = c11*dCdv[1][1][a][i] + dCdv[0][0][a][i]*c22
- c12*dCdv[1][0][a][i] - c21*dCdv[0][1][a][i];
dDetCb = c11*dCdv[1][1][b][j] + dCdv[0][0][b][j]*c22
- c12*dCdv[1][0][b][j] - c21*dCdv[0][1][b][j];
disc = TrC*TrC - 4*DetC;
ddisca = 2*TrC*dTrCa - 4*dDetCa;
ddiscb = 2*TrC*dTrCb - 4*dDetCb;
deps1a = (dTrCa + 0.5/sqrt(disc)*ddisca)/2;
deps1b = (dTrCb + 0.5/sqrt(disc)*ddiscb)/2;
dddisc = 2*dTrCa*dTrCb +
+ 2*TrC*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j])
- 4*(dCdv[0][0][b][j]*dCdv[1][1][a][i] + dCdv[0][0][a][i]*dCdv[1][1][b][j]
- dCdv[0][1][b][j]*dCdv[1][0][a][i] - dCdv[1][0][b][j]*dCdv[0][1][a][i])
- 4*(c11*ddCdv[1][1][a][b][i][j] + ddCdv[0][0][a][b][i][j]*c22
- c12*ddCdv[1][0][a][b][i][j] - c21*ddCdv[0][1][a][b][i][j]);
ddeps = 0.5*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j]
-.25/sqrt(disc)/disc*ddisca*ddiscb + 0.5/sqrt(disc)*dddisc);
ddstuff[a][b][i][j] = (deps1a*deps1b + eps1*ddeps)/4;
}
}
else
{
if ( part & TWO_STRESS )
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term = (coeff1*( 2*c11*ddCdv[0][0][a][b][i][j]
+ 2*c12*ddCdv[1][0][a][b][i][j]
+ 2*c21*ddCdv[0][1][a][b][i][j]
+ 2*c22*ddCdv[1][1][a][b][i][j])
+ 2*coeff2*(c11+c22)*(ddCdv[0][0][a][b][i][j]+ddCdv[1][1][a][b][i][j]))
+ (coeff1*(2*dCdv[0][0][a][i]*dCdv[0][0][b][j]
+ 2*dCdv[0][1][a][i]*dCdv[1][0][b][j]
+ 2*dCdv[1][0][a][i]*dCdv[0][1][b][j]
+ 2*dCdv[1][1][a][i]*dCdv[1][1][b][j]
)
+ 2*coeff2*(dCdv[0][0][a][i]+dCdv[1][1][a][i])
*(dCdv[0][0][b][j] +dCdv[1][1][b][j]));
ddstuff[a][b][i][j] = term;
}
}
/* big Hessian finale */
for ( i = 0 ; i < SDIM ; i++ )
for ( j = 0 ; j < SDIM ; j++ )
for ( a = 0 ; a < web.dimension ; a++ )
for ( b = 0 ; b < web.dimension ; b++ )
{ REAL term;
term = area*ddstuff[a][b][i][j];
term *= weight;
f_info->hess[a+1][b+1][i][j] = term;
f_info->hess[a+1][0][i][j] -= term;
f_info->hess[0][b+1][i][j] -= term;
f_info->hess[0][0][i][j] += term;
}
return energy;
}
/**************************************************************
*
* function: relaxed_elastic_A_energy()
*
* purpose: calculates energy of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_A_energy(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_A_all(f_info,METHOD_VALUE,ONE_STRESS|TWO_STRESS);
}
/**************************************************************
*
* function: relaxed_elastic_A_gradient()
*
* purpose: calculates gradient of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_A_gradient(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_A_all(f_info,METHOD_GRADIENT,ONE_STRESS|TWO_STRESS);
}
/**************************************************************
*
* function: relaxed_elastic_A_hessian()
*
* purpose: calculates hessian of one facet due to potential
*
* input: info about vertex is in qinfo structure.
*
*/
REAL relaxed_elastic_A_hessian(f_info)
struct qinfo *f_info;
{
return relaxed_elastic_A_all(f_info,METHOD_HESSIAN,ONE_STRESS|TWO_STRESS);
}
/* Partial relaxed energy methods */
REAL relaxed_elastic1_A_energy(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_VALUE,ONE_STRESS); }
REAL relaxed_elastic1_A_gradient(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_GRADIENT,ONE_STRESS); }
REAL relaxed_elastic1_A_hessian(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_HESSIAN,ONE_STRESS); }
REAL relaxed_elastic2_A_energy(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_VALUE,TWO_STRESS); }
REAL relaxed_elastic2_A_gradient(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_GRADIENT,TWO_STRESS); }
REAL relaxed_elastic2_A_hessian(f_info)
struct qinfo *f_info;
{ return relaxed_elastic_A_all(f_info,METHOD_HESSIAN,TWO_STRESS); }
/***************************************************************************
****************************************************************************
Named Method dihedral_hooke
Energy is edge length times square of angle between normals of adjacent
facets. Actually, e = (1 - cos(angle))*length.
***************************************************************************/
/********************************************************************
*
* Function: dihedral_hooke_energy()
*
* Purpose: Does energy calculation for an edge.
*
*/
REAL dihedral_hooke_energy(e_info)
struct qinfo *e_info;
{
REAL s1[MAXCOORD],s2[MAXCOORD],t2[MAXCOORD];
REAL s1s1,s1s2,s1t2,s2s2,t2t2,s2t2;
REAL a1,a2;
REAL det;
facetedge_id fe_s1,fe_s2,fe_t2;
edge_id e_id = e_info->id;
REAL cos_th; /* cosine of angle between facets */
/* get edge vectors away from tail vertex */
fe_s1 = get_edge_fe(e_id);
fe_s2 = get_prev_edge(get_next_facet(fe_s1));
fe_s2 = inverse_id(fe_s2);
fe_t2 = get_prev_edge(fe_s1);
fe_t2 = inverse_id(fe_t2);
get_fe_side(fe_s1,s1);
get_fe_side(fe_s2,s2);
get_fe_side(fe_t2,t2);
s1s1 = SDIM_dot(s1,s1);
s1s2 = SDIM_dot(s1,s2);
s1t2 = SDIM_dot(s1,t2);
t2t2 = SDIM_dot(t2,t2);
s2s2 = SDIM_dot(s2,s2);
s2t2 = SDIM_dot(s2,t2);
det = s1s1*t2t2 - s1t2*s1t2;
a1 = sqrt(det);
det = s1s1*s2s2 - s1s2*s1s2;
a2 = sqrt(det);
cos_th = (s1s2*s1t2 - s2t2*s1s1)/a1/a2;
return sqrt(s1s1)*(1 - cos_th);
}
/************************************************************************
*
* Function: dihedral_hooke_grad()
*
* Purpose: Does gradient calculation.
*
*/
REAL dihedral_hooke_grad(e_info)
struct qinfo *e_info;
{
REAL s1[MAXCOORD],s2[MAXCOORD],t2[MAXCOORD];
REAL s1s1,s1s2,s1t2,s2s2,t2t2,s2t2;
REAL a1,a2;
REAL det;
facetedge_id fe_s1,fe_s2,fe_t2;
edge_id e_id = e_info->id;
REAL cos_th; /* cosine of angle between facets */
REAL dcosds1[MAXCOORD],dcosds2[MAXCOORD],dcosdt2[MAXCOORD];
REAL da1ds1[MAXCOORD], da1dt2[MAXCOORD];
REAL da2ds1[MAXCOORD], da2ds2[MAXCOORD];
int i;
/* get edge vectors away from tail vertex */
fe_s1 = get_edge_fe(e_id);
fe_s2 = get_prev_edge(get_next_facet(fe_s1));
fe_s2 = inverse_id(fe_s2);
fe_t2 = get_prev_edge(fe_s1);
fe_t2 = inverse_id(fe_t2);
get_fe_side(fe_s1,s1);
get_fe_side(fe_s2,s2);
get_fe_side(fe_t2,t2);
s1s1 = SDIM_dot(s1,s1);
s1s2 = SDIM_dot(s1,s2);
s1t2 = SDIM_dot(s1,t2);
t2t2 = SDIM_dot(t2,t2);
s2s2 = SDIM_dot(s2,s2);
s2t2 = SDIM_dot(s2,t2);
det = s1s1*t2t2 - s1t2*s1t2;
a1 = sqrt(det);
det = s1s1*s2s2 - s1s2*s1s2;
a2 = sqrt(det);
cos_th = (s1s2*s1t2 - s2t2*s1s1)/a1/a2;
/* gradients of various terms */
for ( i = 0 ; i < SDIM ; i++ )
{ da1ds1[i] = 0.5/a1*(2*s1[i]*t2t2 - 2*s1t2*t2[i]);
da1dt2[i] = 0.5/a1*(2*s1s1*t2[i] - 2*s1t2*s1[i]);
da2ds1[i] = 0.5/a2*(2*s1[i]*s2s2 - 2*s1s2*s2[i]);
da2ds2[i] = 0.5/a2*(2*s1s1*s2[i] - 2*s1s2*s1[i]);
dcosds1[i] = (s2[i]*s1t2 + s1s2*t2[i] - 2*s2t2*s1[i])/a1/a2
- cos_th/a1*da1ds1[i] - cos_th/a2*da2ds1[i];
dcosdt2[i] = (s1s2*s1[i] - s2[i]*s1s1)/a1/a2
- cos_th/a1*da1dt2[i];
dcosds2[i] = (s1[i]*s1t2 - t2[i]*s1s1)/a1/a2
- cos_th/a2*da2ds2[i];
}
for ( i = 0 ; i < SDIM ; i++ )
{ REAL f; /* part of force */
f = s1[i]*(1 - cos_th)/sqrt(s1s1);
e_info->grad[1][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosds1[i];
e_info->grad[1][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosds2[i];
e_info->grad[3][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosdt2[i];
e_info->grad[2][i] += f;
e_info->grad[0][i] -= f;
}
return sqrt(s1s1)*(1 - cos_th);
}
/************************************************************************
*
* Function: dihedral_hooke_hess()
*
* Purpose: Does gradient and hessian calculation.
*
*/
static REAL Gtemp[6];
static REAL Ltemp[6][6];
static REAL Htemp[6][6];
static int Lcount;
void gradList ARGS((REAL,REAL,REAL,REAL,REAL,REAL));
void LList ARGS((REAL*,REAL*,REAL*,REAL*,REAL*,REAL*));
REAL *List ARGS((REAL,REAL,REAL,REAL,REAL,REAL));
/* utility functions for deciphering Mathematica output */
void gradList(a,b,c,d,e,f)
REAL a,b,c,d,e,f;
{ Gtemp[0] = a;
Gtemp[1] = b;
Gtemp[2] = c;
Gtemp[3] = d;
Gtemp[4] = e;
Gtemp[5] = f;
}
void LList(a,b,c,d,e,f)
REAL *a,*b,*c,*d,*e,*f;
{ int i;
for ( i = 0 ; i < 6 ; i++ )
{ Htemp[0][i] = a[i];
Htemp[1][i] = b[i];
Htemp[2][i] = c[i];
Htemp[3][i] = d[i];
Htemp[4][i] = e[i];
Htemp[5][i] = f[i];
}
}
REAL * List(a,b,c,d,e,f)
REAL a,b,c,d,e,f;
{ Ltemp[Lcount][0] = a;
Ltemp[Lcount][1] = b;
Ltemp[Lcount][2] = c;
Ltemp[Lcount][3] = d;
Ltemp[Lcount][4] = e;
Ltemp[Lcount][5] = f;
return Ltemp[Lcount++];
}
/* This has a really long expression in it, which some
compilers may not be able to handle. If so, just
use gcc instead of cc, or #ifdef out the bulk of the function,
since you're probably not going to use it anyway.
*/
REAL dihedral_hooke_hess(e_info)
struct qinfo *e_info;
{
#ifndef MAC_CW
int i,j,k,n,jj,nn;
REAL s1[MAXCOORD],s2[MAXCOORD],t2[MAXCOORD];
REAL s1s1,s1s2,s1t2,s2s2,t2t2,s2t2;
REAL a1,a2;
REAL det;
facetedge_id fe_s1,fe_s2,fe_t2;
edge_id e_id = e_info->id;
REAL cos_th; /* cosine of angle between facets */
REAL dcosds1[MAXCOORD],dcosds2[MAXCOORD],dcosdt2[MAXCOORD];
REAL da1ds1[MAXCOORD], da1dt2[MAXCOORD];
REAL da2ds1[MAXCOORD], da2ds2[MAXCOORD];
REAL dqdx[6][3][MAXCOORD];
REAL ddqdxx[6][3][3];
/* get edge vectors away from tail vertex */
fe_s1 = get_edge_fe(e_id);
fe_s2 = get_prev_edge(get_next_facet(fe_s1));
fe_s2 = inverse_id(fe_s2);
fe_t2 = get_prev_edge(fe_s1);
fe_t2 = inverse_id(fe_t2);
get_fe_side(fe_s1,s1);
get_fe_side(fe_s2,s2);
get_fe_side(fe_t2,t2);
s1s1 = SDIM_dot(s1,s1);
s1s2 = SDIM_dot(s1,s2);
s1t2 = SDIM_dot(s1,t2);
t2t2 = SDIM_dot(t2,t2);
s2s2 = SDIM_dot(s2,s2);
s2t2 = SDIM_dot(s2,t2);
det = s1s1*t2t2 - s1t2*s1t2;
a1 = sqrt(det);
det = s1s1*s2s2 - s1s2*s1s2;
a2 = sqrt(det);
cos_th = (s1s2*s1t2 - s2t2*s1s1)/a1/a2;
/* gradients of various terms */
for ( i = 0 ; i < SDIM ; i++ )
{ da1ds1[i] = 0.5/a1*(2*s1[i]*t2t2 - 2*s1t2*t2[i]);
da1dt2[i] = 0.5/a1*(2*s1s1*t2[i] - 2*s1t2*s1[i]);
da2ds1[i] = 0.5/a2*(2*s1[i]*s2s2 - 2*s1s2*s2[i]);
da2ds2[i] = 0.5/a2*(2*s1s1*s2[i] - 2*s1s2*s1[i]);
dcosds1[i] = (s2[i]*s1t2 + s1s2*t2[i] - 2*s2t2*s1[i])/a1/a2
- cos_th/a1*da1ds1[i] - cos_th/a2*da2ds1[i];
dcosdt2[i] = (s1s2*s1[i] - s2[i]*s1s1)/a1/a2
- cos_th/a1*da1dt2[i];
dcosds2[i] = (s1[i]*s1t2 - t2[i]*s1s1)/a1/a2
- cos_th/a2*da2ds2[i];
}
/* gradients */
for ( i = 0 ; i < SDIM ; i++ )
{ REAL f; /* part of force */
f = s1[i]*(1 - cos_th)/sqrt(s1s1);
e_info->grad[1][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosds1[i];
e_info->grad[1][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosds2[i];
e_info->grad[3][i] += f;
e_info->grad[0][i] -= f;
f = -sqrt(s1s1)*dcosdt2[i];
e_info->grad[2][i] += f;
e_info->grad[0][i] -= f;
}
/* hessian */
/* from Mathematica */
#define Sqrt(a) sqrt(a)
#define Power(a,b) pow(a,(REAL)(b))
gradList(Sqrt(s1s1)*(((s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
s2t2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(1 - (s1s2*s1t2 - s1s1*s2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/
(2.*Sqrt(s1s1)),Sqrt(s1s1)*
(-(s1t2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) -
(s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
Sqrt(s1s1)*(-((s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))) -
s1s2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2))
),(Power(s1s1,1.5)*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
Power(s1s1,1.5)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(Power(s1s1,1.5)*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)));
Lcount = 0;
LList(List(Sqrt(s1s1)*((-3*(s1s2*s1t2 - s1s1*s2t2)*Power(t2t2,2))/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) -
(s2t2*t2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s2s2*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s2s2*s2t2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
(3*Power(s2s2,2)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(((s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
s2t2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/Sqrt(s1s1) -
(1 - (s1s2*s1t2 - s1s1*s2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/
(4.*Power(s1s1,1.5)),Sqrt(s1s1)*
((s1t2*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1t2*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(s1s2*s2t2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*s1s2*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(-(s1t2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) -
(s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/(2.*Sqrt(s1s1)),
Sqrt(s1s1)*((3*s1t2*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) +
(s1t2*s2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1t2*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(-((s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))) -
s1s2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/(2.*Sqrt(s1s1)),
-(Power(s1s1,1.5)*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(Power(s1s1,1.5)*s2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
(3*Power(s1s1,1.5)*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*Sqrt(s1s1)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
-(Power(s1s1,1.5)*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(Power(s1s1,1.5)*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*Sqrt(s1s1))/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(-3*Power(s1s1,1.5)*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) -
(Power(s1s1,1.5)*s2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(Power(s1s1,1.5)*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(3*Sqrt(s1s1)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
List(Sqrt(s1s1)*((s1t2*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1t2*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(s1s2*s2t2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*s1s2*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(-(s1t2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) -
(s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/(2.*Sqrt(s1s1)),
Sqrt(s1s1)*((-2*s1s2*s1t2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
(3*Power(s1s2,2)*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
(s1s2*s1t2 - s1s1*s2t2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
Sqrt(s1s1)*(-(Power(s1t2,2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))) -
(s1s2*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
Power(s1s2,2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
1/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
(Power(s1s1,1.5)*s1t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*Power(s1s1,1.5)*s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(Power(s1s1,1.5)*s1s2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(Power(s1s1,1.5)*s1t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(Power(s1s1,1.5)*s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
List(Sqrt(s1s1)*((3*s1t2*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) +
(s1t2*s2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1t2*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))) +
(-((s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))) -
s1s2/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)))/(2.*Sqrt(s1s1)),
Sqrt(s1s1)*(-(Power(s1t2,2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))) -
(s1s2*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
Power(s1s2,2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
1/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
Sqrt(s1s1)*((-3*Power(s1t2,2)*(s1s2*s1t2 - s1s1*s2t2))/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) -
(2*s1s2*s1t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s1s2*s1t2 - s1s1*s2t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
(Power(s1s1,1.5)*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(Power(s1s1,1.5)*s1s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(Power(s1s1,1.5)*s1t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Power(-Power(s1t2,2) + s1s1*t2t2,1.5)),
(3*Power(s1s1,1.5)*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) +
(Power(s1s1,1.5)*s1s2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
List((Sqrt(s1s1)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
Sqrt(s1s1)*(-(s1s1*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s1s1*s2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) -
(3*s1s1*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(s1s2*s1t2 - s1s1*s2t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
Sqrt(s1s1)*((s1s1*s1t2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
(3*s1s1*s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
Sqrt(s1s1)*((s1s1*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s1*s1s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2))),
(-3*Power(s1s1,2.5)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,2.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
-Power(s1s1,2.5)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
-(Power(s1s1,2.5)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
List(Sqrt(s1s1)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2))
+ Sqrt(s1s1)*(-(s1s1*t2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s1s1*s2s2)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)) +
1/(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)))
,(Power(s1s1,1.5)*s1s2)/
(Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*Sqrt(-Power(s1t2,2) + s1s1*t2t2)),
(Power(s1s1,1.5)*s1t2)/
(Sqrt(-Power(s1s2,2) + s1s1*s2s2)*Power(-Power(s1t2,2) + s1s1*t2t2,1.5)),
-Power(s1s1,2.5)/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Sqrt(-Power(s1t2,2) + s1s1*t2t2)),0,
-Power(s1s1,2.5)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
List((Sqrt(s1s1)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
Sqrt(s1s1)*((-3*s1s1*(s1s2*s1t2 - s1s1*s2t2)*t2t2)/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) -
(s1s1*s2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) -
(s1s1*s2s2*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s2*s1t2 - s1s1*s2t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
Sqrt(s1s1)*((s1s1*s1t2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)) +
(s1s1*s1s2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
Sqrt(s1s1)*((3*s1s1*s1t2*(s1s2*s1t2 - s1s1*s2t2))/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5)) +
(s1s1*s1s2)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5))),
-(Power(s1s1,2.5)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Power(-Power(s1s2,2) + s1s1*s2s2,1.5)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)),
-Power(s1s1,2.5)/
(2.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,1.5)),
(-3*Power(s1s1,2.5)*(s1s2*s1t2 - s1s1*s2t2))/
(4.*Sqrt(-Power(s1s2,2) + s1s1*s2s2)*
Power(-Power(s1t2,2) + s1s1*t2t2,2.5))));
#define S1S1 0
#define S1S2 1
#define S1T2 2
#define S2S2 3
#define S2T2 4
#define T2T2 5
#define S1 0
#define T2 1
#define S2 2
/* chain rule intermediate partials */
for ( i = 0 ; i < 6 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
for ( k = 0 ; k < SDIM ; k++ )
dqdx[i][j][k] = 0.0;
for ( i = 0 ; i < SDIM ; i++ )
{
dqdx[S1S1][S1][i] = 2*s1[i];
dqdx[S1S2][S1][i] = s2[i];
dqdx[S1S2][S2][i] = s1[i];
dqdx[S1T2][S1][i] = t2[i];
dqdx[S1T2][T2][i] = s1[i];
dqdx[S2S2][S2][i] = 2*s2[i];
dqdx[S2T2][S2][i] = t2[i];
dqdx[S2T2][T2][i] = s2[i];
dqdx[T2T2][T2][i] = 2*t2[i];
}
for ( i = 0 ; i < 6 ; i++ )
for ( j = 0 ; j < 3 ; j++ )
for ( k = 0 ; k < 3 ; k++ )
ddqdxx[i][j][k] = 0.0;
ddqdxx[S1S1][S1][S1] = 2.0;
ddqdxx[S1S2][S1][S2] = 1.0;
ddqdxx[S1S2][S2][S1] = 1.0;
ddqdxx[S1T2][S1][T2] = 1.0;
ddqdxx[S1T2][T2][S1] = 1.0;
ddqdxx[S2S2][S2][S2] = 2.0;
ddqdxx[S2T2][S2][T2] = 1.0;
ddqdxx[S2T2][T2][S2] = 1.0;
ddqdxx[T2T2][T2][T2] = 2.0;
/* now assemble */
for ( n = 0 ; n < 3 ; n++ ) /* which edge fan vertex */
for ( i = 0 ; i < SDIM ; i++ ) /* dimension on first */
for ( nn = 0 ; nn < 3 ; nn++ ) /* which edge fan vertex */
for ( k = 0 ; k < SDIM ; k++ ) /* dimension on second */
{ REAL sum = 0.0;
for ( j = 0 ; j < 6 ; j++ )
{ for ( jj = 0 ; jj < 6; jj++ )
sum += Htemp[j][jj]*dqdx[j][n][i]*dqdx[jj][nn][k];
if ( i == k ) sum += Gtemp[j]*ddqdxx[j][n][nn];
}
e_info->hess[n+1][nn+1][i][k] += sum;
e_info->hess[n+1][0][i][k] -= sum;
e_info->hess[0][nn+1][i][k] -= sum;
e_info->hess[0][0][i][k] += sum;
}
return sqrt(s1s1)*(1 - cos_th);
#else
kb_error(2169,"dihedral_hooke hessian not implemented on Mac 68K.\n",WARNING);
return 0.0;
#endif
}
evolver-2.30c.dfsg/src/evalmore.c 0000644 0001753 0001753 00000614543 11410765113 017210 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*****************************************************************
*
* File: evalmore.c
*
* Purpose: Overflow from eval() in evaltree.c.
*/
#include "include.h"
#include "lex.h"
#include "ytab.h"
#ifdef MAC_APP
#define S_IFIFO 0x100
#elif !defined(MAC_CW)
#include
/* #include */
#ifndef S_IFIFO
#ifdef __S_IFIFO
#define S_IFIFO __S_IFIFO
#elif defined(_S_IFIFO)
#define S_IFIFO _S_IFIFO
#else
#define S_IFIFO 0010000
#endif
#endif
#endif
/*
int wait ARGS((int*));
int fork ARGS((void));
int execlp();
int stat();
*/
void flip_toggle ARGS((int*,int,char*));
void set_body ARGS((element_id,body_id));
/************************************************************************
*
* Function: other_stuff()
*
* Purpose: execute command nodes, overflow from eval().
*
* Return: stacktop pointer
*/
void other_stuff(node,recalc_flag,update_display_flag,q_id,localstack,
localbase)
struct treenode * node;
int *recalc_flag;
int *update_display_flag;
element_id q_id;
REAL *localstack; /* stack base */
struct locallist_t *localbase;
{ int i,j,n,k;
char *s,*h;
REAL scale;
int old; /* old state of toggle */
int oldquiet; /* old state of quiet_flag */
element_id id,fe,f_id,b_id;
struct thread_data *td = GET_THREAD_DATA;
#define newstack (td->eval_stack)
#define stackmax (td->eval_stack_size)
#define stacktop (td->stack_top)
#define this_frame ((struct eval_frame*)(newstack + td->frame_spot))
switch ( node->type )
{
case SIMPLEX_TO_FE_:
simplex_to_fe(); break;
case REORDER_STORAGE_:
reorder_storage(); break;
case RENUMBER_ALL_:
renumber_all(); break;
case DUMP_MEMLIST_:
mem_list_dump(); break;
case VIEW_MATRIX_:
i = (int)(*(stacktop--));
k = (int)(*(stacktop--));
if ( (k < 1) || (k > SDIM+1) || (i < 1) || (i > SDIM+1) )
{ sprintf(errmsg,
"Illegal index: view_matrix[%d][%d] (must be 1 to %d)\n",k,i,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2008,errmsg,RECOVERABLE);
}
*(++stacktop) = view[k-1][i-1];
break;
case RESET_COUNTS_:
reset_counts();
break;
case FLUSH_COUNTS_:
flush_counts();
break;
case PRINT_PROFILING_:
print_profiling();
break;
case RESET_PROFILING_:
reset_profiling();
break;
case PAUSE_:
outstring("Paused; hit RETURN to continue, b to break: ");
my_fgets(msg,msgmax,stdin);
if ( msg[0] == 'b' )
breakflag = BREAKFULL;
break;
case HELP_KEYWORD:
keyword_help(node->op1.string);
break;
case CREATE_VERTEX_:
{ vertex_id v_id;
REAL x[MAXCOORD];
for ( i = SDIM-1 ; i >= 0 ; i-- ) x[i] = *(stacktop--);
v_id = new_vertex(x,NULLID);
new_vertex_id = ordinal(v_id) + 1;
set_original(v_id,new_vertex_id);
*(++stacktop) = (REAL)new_vertex_id;
*recalc_flag = 1;
break;
}
case CREATE_EDGE_:
{ vertex_id v_id2;
vertex_id v_id1;
int v2 = (int)(*stacktop--);
int v1 = (int)(*stacktop--);
edge_id e_id;
v_id2 = get_ordinal_id(VERTEX,v2-1);
v_id1 = get_ordinal_id(VERTEX,v1-1);
if ( !valid_id(v_id1) )
{ sprintf(errmsg,"Invalid tail vertex %d in new_edge.\n",v1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2009,errmsg,RECOVERABLE);
}
if ( !valid_id(v_id2) )
{ sprintf(errmsg,"Invalid head vertex %d in new_edge.\n",v2);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2010,errmsg, RECOVERABLE);
}
e_id = new_edge(v_id1,v_id2,NULLID);
new_edge_id = ordinal(e_id)+1;
set_original(e_id,new_edge_id);
*(++stacktop) = (REAL)new_edge_id;
*recalc_flag = 1;
}
break;
case CREATE_FACET_:
{ facetedge_id old_fe = NULLID;
edge_id e_id;
vertex_id tv,hv;
#define ORD_ID(id) ((id)<0 ? inverse_id(get_ordinal_id(EDGE,-1-(id))) : \
get_ordinal_id(EDGE,(id)-1))
f_id = NULLID;
fe = NULLID;
if ( (web.representation == STRING) || (web.representation == SOAPFILM) )
{ n = node[node->left].op1.argcount; /* size of edge list */
for ( i = 0 ; i < n ; i++ )
if ( !valid_id(ORD_ID((int)(stacktop[-i]))) )
{ sprintf(msg,"Invalid edge %g in new_facet.\n",(double)stacktop[-i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2011,msg,RECOVERABLE);
}
/* check continuity */
i = 1-n;
e_id = ORD_ID((int)(stacktop[i]));
hv = get_edge_headv(e_id);
for ( i++ ; i <= 0 ; i++ )
{ e_id = ORD_ID((int)(stacktop[i]));
tv = get_edge_tailv(e_id);
if ( !equal_id(hv,tv) )
{ sprintf(errmsg,
"Inconsistency: edge %s tail vertex %s disagrees with previous head %s.\n",
ELNAME(e_id),ELNAME1(tv),ELNAME2(hv));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2012,errmsg,RECOVERABLE);
}
hv = get_edge_headv(e_id);
}
if ( web.representation == SOAPFILM)
{
e_id = ORD_ID((int)(stacktop[0]));
hv = get_edge_headv(e_id);
e_id = ORD_ID((int)(stacktop[1-n]));
tv = get_edge_tailv(e_id);
if ( !equal_id(hv,tv) )
{ sprintf(errmsg,
"Inconsistency in first edge tail vertex and last edge head.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2013,errmsg,RECOVERABLE);
}
}
f_id = new_facet();
set_original(f_id,f_id);
for ( i = 0 ; i < n ; i++ )
{ facetedge_id edge_fe;
e_id = ORD_ID((int)(stacktop[i-n+1]));
fe = new_facetedge(f_id,e_id);
if ( !valid_id(get_facet_fe(f_id)) )
set_facet_fe(f_id,fe);
else
{ set_next_edge(old_fe,fe);
set_prev_edge(fe,old_fe);
}
old_fe = fe;
/* add to edge facet list, and get in geometric order */
edge_fe = get_edge_fe(e_id);
if ( valid_id(edge_fe) )
{ /* insert in chain */
set_next_facet(fe,get_next_facet(edge_fe));
set_prev_facet(fe,edge_fe);
set_prev_facet(get_next_facet(fe),fe);
set_next_facet(edge_fe,fe);
}
else
{ set_next_facet(fe,fe);
set_prev_facet(fe,fe);
set_edge_fe(e_id,fe); /* link edge to rest of world */
}
}
if ( equal_id(get_fe_tailv(get_facet_fe(f_id)),get_fe_headv(fe)) )
{
set_next_edge(fe,get_facet_fe(f_id)); /* close up ring */
set_prev_edge(get_facet_fe(f_id),fe);
}
if ( web.representation == SOAPFILM )
{ fe = get_facet_fe(f_id);
for ( i = 0 ; i < n ; i++,fe = get_next_edge(fe) )
fe_reorder(get_fe_edge(fe));
if ( n > 3 ) face_triangulate(f_id,n);
recalc_facet_area(f_id);
}
if ( web.representation == SOAPFILM )
need_fe_reorder_flag = 1;
stacktop -= n; /* pop id's */
}
else if ( web.representation == SIMPLEX )
{ vertex_id *v;
n = node[node->left].op1.argcount; /* size of edge list */
for ( i = 0 ; i < n ; i++ )
if ( !valid_id(get_ordinal_id(VERTEX,(int)stacktop[-i]-1) ) )
{ sprintf(msg,"Invalid vertex %d in new_facet.\n",(int)stacktop[-i]);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2014,msg,RECOVERABLE);
}
f_id = new_facet();
v = get_facet_vertices(f_id);
for ( i = 0 ; i < n ; i++ ) v[i] = get_ordinal_id(VERTEX,(int)stacktop[-n+i+1]-1);
stacktop -= n; /* pop id's */
}
}
new_facet_id = ordinal(f_id) + 1;
*(++stacktop) = (REAL)new_facet_id;
*recalc_flag = 1;
break;
case CREATE_BODY_:
{ body_id b_id = new_body();
new_body_id = ordinal(b_id) + 1;
set_original(b_id,new_body_id);
*(++stacktop) = (REAL)new_body_id;
}
*recalc_flag = 1;
break;
case MERGE_VERTEX_:
{ vertex_id v_id2;
vertex_id v_id1;
int v2 = (int)(*stacktop--);
int v1 = (int)(*stacktop--);
v_id2 = get_ordinal_id(VERTEX,v2-1);
v_id1 = get_ordinal_id(VERTEX,v1-1);
if ( (v1==0) || !valid_id(v_id1) )
{ sprintf(errmsg,"Invalid first vertex %d in vertex_merge.\n",v1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3886,errmsg,RECOVERABLE);
}
if ( (v2==0) || !valid_id(v_id2) )
{ sprintf(errmsg,"Invalid second vertex %d in vertex_merge.\n",v2);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3916,errmsg, RECOVERABLE);
}
merge_vertex(v_id1,v_id2);
*recalc_flag = 1;
}
break;
case MERGE_EDGE_:
{ edge_id e_id2;
edge_id e_id1;
int e2 = (int)(*stacktop--);
int e1 = (int)(*stacktop--);
e_id2 = get_ordinal_id(EDGE,abs(e2)-1);
if ( e2 < 0 ) invert(e_id2);
e_id1 = get_ordinal_id(EDGE,abs(e1)-1);
if ( e1 < 0 ) invert(e_id1);
if ( (e1==0) ||!valid_id(e_id1) )
{ sprintf(errmsg,"Invalid first edge %d in edge_merge.\n",e1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3878,errmsg,RECOVERABLE);
}
if ( (e2==0) || !valid_id(e_id2) )
{ sprintf(errmsg,"Invalid second edge %d in edge_merge.\n",e2);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3912,errmsg, RECOVERABLE);
}
merge_edge(e_id1,e_id2);
*recalc_flag = 1;
}
break;
case MERGE_FACET_:
{ facet_id f_id2;
facet_id f_id1;
int f2 = (int)(*stacktop--);
int f1 = (int)(*stacktop--);
f_id2 = get_ordinal_id(FACET,abs(f2)-1);
if ( f2 < 0 ) invert(f_id2);
f_id1 = get_ordinal_id(FACET,abs(f1)-1);
if ( f1 < 0 ) invert(f_id1);
if ( (f1==0) || !valid_id(f_id1) )
{ sprintf(errmsg,"Invalid first facet %d in facet_merge.\n",f1);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3880,errmsg,RECOVERABLE);
}
if ( (f2==0) || !valid_id(f_id2) )
{ sprintf(errmsg,"Invalid second facet %d in facet_merge.\n",f2);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3879,errmsg, RECOVERABLE);
}
merge_facet(f_id1,f_id2);
*recalc_flag = 1;
}
break;
case GET_TORUS_PERIODS_:
j = (int)(*stacktop--);
i = (int)(*stacktop--);
if ( (j<1) || (j > SDIM))
{ sprintf(errmsg,
"Torus_periods index %d; must be between 1 and %d.\n",j,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2015,errmsg,RECOVERABLE);
}
if ((i<1) || (i>SDIM) )
{ sprintf(errmsg,
"Torus_periods index %d; must be between 1 and %d.\n",i,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2016,errmsg,RECOVERABLE);
}
*++stacktop = web.torus_period[i-1][j-1]; /* 1-based indexing */
break;
case GET_INVERSE_PERIODS_:
j = (int)(*stacktop--);
i = (int)(*stacktop--);
if ( (j<1) || (j > SDIM) )
{ sprintf(errmsg,
"Inverse_periods index %d; must be between 1 and %d.\n",j,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2017,errmsg,RECOVERABLE);
}
if ( (i<1) || (i>SDIM) )
{ sprintf(errmsg,
"Inverse_periods index %d; must be between 1 and %d.\n",i,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2018,errmsg,RECOVERABLE);
}
*++stacktop = web.inverse_periods[i-1][j-1]; /* 1-based indexing */
break;
case SET_GAP_CONSTANT_:
web.spring_constant = *(stacktop--);
if ( everything_quantities_flag )
GEN_QUANT(gap_quantity_num)->modulus = web.spring_constant;
if ( web.spring_constant == 0.0 ) web.convex_flag = 0;
else web.convex_flag = 1;
*recalc_flag = 1;
break;
case GET_INTERNAL_:
*++stacktop = get_internal_variable(node->op1.name_id);
break;
case SET_INTERNAL_:
{ REAL oldvalue=0.0;
REAL val;
/* get old value */
switch(node->op1.name_id)
{
#ifdef MPI_EVOLVER
case V_CORONA_STATE : oldvalue = mpi_corona_state; break;
#endif
case V_PS_LABELSIZE_ : oldvalue = ps_labelsize; break;
case V_PS_STRINGWIDTH_: oldvalue = ps_stringwidth; break;
case V_PS_FIXEDEDGEWIDTH_: oldvalue = ps_fixededgewidth; break;
case V_PS_TRIPLEEDGEWIDTH_: oldvalue = ps_tripleedgewidth; break;
case V_PS_CONEDGEWIDTH_: oldvalue = ps_conedgewidth; break;
case V_PS_BAREEDGEWIDTH_: oldvalue = ps_bareedgewidth; break;
case V_PS_GRIDEDGEWIDTH_: oldvalue = ps_gridedgewidth; break;
case V_TOLERANCE: oldvalue = web.tolerance; break;
case V_LAST_ERROR: oldvalue = last_error; break;
case V_BRIGHTNESS: oldvalue = brightness; break;
case V_BACKGROUND: oldvalue = background_color; break;
case V_TARGET_TOLERANCE: oldvalue = web.target_tolerance;
break;
case V_HESS_EPSILON: oldvalue = hessian_epsilon; break;
case GRAV_CONST_: oldvalue = web.grav_const; break;
case V_THICKNESS: oldvalue = thickness; break;
case V_HESSIAN_SLANT_CUTOFF: oldvalue = hessian_slant_cutoff; break;
case V_AMBIENT_PRESSURE: oldvalue = web.pressure; break;
case V_DIFFUSION: oldvalue = web.diffusion_const;
web.diffusion_flag = 1; break;
case V_SCALE_SCALE: oldvalue = web.scale_scale; break;
case V_SCALE: oldvalue = web.scale; break;
case V_SCALE_LIMIT: oldvalue = web.maxscale; break;
case V_TIME: oldvalue = total_time; break;
case V_CHECK_COUNT_: oldvalue = check_count; break;
case V_VISIBILITY_DEBUG_: oldvalue = visdebuglevel; break;
case V_SCROLLBUFFERSIZE_: oldvalue = scrollbuffersize; break;
case V_BREAKFLAG_: oldvalue = breakflag; break;
case V_STRING_CURVE_TOLERANCE: oldvalue = string_curve_tolerance;
break;
case V_MINDEG_DEBUG_LEVEL: oldvalue = mindeg_debug_level; break;
case V_MINDEG_MARGIN: oldvalue = mindeg_margin; break;
case V_MINDEG_MIN_REGION_SIZE: oldvalue = mindeg_min_region_size; break;
case V_WINDOW_ASPECT_RATIO: oldvalue = window_aspect_ratio; break;
case V_PICKVNUM: oldvalue = pickvnum; break;
case V_PICKENUM: oldvalue = pickenum; break;
case V_PICKFNUM: oldvalue = pickfnum; break;
case V_JIG_TEMP: oldvalue = web.temperature; break;
case V_LINEAR_METRIC_MIX: oldvalue = linear_metric_mix; break;
case V_GAP_CONSTANT: oldvalue = web.spring_constant; break;
case V_QUADRATIC_METRIC_MIX:
oldvalue = quadratic_metric_mix; break;
case V_RANDOM_SEED: oldvalue = random_seed;break;
case V_RANDOM:
sprintf(errmsg,"Cannot set random. Set random_seed instead.\n");
stacktop--;
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2019,errmsg, WARNING);
break;
case V_INTEGRAL_ORDER: oldvalue = web.gauss2D_order; break;
case V_INTEGRAL_ORDER_1D: oldvalue = web.gauss1D_order; break;
case V_INTEGRAL_ORDER_2D: oldvalue = web.gauss2D_order; break;
case V_AUTOCHOP_LENGTH: oldvalue = autochop_length; break;
default:
sprintf(errmsg,"Internal: illegal variable number %d.\n",
node->op1.name_id);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1209,errmsg, RECOVERABLE);
}
val = *(stacktop--);
switch ( node->op2.assigntype )
{ case ASSIGN_: break;
case PLUSASSIGN_: val += oldvalue; break;
case SUBASSIGN_: val = oldvalue - val; break;
case MULTASSIGN_: val = oldvalue * val; break;
case DIVASSIGN_: val = oldvalue / val; break;
}
switch(node->op1.name_id)
{ case V_TOLERANCE: web.tolerance = val; break;
case V_PS_LABELSIZE_: ps_labelsize = val; break;
case V_PS_STRINGWIDTH_: ps_stringwidth = val; break;
case V_PS_FIXEDEDGEWIDTH_: ps_fixededgewidth = val; break;
case V_PS_TRIPLEEDGEWIDTH_: ps_tripleedgewidth = val; break;
case V_PS_CONEDGEWIDTH_: ps_conedgewidth = val; break;
case V_PS_BAREEDGEWIDTH_: ps_bareedgewidth = val; break;
case V_PS_GRIDEDGEWIDTH_: ps_gridedgewidth = val; break;
#ifdef MPI_EVOLVER
case V_CORONA_STATE: mpi_set_corona((int)val); break;
#else
case V_CORONA_STATE: ; break;
#endif
case V_BRIGHTNESS:
if ( (val < 0.0) || (val > 1.0) )
{ sprintf(errmsg,"Brightness is %f; must be between 0 and 1.\n",val);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2020,errmsg, RECOVERABLE);
}
else { brightness = val; update_display(); }
break;
case V_BACKGROUND:
background_color = (int)val;
update_display();
break;
case V_TARGET_TOLERANCE: web.target_tolerance = val;
break;
case V_HESS_EPSILON: hessian_epsilon = val;
if ( hessian_epsilon < 0.0 )
{ sprintf(errmsg,"hessian_epsilon is negative!\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2558,errmsg, WARNING);
}
break;
case GRAV_CONST_: web.grav_const = val;
if ( web.grav_const != 0.0 )
web.gravflag = 1;
else
web.gravflag = 0;
if (gravity_quantity_num >= 0 )
GEN_QUANT(gravity_quantity_num)->modulus =
web.gravflag ? web.grav_const : 0.0;
break;
case V_DIFFUSION: web.diffusion_const = val; break;
case V_AMBIENT_PRESSURE: web.pressure = val; break;
case V_HESSIAN_SLANT_CUTOFF: hessian_slant_cutoff = val; break;
case V_THICKNESS: thickness = val; user_thickness_flag = 1;
update_display();break;
case V_SCALE_SCALE: web.scale_scale = val; break;
case V_SCALE: web.scale = val; break;
case V_SCALE_LIMIT: web.maxscale = val; break;
case V_LAST_ERROR: last_error = (int)val; break;
case V_TIME: total_time = val; break;
case V_CHECK_COUNT_: check_count = (int)val; break;
case V_VISIBILITY_DEBUG_: visdebuglevel = (int)val; break;
case V_SCROLLBUFFERSIZE_: scrollbuffersize = (int)val;
set_scroll_size(scrollbuffersize); break;
case V_BREAKFLAG_: breakflag = (int)val; break;
case V_STRING_CURVE_TOLERANCE: string_curve_tolerance = val;
update_display();break;
case V_MINDEG_DEBUG_LEVEL: mindeg_debug_level = (int)val; break;
case V_MINDEG_MARGIN: mindeg_margin = (int)val; break;
case V_MINDEG_MIN_REGION_SIZE: mindeg_min_region_size = (int)val; break;
case V_WINDOW_ASPECT_RATIO: window_aspect_ratio = (REAL)val;
update_display(); break;
case V_PICKVNUM: pickvnum = (int)val; break;
case V_PICKENUM: pickenum = (int)val; break;
case V_PICKFNUM: pickfnum = (int)val; break;
case V_JIG_TEMP: web.temperature = val; break;
case V_LINEAR_METRIC_MIX: linear_metric_mix=val; break;
case V_GAP_CONSTANT: web.spring_constant = val; break;
case V_AUTOCHOP_LENGTH: autochop_length = val; break;
case V_QUADRATIC_METRIC_MIX:
quadratic_metric_mix=val; break;
case V_RANDOM_SEED: random_seed = (int)val;
srand(random_seed); srand48(random_seed);
kb_initr(random_seed); break;
case V_RANDOM: sprintf(errmsg,
"Cannot set random. Set random_seed instead.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2021,errmsg,WARNING);
stacktop--; break;
case V_INTEGRAL_ORDER:
web.gauss1D_order = (int)val;
set_by_user_gauss_1D = web.gauss1D_order;
web.gauss2D_order = (int)val;
set_by_user_gauss_2D = web.gauss2D_order;
gauss_setup();
if ( web.modeltype == LAGRANGE )
{ gauss_lagrange_setup(
(web.dimension==1)?1:web.dimension-1,
web.lagrange_order,web.gauss1D_order);
gauss_lagrange_setup(web.dimension,
web.lagrange_order,web.gauss2D_order);
}
*recalc_flag = 1;
break;
case V_INTEGRAL_ORDER_1D:
web.gauss1D_order = (int)val;
set_by_user_gauss_1D = web.gauss1D_order;
if ( web.modeltype == LAGRANGE )
gauss_lagrange_setup(
(web.dimension==1)?1:web.dimension-1,
web.lagrange_order,web.gauss1D_order);
gauss_setup();
*recalc_flag = 1;
break;
case V_INTEGRAL_ORDER_2D:
web.gauss2D_order = (int)val;
set_by_user_gauss_2D = web.gauss2D_order;
gauss_setup();
if ( web.modeltype == LAGRANGE )
gauss_lagrange_setup(web.dimension,
web.lagrange_order,web.gauss2D_order);
*recalc_flag = 1;
break;
default:
sprintf(errmsg,"Internal: illegal internal variable number %d.\n",
node->op1.name_id);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1114,errmsg,RECOVERABLE);
}
break;
} /* end SET_INTERNAL_ */
case SIZEOF_ATTR_:
*++stacktop = (REAL)EXTRAS(node->op2.eltype)[node->op1.extranum].array_spec.datacount;
break;
case SIZEOF_ARRAY_:
*++stacktop = (REAL)get_name_arrayptr(node->op1.name_id,localstack,localbase)->datacount;
break;
case SIZEOF_STRING_:
{ char *s = *(char**)stacktop;
*stacktop = s ? (REAL)strlen(s) : 0;
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
break;
}
case TORDUP_:
i = (int)*(stacktop--);
if ( ! web.torus_flag )
{ outstring("Torus model not in effect.\n");
break;
}
if ( i < 1 || i > SDIM ) outstring("Improper period number.\n");
else tordup(i-1);
recalc();
break;
case SKINNY_:
sprintf(msg,"New edges: %d\n",web.facet_refine_count = skinny(*(stacktop--)));
outstring(msg);
recalc();
break;
case PUSHQPRESSURE_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->pressure;
break;
case PUSHQTARGET_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->target;
break;
case PUSHQMODULUS_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->modulus;
break;
case PUSHQTOLERANCE_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->tolerance;
break;
case PUSHMMODULUS_:
*++stacktop = METH_INSTANCE(node->op1.meth_id)->modulus;
break;
case PUSHQVALUE_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
if ( q->timestampflags&(Q_INFO|Q_ENERGY|Q_FIXED));
*++stacktop = q->value;
}
break;
case PUSHQFIXED_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->flags & Q_FIXED ? 1:0 ;
break;
case PUSHQENERGY_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->flags & Q_ENERGY ? 1:0 ;
break;
case PUSHQINFO_ONLY_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->flags & Q_INFO ? 1:0 ;
break;
case PUSHQCONSERVED_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->flags & Q_CONSERVED ? 1:0 ;
break;
case PUSHMVALUE_:
{ struct method_instance *q
= METH_INSTANCE(node->op1.meth_id);
if ((q->timestamptimestampvalue;
}
break;
case PUSHQVOLCONST_:
*++stacktop = GEN_QUANT(node->op1.quant_id)->volconst;
break;
case PUSH_NAMED_QUANTITY:
case PUSH_METHOD_INSTANCE_:
*++stacktop = (REAL)node->op1.quant_id;
break;
case FIX_QUANTITY_: case SET_Q_FIXED_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
q->flags &= ~(Q_ENERGY|Q_INFO|Q_CONSERVED);
q->flags |= Q_FIXED;
if ( everything_quantities_flag )
if ( valid_id(q->b_id) )
set_attr(q->b_id,FIXEDVOL);
}
break;
case UNFIX_QUANTITY_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
q->flags &= ~(Q_ENERGY|Q_FIXED|Q_CONSERVED);
q->flags |= Q_INFO;
if ( everything_quantities_flag )
if ( valid_id(q->b_id) )
unset_attr(q->b_id,FIXEDVOL);
}
break;
case SET_Q_INFO_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
q->flags &= ~(Q_ENERGY|Q_FIXED|Q_CONSERVED);
q->flags |= Q_INFO;
if ( everything_quantities_flag )
if ( valid_id(q->b_id) )
unset_attr(q->b_id,FIXEDVOL);
}
break;
case SET_Q_ENERGY_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
if ( everything_quantities_flag )
if ( valid_id(q->b_id) )
{ sprintf(errmsg,"Cannot set body volume to ENERGY.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2416,errmsg,RECOVERABLE);
}
q->flags &= ~(Q_FIXED|Q_INFO|Q_CONSERVED);
q->flags |= Q_ENERGY;
}
break;
case SET_Q_CONSERVED_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
if ( everything_quantities_flag )
if ( valid_id(q->b_id) )
{ sprintf(errmsg,"Cannot set body volume to CONSERVED.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2546,errmsg,RECOVERABLE);
}
q->flags &= ~(Q_FIXED|Q_INFO|Q_ENERGY);
q->flags |= Q_CONSERVED;
}
break;
case UNFIX_PARAMETER_:
{ struct global *p = globals(node->op1.name_id);
int old = p->flags & OPTIMIZING_PARAMETER;
if ( !old )
{ if ( p->type != REAL_TYPE )
{ sprintf(errmsg,"Cannot unfix \"%s\" since it is not type REAL.\n",
p->name);
kb_error(4124,errmsg,RECOVERABLE);
}
if ( optparamcount >= MAXOPTPARAM-1 )
{ sprintf(errmsg,"Too many optimizing parameters. Increase MAXOPTPARAM in extern.h and recompile.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2022,errmsg,RECOVERABLE);
}
p->flags |= OPTIMIZING_PARAMETER;
memset((char*)&optparam[optparamcount],0,sizeof(struct optparam_t));
optparam[optparamcount++].pnum = node->op1.name_id;
if ( !everything_quantities_flag ) convert_to_quantities();
sprintf(msg,"%s now optimizing parameter. (was not)\n",p->name);
}
else sprintf(msg,"%s now optimizing parameter. (already was)\n",p->name);
break;
}
case FIX_PARAMETER_:
{ struct global *p = globals(node->op1.name_id);
int old = p->flags & OPTIMIZING_PARAMETER;
int spot;
if ( old )
{ for ( spot = 0 ; spot < optparamcount ; spot++ )
if ( optparam[spot].pnum == node->op1.name_id ) break;
if ( spot == optparamcount )
{ sprintf(errmsg,"`%s` not found in optimizing parameter list.\n",p->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2023,errmsg,WARNING);
break;
}
p->flags &= ~OPTIMIZING_PARAMETER;
optparam[spot] = optparam[--optparamcount];
sprintf(msg,"%s now nonoptimizing parameter. (was not)\n",p->name);
}
else sprintf(msg,"%s now nonoptimizing parameter. (already was)\n",p->name);
break;
}
/* attribute setting in set statements */
case SET_ATTRIBUTE_:
case SET_ATTRIBUTE_L:
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
parallel_update_flag[id_type(id)] = 1; /* set when element info changed */
switch ( node->op2.attr_kind )
{
case SET_FIXED_: set_attr(id,FIXED); break;
case SET_TRIPLE_PT_: set_attr(id,TRIPLE_PT); --stacktop; break;
case SET_TETRA_PT_: set_attr(id,TETRA_PT); --stacktop; break;
case SET_AXIAL_POINT_: set_attr(id,AXIAL_POINT); --stacktop; break;
case SET_EXTRA_ATTR_:
{ struct extra *ext;
int spot; /* index */
n = node->op3.extra_info & ((1<op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
ext = EXTRAS(id_type(id)) + n;
/* get index */
spot = 0;
for ( k = 0 ; k < ext->array_spec.dim ; k++ )
{ int j = (int)(stacktop[-ext->array_spec.dim+k+1]);
spot *= ext->array_spec.sizes[k];
if ( j > ext->array_spec.sizes[k] )
{ sprintf(errmsg,
"Attribute %s index %d is %d; maximum is %d (in %s).\n",
ext->name,k+1,j,ext->array_spec.sizes[k],ext->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1210,errmsg,RECOVERABLE);
}
if ( j < 1 )
{ sprintf(errmsg,
"Attribute %s index %d is %d; must be positive.\n",
ext->name,k,j);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1129,errmsg,RECOVERABLE);
}
spot += (int)(stacktop[-ext->array_spec.dim+k+1]) - 1;
}
stacktop -= ext->array_spec.dim;
switch ( ext->type )
{ case REAL_TYPE: ((REAL*)get_extra(id,n))[spot] = *(stacktop--);
break;
case INTEGER_TYPE:
((int*)get_extra(id,n))[spot] = (int)*(stacktop--);
break;
case ULONG_TYPE:
((unsigned long*)get_extra(id,n))[spot] =
(unsigned long)*(stacktop--);
break;
case USHORT_TYPE:
((unsigned short*)get_extra(id,n))[spot] =
(unsigned short)*(stacktop--);
break;
case UINT_TYPE:
((unsigned int*)get_extra(id,n))[spot] =
(unsigned int)*(stacktop--);
break;
case UCHAR_TYPE:
((unsigned char*)get_extra(id,n))[spot] =
(unsigned char)*(stacktop--);
break;
case LONG_TYPE:
((long int*)get_extra(id,n))[spot] =
(long int)*(stacktop--);
break;
case SHORT_TYPE:
((short*)get_extra(id,n))[spot] =
(short)*(stacktop--);
break;
case CHAR_TYPE:
((char*)get_extra(id,n))[spot] =
(char)*(stacktop--);
break;
case ELEMENTID_TYPE:
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
((element_id*)get_extra(id,n))[spot] =
*(element_id*)(stacktop--);
break;
case PTR_TYPE:
((char**)get_extra(id,n))[spot] =
*(char**)(stacktop--);
break;
case BOUNDARY_TYPE:
case CONSTRAINT_TYPE:
case QUANTITY_TYPE:
case INSTANCE_TYPE:
case PROCEDURE_TYPE:
((int*)get_extra(id,n))[spot] = (int)*(stacktop--);
break;
}
}
break;
case SET_DENSITY_:
{ REAL density = *(stacktop--);
if ( density != 1.0 ) set_attr(id,DENSITY);
switch ( id_type(id) )
{ case EDGE: set_edge_density(id,density);
pressure_set_flag = 0; break;
case FACET: set_facet_density(id,density);
pressure_set_flag = 0; break;
case BODY: set_body_density(id,density);
web.gravflag = 1;
if (gravity_quantity_num >= 0 )
GEN_QUANT(gravity_quantity_num)->modulus =
web.grav_const;
break;
}
*recalc_flag = 1;
}
break;
case SET_PHASE_:
{ int phase = (int)*(stacktop--);
switch ( id_type(id) )
{ case BODY: set_b_phase(id,phase); break;
case FACET: set_f_phase(id,phase); break;
}
*recalc_flag = 1;
}
break;
case SET_VOLCONST_:
{ REAL v = *(stacktop--);
REAL oldvcon = get_body_volconst(id);
set_body_volconst(id,v);
set_body_volume(id,get_body_volume(id)+v-oldvcon,SETSTAMP);
set_body_oldvolume(id,get_body_oldvolume(id)+v-oldvcon);
if ( everything_quantities_flag )
GEN_QUANT(get_body_volquant(id))->volconst = v;
*recalc_flag = 1;
break;
}
case SET_TARGET_:
{ REAL v = *(stacktop--);
if ( get_attr(id) & PRESSURE )
{ sprintf(errmsg,"Must unset body pressure before fixing target.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2024,errmsg, RECOVERABLE);
}
set_attr(id,FIXEDVOL);
set_body_fixvol(id,v); /* takes care of quantity */
reset_conj_grad();
*recalc_flag = 1;
break;
}
case SET_PRESSURE_:
{ REAL p = *(stacktop--);
unset_attr(id,FIXEDVOL);
set_attr(id,PRESSURE);
web.pressflag = 1;
set_body_pressure(id,p);
reset_conj_grad();
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(id));
if ( p == 0.0 )
{ q->modulus = 1.0;
if ( !(q->flags & Q_INFO) )
{ q->flags &= ~(Q_ENERGY|Q_FIXED|Q_CONSERVED);
q->flags |= Q_INFO;
}
}
else
{ q->modulus = -p;
if ( !(q->flags & Q_ENERGY ) )
{ q->flags &= ~(Q_INFO|Q_FIXED|Q_CONSERVED);
q->flags |= Q_ENERGY;
}
}
}
*recalc_flag = 1;
break;
}
case SET_OPACITY_:
facet_alpha = *(stacktop)--;
break;
case SET_CONSTRAINT_:
{ int con = (int)*(stacktop--);
struct constraint *constr;
constr = get_constraint(con);
if ( (con<0) || (con>=web.maxcon) || !(constr->attr & IN_USE))
{ sprintf(errmsg,"Illegal constraint number: %d.\n",con);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1212,errmsg,RECOVERABLE);
}
if ( get_attr(id) & BOUNDARY )
{ sprintf(errmsg,
"Cannot set constraint on %s %s since it is on a boundary.\n",
typenames[id_type(id)],ELNAME(id));
kb_error(4111,errmsg,RECOVERABLE);
}
set_attr(id,CONSTRAINT);
if ( constr->attr & CON_ENERGY )
set_attr(id, BDRY_ENERGY);
if ( constr->attr & CON_CONTENT )
set_attr(id, BDRY_CONTENT);
switch ( id_type(id) )
{ case VERTEX: set_v_constraint_map(id,con);
project_v_constr(id,ACTUAL_MOVE,RESET_ONESIDEDNESS);
break;
case EDGE: set_e_constraint_map(id,con); break;
case FACET: set_f_constraint_map(id,con); break;
}
*recalc_flag = 1;
}
break;
case SET_BOUNDARY_:
{ struct boundary *bdry;
k = (int)*(stacktop--); /* boundary number */
bdry = web.boundaries+abs(k);
if ( (abs(k) >= web.bdrymax) || !(bdry->attr&IN_USE) )
{ sprintf(errmsg,"Boundary %d is not valid.\n",k);
kb_error(3374,errmsg,RECOVERABLE);
}
if ( get_attr(q_id) & BOUNDARY )
{ struct boundary *qbdry;
switch ( id_type(q_id) )
{ case VERTEX: qbdry = get_boundary(q_id); break;
case EDGE: qbdry = get_edge_boundary(q_id); break;
case FACET: qbdry = get_facet_boundary(q_id); break;
default: qbdry = NULL; /* error message below */
}
if ( qbdry == bdry ) break;
sprintf(errmsg,"%s %s already on a different boundary.\n",
typenames[id_type(q_id)],ELNAME(q_id));
kb_error(3375,errmsg,RECOVERABLE);
}
set_attr(q_id,BOUNDARY);
if ( k < 0 )
set_attr(q_id,NEGBOUNDARY);
switch(id_type(q_id))
{ case VERTEX:
{ REAL *x = get_coord(q_id);
int n;
set_boundary_num(q_id,abs(k));
for ( n = 0 ; n < SDIM ; n++ )
if ( bdry->coordf[n]->root != NULL )
x[n] = eval(bdry->coordf[n],get_param(q_id),q_id,NULL);
break;
}
case EDGE:
set_edge_boundary_num(q_id,abs(k));
break;
case FACET:
set_facet_boundary_num(q_id,abs(k));
break;
default:
sprintf(errmsg,"Bad element type for boundary.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3376,errmsg, RECOVERABLE);
}
if ( bdry->attr & CON_ENERGY )
apply_method_num(q_id,bdry->energy_method);
if ( bdry->attr & CON_CONTENT )
{ if ( (web.representation == STRING) && (id_type(q_id) == VERTEX) )
fixup_vertex_content_meths(q_id);
else if ( (web.representation == SOAPFILM) && (id_type(q_id) == EDGE) )
fixup_edge_content_meths(q_id);
}
/* go back to next element generator */
node += node->op1.skipsize - 1; /* back to start of loop */
break;
}
case SET_ORIGINAL_:
set_original(id,(int)*(stacktop--) | ((element_id)id_type(id)<right ) /* indexed */
{ int dim = (int)*(stacktop--)-1;
if ( (dim >= SDIM) || (dim < 0) )
{ sprintf(errmsg,
"Trying to set coordinate %d, in space dimension %d.\n",
dim+1,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2026,errmsg,RECOVERABLE);
}
get_coord(id)[dim] = *(stacktop--);
*recalc_flag = 1;
break;
}
/* else fall through */
case SET_COORD_2:
case SET_COORD_3: case SET_COORD_4: case SET_COORD_5:
case SET_COORD_6: case SET_COORD_7: case SET_COORD_8:
get_coord(id)[node->op2.attr_kind-SET_COORD_1] = *(stacktop--);
if ( node->op2.attr_kind-SET_COORD_1 <= SDIM ) *recalc_flag = 1;
break;
case SET_PARAM_: case SET_PARAM_1: case SET_PARAM_2:
case SET_PARAM_3: case SET_PARAM_4:
if ( get_vattr(id) & BOUNDARY )
{ struct boundary *boundary = get_boundary(id);
REAL *param = get_param(id);
REAL *xx = get_coord(id);
int pnum = node->op2.attr_kind-SET_PARAM_1;
if ( node->right ) pnum += (int)*(stacktop--);
if ( pnum > boundary->pcount )
{ sprintf(errmsg,"Parameter number is %d; maximum is %d.\n",
pnum,boundary->pcount);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1149,errmsg,RECOVERABLE);
}
param[pnum] = *(stacktop--);
for ( k = 0 ; k < SDIM ; k++ )
xx[k] = eval(boundary->coordf[k],param,id,NULL);
*recalc_flag = 1;
}
else /* just parking a value probably */
{ REAL *param = get_param(id);
int pnum = node->op2.attr_kind-SET_PARAM_1;
if ( node->right ) pnum += (int)*(stacktop--);
param[pnum] = *(stacktop--);
}
break;
case SET_FRONTBODY_:
case SET_BACKBODY_:
b_id = get_ordinal_id(BODY,(int)*(stacktop--)-1);
if ( b_id && !valid_id(b_id) )
{ sprintf(errmsg,"Invalid body in SET FRONTBODY or BACKBODY.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2027,errmsg,RECOVERABLE);
}
set_body((node->op2.attr_kind==SET_FRONTBODY_?id:inverse_id(id)),b_id);
*recalc_flag = 1;
break;
default:
sprintf(errmsg,"Unhandled SET attribute %d\n",node->op2.attr_kind);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2028,errmsg,RECOVERABLE);
break;
} /* end SET_ATTRIBUTE */
break;
/*****************************
* assignop attribute values *
* for single element assigns *
*****************************/
case SET_ATTRIBUTE_A:
{ int assign_type = node[1].op1.assigntype;
if ( node->op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
parallel_update_flag[id_type(id)] = 1; /* set when element info changed */
switch ( node->op2.attr_kind )
{ /* Those attributes not fitted for arithmetic assignment
have error test for that in yexparse() */
case SET_ORIENTATION_:
if ( *(stacktop--) >= 0.0 )
unset_attr(id,NEGBOUNDARY);
else set_attr(id,NEGBOUNDARY);
break;
case SET_EXTRA_ATTR_:
{ struct extra *ext;
int spot; /* index */
n = node->op3.extra_info & ((1<op1.localnum )
id = *(element_id*)get_localp(node->op1.localnum);
else id = q_id;
ext = EXTRAS(id_type(id)) + n;
/* get index */
spot = 0;
for ( k = 0 ; k < ext->array_spec.dim ; k++ )
{ int j = (int)(stacktop[-ext->array_spec.dim+k+1]);
spot *= ext->array_spec.sizes[k];
if ( j > ext->array_spec.sizes[k] )
{ sprintf(errmsg,
"Attribute %s index %d is %d; maximum is %d (in %s).\n",
ext->name,k+1,j,ext->array_spec.sizes[k],ext->name);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2524,errmsg,RECOVERABLE);
}
if ( j < 1 )
{ sprintf(errmsg,"Attribute %s index %d is %d; must be positive.\n",
ext->name,k,j);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3365,errmsg,RECOVERABLE);
}
spot += (int)(stacktop[-ext->array_spec.dim+k+1]) - 1;
}
stacktop -= ext->array_spec.dim;
#define ATTRCASE(type) \
switch ( assign_type ) \
{ case ASSIGN_: \
((type*)get_extra(id,n))[spot] = (type)*(stacktop--); break; \
case PLUSASSIGN_: \
((type*)get_extra(id,n))[spot] += (type)*(stacktop--); break; \
case SUBASSIGN_: \
((type*)get_extra(id,n))[spot] -= (type)*(stacktop--); break; \
case MULTASSIGN_: \
((type*)get_extra(id,n))[spot] *= (type)*(stacktop--); break; \
case DIVASSIGN_: \
((type*)get_extra(id,n))[spot] /= (type)*(stacktop--); break; \
}
switch ( ext->type )
{ case REAL_TYPE:
switch ( assign_type )
{ case ASSIGN_:
((REAL*)get_extra(id,n))[spot] = *(stacktop--); break;
case PLUSASSIGN_:
((REAL*)get_extra(id,n))[spot] += *(stacktop--); break;
case SUBASSIGN_:
((REAL*)get_extra(id,n))[spot] -= *(stacktop--); break;
case MULTASSIGN_:
((REAL*)get_extra(id,n))[spot] *= *(stacktop--); break;
case DIVASSIGN_:
((REAL*)get_extra(id,n))[spot] /= *(stacktop--); break;
}
break;
case INTEGER_TYPE:
switch ( assign_type )
{ case ASSIGN_:
((int*)get_extra(id,n))[spot] = (int)*(stacktop--); break;
case PLUSASSIGN_:
((int*)get_extra(id,n))[spot] += (int)*(stacktop--); break;
case SUBASSIGN_:
((int*)get_extra(id,n))[spot] -= (int)*(stacktop--); break;
case MULTASSIGN_:
((int*)get_extra(id,n))[spot] =
(int)(((int*)get_extra(id,n))[spot] * *(stacktop--));break;
case DIVASSIGN_:
((int*)get_extra(id,n))[spot] =
(int)(((int*)get_extra(id,n))[spot] / *(stacktop--));break;
}
break;
case ULONG_TYPE:
ATTRCASE(unsigned long int);
break;
case LONG_TYPE:
ATTRCASE(long int);
break;
case UINT_TYPE:
ATTRCASE(unsigned int);
break;
case UCHAR_TYPE:
ATTRCASE(unsigned char);
break;
case CHAR_TYPE:
ATTRCASE(char);
break;
case SHORT_TYPE:
ATTRCASE(short int);
break;
case USHORT_TYPE:
ATTRCASE(unsigned short int);
break;
case ELEMENTID_TYPE:
case VERTEX_TYPE:
case EDGE_TYPE:
case FACET_TYPE:
case BODY_TYPE:
case FACETEDGE_TYPE:
switch ( assign_type )
{ case ASSIGN_:
((element_id*)get_extra(id,n))[spot] =
*(element_id*)(stacktop--); break;
default:
kb_error(3453,
"Illegal assignment operation on element id attribute.\n",
RECOVERABLE);
}
case PTR_TYPE:
switch ( assign_type )
{ case ASSIGN_:
((char**)get_extra(id,n))[spot] =
*(char**)(stacktop--); break;
default:
kb_error(3454,
"Illegal assignment operation on pointer attribute.\n",
RECOVERABLE);
}
case BOUNDARY_TYPE:
case CONSTRAINT_TYPE:
case QUANTITY_TYPE:
case INSTANCE_TYPE:
case PROCEDURE_TYPE:
switch ( assign_type )
{ case ASSIGN_:
((int*)get_extra(id,n))[spot] =
*(int*)(stacktop--); break;
default:
kb_error(3682,
"Illegal assignment operation on attribute.\n",
RECOVERABLE);
}
}
}
break;
case SET_DENSITY_:
{ REAL density = *(stacktop--);
REAL oldvalue = 0.0;
if ( density != 1.0 ) set_attr(id,DENSITY);
switch ( id_type(id) )
{ case EDGE: oldvalue = get_edge_density(id); break;
case FACET: oldvalue = get_facet_density(id); break;
case BODY: oldvalue = get_body_density(id); break;
}
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: density += oldvalue; break;
case SUBASSIGN_: density = oldvalue - density; break;
case MULTASSIGN_: density *= oldvalue; break;
case DIVASSIGN_: density = oldvalue / density; break;
}
switch ( id_type(id) )
{ case EDGE: set_edge_density(id,density);
pressure_set_flag = 0; break;
case FACET: set_facet_density(id,density);
pressure_set_flag = 0; break;
case BODY: set_body_density(id,density);
web.gravflag = 1;
if (gravity_quantity_num >= 0 )
GEN_QUANT(gravity_quantity_num)->modulus =
web.grav_const;
break;
}
*recalc_flag = 1;
}
break;
case SET_PHASE_:
{ int phase = (int)*(stacktop--);
switch ( id_type(id) )
{ case BODY: set_b_phase(id,phase); break;
case FACET: set_f_phase(id,phase); break;
}
*recalc_flag = 1;
}
break;
case SET_VOLCONST_:
{ REAL v = *(stacktop--);
REAL oldvalue = get_body_volconst(id);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
set_body_volconst(id,v);
set_body_volume(id,get_body_volume(id)+v-oldvalue,SETSTAMP);
set_body_oldvolume(id,get_body_oldvolume(id)+v-oldvalue);
if ( everything_quantities_flag )
GEN_QUANT(get_body_volquant(id))->volconst = v;
*recalc_flag = 1;
break;
}
case SET_TARGET_:
{ REAL v = *(stacktop--);
REAL oldvalue = get_body_fixvol(id);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
if ( get_attr(id) & PRESSURE )
{ sprintf(errmsg,"Must unset body pressure before fixing target.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2029,errmsg,RECOVERABLE);
}
set_attr(id,FIXEDVOL);
set_body_fixvol(id,v);
*recalc_flag = 1;
break;
}
case SET_PRESSURE_:
{ REAL p = *(stacktop--);
REAL oldvalue = get_body_pressure(id);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: p += oldvalue; break;
case SUBASSIGN_: p = oldvalue - p; break;
case MULTASSIGN_: p = oldvalue * p; break;
case DIVASSIGN_: p = oldvalue / p; break;
}
if ( get_attr(id) & FIXEDVOL )
{ sprintf(errmsg,"Must unset body target before fixing pressure.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2030,errmsg,RECOVERABLE);
}
set_attr(id,PRESSURE);
set_body_pressure(id,p); web.pressflag = 1;
if ( everything_quantities_flag )
{ struct gen_quant *q = GEN_QUANT(get_body_volquant(id));
if ( p == 0.0 )
{ q->modulus = 1.0;
if ( !(q->flags & Q_INFO) )
{ q->flags &= ~(Q_ENERGY|Q_FIXED|Q_CONSERVED);
q->flags |= Q_INFO;
}
}
else
{ q->modulus = -p;
if ( !(q->flags & Q_ENERGY ) )
{ q->flags &= ~(Q_INFO|Q_FIXED|Q_CONSERVED);
q->flags |= Q_ENERGY;
}
}
}
*recalc_flag = 1;
break;
}
case SET_OPACITY_:
facet_alpha = *(stacktop)--;
break;
case SET_CONSTRAINT_:
{ int con = (int)*(stacktop--);
struct constraint *constr = get_constraint(con);
if ( (con<0) || (con>=web.maxcon) || !(constr->attr & IN_USE))
{ sprintf(errmsg,"Illegal constraint number: %d.\n",con);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1146,errmsg,RECOVERABLE);
}
set_attr(id,CONSTRAINT);
if ( constr->attr & CON_ENERGY )
set_attr(id, BDRY_ENERGY);
if ( constr->attr & CON_CONTENT )
set_attr(id, BDRY_CONTENT);
switch ( id_type(id) )
{ case VERTEX: set_v_constraint_map(id,con);
project_v_constr(id,ACTUAL_MOVE,RESET_ONESIDEDNESS);
break;
case EDGE: set_e_constraint_map(id,con); break;
case FACET: set_f_constraint_map(id,con); break;
}
*recalc_flag = 1;
}
break;
case SET_ORIGINAL_:
set_original(id,(int)*(stacktop--) | ((element_id)id_type(id)<right ) /* indexed */
{ int dim = (int)*(stacktop--)-1;
REAL oldvalue = get_coord(id)[dim];
REAL v;
if ( (dim >= SDIM) || (dim < 0) )
{ sprintf(errmsg,
"Trying to set coordinate %d, in space dimension %d.\n",
dim,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2031,errmsg,RECOVERABLE);
}
v = *(stacktop--);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
get_coord(id)[dim] = v;
*recalc_flag = 1;
break;
}
/* else fall through */
case SET_COORD_2:
case SET_COORD_3: case SET_COORD_4: case SET_COORD_5:
case SET_COORD_6: case SET_COORD_7: case SET_COORD_8:
{ REAL v = *(stacktop--);
REAL oldvalue = get_coord(id)[node->op2.attr_kind-SET_COORD_1];
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
get_coord(id)[node->op2.attr_kind-SET_COORD_1] = v;
if ( node->op2.attr_kind-SET_COORD_1 <= SDIM ) *recalc_flag = 1;
}
break;
case SET_PARAM_: case SET_PARAM_1: case SET_PARAM_2:
case SET_PARAM_3: case SET_PARAM_4:
if ( get_vattr(id) & BOUNDARY )
{ struct boundary *boundary = get_boundary(id);
REAL *param = get_param(id);
REAL *xx = get_coord(id);
REAL v;
int pnum = node->op2.attr_kind-SET_PARAM_1;
REAL oldvalue = param[pnum];
if ( node->right ) pnum += (int)*(stacktop--);
if ( pnum > boundary->pcount )
{ sprintf(errmsg,"Parameter number is %d; maximum is %d.\n",
pnum,boundary->pcount);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1213,errmsg,RECOVERABLE);
}
v = *(stacktop--);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
param[pnum] = v;
for ( k = 0 ; k < SDIM ; k++ )
xx[k] = eval(boundary->coordf[k],param,id,NULL);
*recalc_flag = 1;
}
else /* just parking a value probably */
{ REAL *param = get_param(id);
int pnum = node->op2.attr_kind-SET_PARAM_1;
REAL oldvalue = param[pnum];
REAL v;
if ( node->right ) pnum += (int)*(stacktop--);
v = *(stacktop--);
switch ( assign_type )
{ case ASSIGN_: break;
case PLUSASSIGN_: v += oldvalue; break;
case SUBASSIGN_: v = oldvalue - v; break;
case MULTASSIGN_: v = oldvalue * v; break;
case DIVASSIGN_: v = oldvalue / v; break;
}
param[pnum] = v;
}
break;
case SET_FRONTBODY_:
case SET_BACKBODY_:
b_id = get_ordinal_id(BODY,(int)*(stacktop--)-1);
if ( !valid_id(b_id) )
{ sprintf(errmsg,"Invalid body in SET FRONTBODY or BACKBODY.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2032,errmsg,RECOVERABLE);
}
set_body((node->op2.attr_kind==SET_FRONTBODY_?id:inverse_id(id)),b_id);
*recalc_flag = 1;
break;
default:
sprintf(errmsg,"Unhandled SET attribute %d\n",node->op2.attr_kind);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2033,errmsg,RECOVERABLE);
break;
} /* end assigned SET_ATTRIBUTE_A */
}
break;
/******************************/
/* initializing element loops */
/******************************/
case INIT_VERTEX_: /* all vertices */
*(element_id *)++stacktop = q_id; /* save old element */
*(vertex_id*)++stacktop=web.skel[VERTEX].last; /* sentinel */
*(element_id *)++stacktop = web.skel[VERTEX].used;
break;
case INIT_EDGE_VERTEX_: /* edge endpoints */
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(int *)++stacktop = 0; /* element number */
*(element_id **)++stacktop = get_edge_vertices(id);
break;
case INIT_FACET_VERTEX_: /* facet vertices */
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
if ( (web.representation == SIMPLEX) ||
(web.modeltype==LAGRANGE) ||
((web.modeltype==QUADRATIC) && (web.representation==SOAPFILM)))
{ *(element_id *)++stacktop = 0 ; /* counter */
*(element_id *)++stacktop = id ; /* facet */
}
else
{ facetedge_id fe = get_facet_fe(id);
if ( inverted(id) && web.representation==STRING && valid_id(fe) )
{ facetedge_id nextfe=fe,startfe=fe;
/* go back round to find start */
do
{ fe = nextfe;
nextfe = get_prev_edge(fe);
} while ( valid_id(nextfe) && !equal_id(nextfe,startfe) );
}
*(element_id *)++stacktop = fe; /* start */
*(element_id *)++stacktop = fe; /* current */
}
break;
case INIT_BODY_VERTEX_: /* vertices on body */
sprintf(errmsg,"Can't do body vertices yet.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1214,errmsg,RECOVERABLE);
break;
case INIT_EDGE_: /* all edges */
*(element_id *)++stacktop = q_id; /* save old element */
*(edge_id *)++stacktop = web.skel[EDGE].last; /* sentinel */
*(element_id *)++stacktop = web.skel[EDGE].used;
break;
case INIT_VERTEX_EDGE_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
if ( get_vattr(id) & Q_MIDFACET )
{ *(element_id *)++stacktop = NULLID;
*(element_id *)++stacktop = NULLID;
}
else
{ *(element_id *)++stacktop = get_vertex_edge(id);
*(element_id *)++stacktop = get_vertex_edge(id);
}
break;
case INIT_FACET_EDGE_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
if ( web.representation == STRING )
{ facetedge_id fe = get_facet_fe(id);
if ( inverted(id) && valid_id(fe) )
{ facetedge_id nextfe=fe,startfe=fe;
/* go back round to find start */
do
{ fe = nextfe;
nextfe = get_prev_edge(fe);
} while ( valid_id(nextfe) && !equal_id(nextfe,startfe) );
}
*(element_id *)++stacktop = fe; /* start */
*(element_id *)++stacktop = fe;
}
else
{ *(int *)++stacktop = 0; /* counter */
*(element_id *)++stacktop = get_facet_fe(id);
}
break;
case INIT_BODY_EDGE_:
sprintf(errmsg,"Can't do body edges yet.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1215,errmsg,RECOVERABLE);
break;
case INIT_FACET_: /* all facets */
*(element_id *)++stacktop = q_id; /* save old element */
*(facet_id *)++stacktop = web.skel[FACET].last; /* sentinel */
*(element_id *)++stacktop = web.skel[FACET].used;
break;
case INIT_VERTEX_FACET_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(element_id *)++stacktop = f_id = get_vertex_first_facet(id);
*(element_id *)++stacktop = f_id;
break;
case INIT_FACETEDGE_EDGE_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(element_id *)++stacktop = get_fe_edge(id); /* start */
*(element_id *)++stacktop = get_fe_edge(id);
break;
case INIT_FACETEDGE_FACET_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(element_id *)++stacktop = get_fe_facet(id); /* start */
*(element_id *)++stacktop = get_fe_facet(id);
break;
case INIT_EDGE_FACET_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(element_id *)++stacktop = get_edge_fe(id); /* start */
*(element_id *)++stacktop = get_edge_fe(id);
break;
case INIT_EDGE_FACETEDGE_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(element_id *)++stacktop = get_edge_fe(id); /* start */
*(element_id *)++stacktop = get_edge_fe(id);
break;
case INIT_BODY_FACET_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = q_id; /* save old element */
f_id = get_body_facet(id);
*(element_id *)++stacktop = f_id;
*(element_id *)++stacktop = f_id;
/* kludge to make things work in the face of arbitrary deletions. */
if ( valid_id(f_id) )
{ facet_id start_f = f_id;
int counter = 0;
int maxcount = 2*web.skel[FACET].count;
do
{ f_id = get_next_body_facet(f_id);
unset_attr(f_id,DID_BODYFRONTFACET|DID_BODYBACKFACET);
if ( counter++ > maxcount )
{ sprintf(errmsg,"Internal error: Body %s facet list is not closed.\n",
ELNAME(q_id));
kb_error(4376,errmsg,RECOVERABLE);
}
} while ( !equal_id(f_id,start_f) );
set_attr(f_id,(inverted(f_id)?DID_BODYBACKFACET:DID_BODYFRONTFACET));
}
break;
case INIT_BODY_: /* all bodies */
*(element_id *)++stacktop = q_id; /* save old element */
*(body_id *)++stacktop = web.skel[BODY].last; /* sentinel */
*(element_id *)++stacktop = web.skel[BODY].used;
break;
case INIT_FACET_BODY_:
if ( node->op2.localnum )
id = *(element_id*)get_localp(node->op2.localnum);
else id = q_id;
*(element_id *)++stacktop = id; /* save old element */
*(int *)++stacktop = 0; /* element number */
*(element_id *)++stacktop = NULLID;
break;
case INIT_VERTEX_BODY_:
sprintf(errmsg,"Can't do vertex bodies yet.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1216,errmsg,RECOVERABLE);
break;
case INIT_EDGE_BODY_:
sprintf(errmsg,"Can't do edge bodies yet.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1217,errmsg,RECOVERABLE);
break;
case INIT_FACETEDGE_: /* all edges */
*(element_id *)++stacktop = q_id; /* save old element */
*(edge_id *)++stacktop = web.skel[FACETEDGE].last; /* sentinel */
*(element_id *)++stacktop = web.skel[FACETEDGE].used;
break;
case SINGLE_ELEMENT_INIT_:
*(element_id *)++stacktop = q_id; /* save old element */
*(++stacktop) = 0.0 ; /* iteration count */
stacktop++; /* dummy local to pop */
break;
/*******************/
/* simple commands */
/*******************/
case NOP_:
case NULLBLOCK_:
case NULLCMD_:
break;
case DEFINE_EXTRA_:
{ int one = 1;
struct extra *ex = EXTRAS(node->op2.eltype) + node->op1.extranum;
if ( ex->array_spec.dim == 0 )
{ expand_attribute(node->op2.eltype,node->op1.extranum,&one);
ex->array_spec.datacount = 1;
ex->flags &= ~DIMENSIONED_ATTR;
}
break;
}
case DEFINE_EXTRA_INDEX_: /* have indexes tacked onto DEFINE_EXTRA_ */
{ int newsizes[MAXARRAYDIMS];
struct extra *ex = EXTRAS(node->op2.eltype) + node->op1.extranum;
for ( k = ex->array_spec.dim-1 ; k >= 0 ; k-- )
newsizes[k] = (int)*(stacktop--);
expand_attribute(node->op2.eltype,node->op1.extranum,newsizes);
break;
}
case HISTORY_:
if ( history_space == NULL ) { outstring("No history.\n"); break;}
for ( k = history_count-1 ; k >= 0 ; k-- )
{ h = history_space+history_offsets[k];
sprintf(msg,"%d) ",history_number-k); outstring(msg);
outstring(h);
}
break;
case REDIRECT_:
case REDIRECTOVER_:
{ struct stat st;
int retval;
if ( node->left ) s = *(char**)(stacktop--);
else s = node->op1.string;
*(FILE **)(++stacktop) = outfd;
retval = stat(s,&st);
outfd = NULL;
if ( ((retval == 0) && (st.st_mode & S_IFIFO))
|| (node->type==REDIRECTOVER_) )
outfd = fopen(s,"w");
else outfd = fopen(s,"a");
if ( outfd == NULL )
{
#ifdef MAC_APP
sprintf(errmsg,"Cannot open file %s. \n",s);
#else
perror(s);
sprintf(errmsg,"Cannot open redirection file %s.\n",s);
#endif
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1218,errmsg,RECOVERABLE);
}
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
}
break;
case REDIRECT_END_:
fclose(outfd);
/* outfd = stdout; */
outfd = *(FILE**)(stacktop--);
break;
case PIPE_:
if ( node->left ) s = *(char**)(stacktop--);
else s = node->op1.string;
*(FILE **)(++stacktop) = outfd;
if ( s[0] == '+' ) /* kludge to permit appending to file */
outfd = fopen(s+1,"a+");
#ifdef NOPIPE
else
outfd = fopen(s,"w");
#else
outfd = popen(s,"w");
#endif
if ( outfd == NULL )
{
outfd = *(FILE**)(stacktop--);
#ifdef MAC_APP
sprintf(errmsg,"Cannot open pipe %s. \n",s);
#else
perror(s);
sprintf(errmsg,"Cannot open pipe %s.\n",s);
#endif
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1219,errmsg,RECOVERABLE);
}
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
broken_pipe_flag = 0; /* reset */
break;
case PIPE_END_:
#ifdef NOPIPE
fclose(outfd);
#else
pclose(outfd);
#endif
/* outfd = stdout; */
outfd = *(FILE**)(stacktop--);
break;
case DEBUG_:
outstring(yydebug?"YACC debugging was ON.":
"YACC debugging was OFF.\n");
yydebug = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(yydebug?"Now ON.\n":"Now OFF.\n");
break;
case ITDEBUG_:
outstring(itdebug?"Iteration debugging was ON.":
"Iteration debugging was OFF.\n");
itdebug = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(itdebug?"Now ON.\n":"Now OFF.\n");
break;
case MEMDEBUG_:
old = memdebug;
memdebug = (node->op1.toggle_state==ON_) ? 1 : 0;
#ifdef M_DEBUG
mallopt(M_DEBUG,memdebug);
#endif
outstring(memdebug?"Memory debugging ON.":
"Memory debugging OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case RECALC_: recalc(); break;
case CLOSE_SHOW_: close_graphics(); break;
case TOPINFO_:
oldquiet = quiet_flag; quiet_flag = 0;
top_dump(outfd);
quiet_flag = oldquiet;
break;
case BOTTOMINFO_:
oldquiet = quiet_flag; quiet_flag = 0;
bottom_dump(outfd);
quiet_flag = oldquiet;
break;
case LIST_QUANTITY_:
list_quantity(node->op1.quant_id);
break;
case LIST_METHOD_INSTANCE_:
list_method_instance(node->op1.meth_id);
break;
case LIST_CONSTRAINT_:
k = (int)(*(stacktop--));
if ( k < 0 || k >= web.maxcon || !(get_constraint(k)->attr & IN_USE) )
kb_error(3614,"Invalid constraint for list_constraint.",
RECOVERABLE);
list_constraint(k);
break;
case LIST_BOUNDARY_:
k = (int)(*(stacktop--));
if ( k < 0 || k >= web.bdrymax || !(web.boundaries[k].attr & IN_USE) )
kb_error(3615,"Invalid boundary for list_boundary.",
RECOVERABLE);
list_boundary(k);
break;
case LIST_PROCS_:
oldquiet = quiet_flag; quiet_flag = 0;
list_procedures(LIST_PROTO);
quiet_flag = oldquiet;
break;
case LIST_ATTRIBUTES_:
oldquiet = quiet_flag; quiet_flag = 0;
outstring("//Element attributes: \n");
list_attributes();
quiet_flag = oldquiet;
break;
case PRINT_ARRAY_:
oldquiet = quiet_flag; quiet_flag = 0;
print_array(globals(node->op1.name_id)->attr.arrayptr,NULL);
quiet_flag = oldquiet;
break;
case PRINT_ARRAY_LVALUE_:
{ struct array *a,kludge;
oldquiet = quiet_flag; quiet_flag = 0;
a = get_name_arrayptr(node->op2.name_id,localstack,localbase);
if ( node[node->left].flags & IS_VIRTUAL_ATTR )
{ kludge = *a;
kludge.datacount = SDIM;
kludge.sizes[0] = SDIM;
a = &kludge;
}
print_array(a,*(char**)(stacktop--));
quiet_flag = oldquiet;
break;
}
case PRINT_ARRAYPART_:
{ struct array *part;
struct global *g = globals(node[node->left].op1.name_id);
int offset = 0;
struct array *a;
if ( g->flags & GLOB_LOCALVAR )
a = *(struct array **)(localstack+g->value.offset);
else
a = g->attr.arrayptr;
part = (struct array *)temp_calloc(1,sizeof(struct array)+
a->dim*sizeof(int));
part->dim = a->dim - node->op1.indexcount;
part->datatype = a->datatype;
part->itemsize = a->itemsize;
part->datacount = a->datacount;
part->datastart = a->datastart +
((char*)(a) - (char*)part);
for ( n = 0; n < node->op1.indexcount ; n++ )
{ int size = a->sizes[n];
int inx = (int)*(stacktop - node->op1.indexcount + n + 1) - 1;
if ( inx >= size )
{ sprintf(errmsg,
"Index %d of array %s is %d; exceeds declared size, %d\n",
n+1,g->name,inx+1,size);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2610,errmsg,RECOVERABLE);
}
if ( size ) part->datacount /= size;
offset *= size;
offset += inx;
}
stacktop -= n;
for ( k = 0 ; n < a->dim ; n++,k++ )
{ int size = a->sizes[n];
part->sizes[k] = size;
offset *= size;
}
part->datastart += offset*part->itemsize;
msg[0] = 0;
oldquiet = quiet_flag; quiet_flag = 0;
print_array(part,NULL);
quiet_flag = oldquiet;
temp_free((char*)part);
break;
}
case PRINT_ATTR_ARRAY_:
{ struct array *part;
struct extra *ext;
int offset = 0;
n = node->op3.extranum; /* attribute number */
id = *(element_id*)get_localp((node+node->left)->op2.localnum);
ext = EXTRAS(node->op2.eltype) + n;
part = (struct array *)temp_calloc(1,sizeof(struct array)+
ext->array_spec.dim*sizeof(int));
part->dim = ext->array_spec.dim - node->op1.indexcount;
part->datatype = ext->type;
part->itemsize = ext->array_spec.itemsize;
part->datacount = ext->array_spec.datacount;
part->datastart = (char*)get_extra(id,n) - (char*)part;
for ( n = 0; n < node->op1.indexcount ; n++ )
{ int size = ext->array_spec.sizes[n];
int inx = (int)*(stacktop - node->op1.indexcount + n + 1) - 1;
if ( inx >= size )
{ sprintf(errmsg,
"Index %d of attribute %s is %d; exceeds declared size, %d\n",
n+1,ext->name,inx+1,size);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2645,errmsg,RECOVERABLE);
}
if ( size ) part->datacount /= size;
offset *= size;
offset += inx;
}
stacktop -= n;
for ( k = 0 ; n < ext->array_spec.dim ; n++,k++ )
{ int size = ext->array_spec.sizes[n];
part->sizes[k] = size;
offset *= size;
}
part->datastart += offset*part->itemsize;
msg[0] = 0;
oldquiet = quiet_flag; quiet_flag = 0;
print_array(part,NULL);
quiet_flag = oldquiet;
temp_free((char*)part);
break;
}
case DIRICHLET_:
case DIRICHLET_SEEK_:
scale = dirichlet(node->type==DIRICHLET_?0:1);
recalc();
#ifdef LONGDOUBLE
sprintf(msg,"%3d. energy: %#*.*Lg scale: %#g\n",gocount,
DWIDTH,DPREC, web.total_energy,(DOUBLE)scale);
#else
sprintf(msg,"%3d. %s: %#17.15g energy: %#17.15g scale: %#g\n",gocount,
areaname,web.total_area,web.total_energy,scale);
#endif
outstring(msg);
break;
case SOBOLEV_:
case SOBOLEV_SEEK_:
scale = sobolev(node->type==SOBOLEV_?0:1);
recalc();
#ifdef LONGDOUBLE
sprintf(msg,"%3d. energy: %#*.*Lg scale: %#g\n",gocount,
DWIDTH,DPREC,web.total_energy,(DOUBLE)scale);
#else
sprintf(msg,"%3d. %s: %#17.15g energy: %#17.15g scale: %#g\n",gocount,
areaname,web.total_area,web.total_energy,scale);
#endif
outstring(msg);
break;
case HESSIAN_SEEK_:
{ REAL maxscale;
if ( node->left ) maxscale = *(stacktop--);
else maxscale = 10.;
scale = hessian_seek(maxscale);
recalc();
#ifdef LONGDOUBLE
sprintf(msg,"%3d. energy: %#*.*Lg scale: %#g\n",gocount,
DWIDTH,DPREC,web.total_energy,(DOUBLE)scale);
#else
sprintf(msg,"%3d. %s: %#17.15g energy: %#17.15g scale: %#g\n",
gocount, areaname,web.total_area,web.total_energy,scale);
#endif
outstring(msg);
}
break;
case HESSIAN_SADDLE_:
{ REAL maxscale;
if ( node->left ) maxscale = *(stacktop--);
else maxscale = 100.;
hessian_saddle(maxscale);
}
break;
case HESSIAN_MENU_:
if ( hessian_subshell_flag )
{ kb_error(3633,"Can't do hessian_menu in a hessian subshell.\n",WARNING);
break;
}
hessian_menu();
recalc();
#ifdef LONGDOUBLE
sprintf(msg,"%3d. energy: %#*.*Lg \n",1,
DWIDTH,DPREC,web.total_energy);
#else
sprintf(msg,"%3d. %s: %#17.15g energy: %#17.15g \n",1,
areaname,web.total_area,web.total_energy);
#endif
outstring(msg);
break;
case HESSIAN_ :
hessian_auto();
recalc();
#ifdef LONGDOUBLE
sprintf(msg,"%3d. energy: %#*.*Lg \n",gocount, DWIDTH,
DPREC,web.total_energy);
#else
sprintf(msg,"%3d. %s: %#17.15g energy: %#17.15g\n",gocount,
areaname,web.total_area,web.total_energy);
#endif
outstring(msg);
break;
case SHELL_: /* execute subshell */
#if defined(__WIN32__) || defined(_WIN32)
spawnlp(P_WAIT,"command",NULL);
#else
#if defined(MAC_APP) || defined(MAC_CW)
kb_error(1221,"No subshell on Mac.\n",RECOVERABLE);
#else
if ( fork() == 0 )
{ execlp("sh","sh",NULL);
perror("sh");
}
else wait(NULL);
#endif
#endif
break;
case SHOW_TRANS_:
view_transform(*(char**)(stacktop--));
update_display();
break;
case CHECK_:
run_checks();
break;
case CONVERT_TO_QUANTS_:
if ( everything_quantities_flag )
outstring("Everything already quantities.\n");
else
{ convert_to_quantities();
recalc();
}
break;
case SHOW_VOL_:
show_volumes();
break;
case LOGFILE_:
start_logfile(*(char**)(stacktop--));
outstring("Logfile ON.\n");
break;
case KEYLOGFILE_:
start_keylogfile(*(char**)(stacktop--));
outstring("Keylogfile ON.\n");
break;
case GEOMVIEW_:
geomview_command(*(char**)(stacktop--));
break;
case IS_DEFINED_:
*stacktop = (identcase(*(char**)stacktop) != NEWIDENT_);
break;
case REPARTITION_:
#ifdef MPI_EVOLVER
mpi_repartition();
update_display();
#else
kb_error(5005,"'Repartition' command only implemented in MPI Evolver.\n",
WARNING);
#endif
break;
case EXEC_:
command(*(char**)(stacktop--),NO_HISTORY);
break;
case PARALLEL_EXEC_:
#ifdef MPI_EVOLVER
mpi_parallel_exec(*(char**)(stacktop--));
#else
command(*(char**)(stacktop--),NO_HISTORY);
#endif
break;
case TASK_EXEC_:
{ int task = (int)(stacktop[-1]);
#ifdef MPI_EVOLVER
if ( task == 0 ) command(*(char**)(stacktop--),NO_HISTORY);
else if ( task >= mpi_nprocs )
{ sprintf(errmsg,"Node number %d exceeds maximum node number, %d.\n",
task,mpi_nprocs-1);
kb_error(3167,errmsg,RECOVERABLE);
}
else if ( task < 0 )
{ sprintf(errmsg,"Node number %d is negative!\n", task);
kb_error(3168,errmsg,RECOVERABLE);
}
else
mpi_task_exec(task,*(char**)(stacktop--));
#else
if ( task != 0 )
kb_error(3169,"Node_exec node number must be 0 for non-MPI Evolver.\n",RECOVERABLE);
command(*(char**)(stacktop--),NO_HISTORY);
#endif
stacktop--; /* pop node number */
}
break;
case SYSTEM_:
system(*(char**)(stacktop--));
break;
case CHDIR_:
#ifdef MSC
k = _chdir(*(char**)(stacktop--));
if ( k < 0 )
{ sprintf(errmsg,"Unable to change directory. \n");
if ( !strchr(*(char**)(stacktop+1),'\\') )
strcat(errmsg,"Try using \\\\ or / instead of \\.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2034,errmsg,RECOVERABLE);
}
#else
k = chdir(*(char**)(stacktop--));
if ( k < 0 )
{ sprintf(errmsg,"Unable to change to directory \"%s\".\n",
*(char**)(stacktop+1));
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1116,errmsg,RECOVERABLE);
}
#endif
break;
case READ_:
if ( read_depth <= 1 ) warning_messages_new = 0;
exec_file(NULL,*(char**)(stacktop--));
break;
case VIEW_TRANSFORM_SWAP_COLORS_:
{ int k = (int)(*stacktop--);
if ( (k < 1) || (k > transform_count) )
{ sprintf(errmsg,
"Invalid index %d to view_transform_swap_colors.\n",k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2518,errmsg, RECOVERABLE);
}
if ( !transform_colors ) *(++stacktop) = 0;
else
*(++stacktop) = (transform_colors[k-1] == SWAP_COLORS);
break;
}
case VIEW_TRANSFORM_PARITY_:
{ int k = (int)(*stacktop--);
if ( !transform_parity )
*(++stacktop) = 1;
else
*(++stacktop) = transform_parity[k-1];
break;
}
case VIEW_TRANSFORMS_:
read_transforms((int)(*stacktop--));
break;
case VIEW_TRANSFORMS_NOP_:
break; /* just to get first two indices on stack */
case VIEW_TRANSFORMS_ELEMENT_:
{ int k = (int)(*stacktop--);
int j = (int)(*stacktop--);
int i = (int)(*stacktop--);
if ( i < 1 )
{ sprintf(errmsg,
"View_transforms index 1 is %d, must be at least 1.\n",i);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2036,errmsg,RECOVERABLE);
}
if ( j < 1 )
{ sprintf(errmsg,
"View_transforms index 2 is %d, must be at least 1.\n",j);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2037,errmsg,RECOVERABLE);
}
if ( k < 1 )
{ sprintf(errmsg,
"View_transforms index 3 is %d, must be at least 1.\n",k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2038,errmsg,RECOVERABLE);
}
if ( (view_transforms == 0) && (i == 1))
{ *(++stacktop) = (j==k) ? 1 : 0; break; }
if ( i > transform_count )
{ sprintf(errmsg,
"View_transforms index 1 is %d, must be at most transform_count %d.\n",i,transform_count);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2039,errmsg,RECOVERABLE);
}
if ( j > 4 )
{ sprintf(errmsg,
"View_transforms index 2 is %d, must be at most 4.\n",j);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2040,errmsg,RECOVERABLE);
}
if ( k > 4 )
{ sprintf(errmsg,
"View_transforms index 3 is %d, must be at most 4.\n",k);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2041,errmsg,RECOVERABLE);
}
*(++stacktop) = view_transforms[i-1][j-1][k-1];
break;
}
case TRANSFORM_DEPTH_:
generate_transforms((int)(*stacktop--));
update_display();
break;
case TRANSFORM_EXPR_:
calc_view_transform_gens();
transform_gen_expr(*(char**)(stacktop--));
update_display();
break;
case DEFINE_METHOD_INSTANCE_:
case DEFINE_QUANTITY_:
case DEFINE_CONSTRAINT_:
case DEFINE_BOUNDARY_:
/* was parse-time action */
break;
case GRAVITY_:
old = web.gravflag;
web.gravflag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(web.gravflag ? "Gravity ON." : "Gravity OFF.");
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case TOGGLEVALUE:
*++stacktop = (REAL)get_toggle_value(node->op1.toggle_id);
break;
case FACET_COLORS_:
old = color_flag;
color_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(color_flag ? "Facet colors ON.":
"Facet colors OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case SHADING_:
old = shading_flag;
shading_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(shading_flag ? "Facet shading ON.":
"Facet shading OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case PREPRINTF_:
case PRESPRINTF_:
break;
case GO_:
iterate();
break;
default:
more_other_stuff(node,recalc_flag,
update_display_flag,q_id,localstack,localbase);
break;
}
} /* end other_stuff() */
/******************************************************************
*
* Function: flip_toggle()
*
* Purpose: Utility function to flip a toggle. Put here so Mac 68K
* can make a short jump to it within this file.
*/
void flip_toggle(flag,newstate,phrase)
int *flag; /* toggle variable */
int newstate;
char *phrase; /* to print */
{ int old;
old = *flag;
*flag = (newstate==ON_) ? 1 : 0;
outstring(phrase);
outstring(*flag ? " ON." : " OFF.");
if ( old < 0 ) outstring(" (was unset)\n");
else if ( old == 0 ) outstring(" (was off)\n");
else outstring(" (was on)\n");
}
/************************************************************************
*
* Function: more_other_stuff()
*
* Purpose: execute command nodes, overflow from eval() and other_stuff().
*
* Return: stacktop pointer
*
*/
void more_other_stuff(node,recalc_flag,update_display_flag,q_id,
localstack,localbase)
struct treenode * node;
int *recalc_flag;
int *update_display_flag;
element_id q_id;
REAL *localstack;
struct locallist_t *localbase;
{
char response[100];
int old; /* old state of toggle */
int n,i;
char *s;
int oldquiet; /* old state of quiet_flag */
struct thread_data *td = GET_THREAD_DATA;
#define newstack (td->eval_stack)
#define stackmax (td->eval_stack_size)
#define stacktop (td->stack_top)
#define this_frame ((struct eval_frame*)(newstack + td->frame_spot))
switch ( node->type )
{
case WRAP_VERTEX_:
{ vertex_id v_id = get_ordinal_id(VERTEX,(int)(stacktop[-1])-1);
int wrap = (int)(stacktop[0]);
stacktop -= 2;
if ( !web.symmetry_flag || !wrap ) break;
wrap_vertex(v_id,wrap);
*update_display_flag = 1;
}
break;
case NORMAL_MOTION_:
old = normal_motion_flag;
normal_motion_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(normal_motion_flag ? "Normal motion ON.":
"Normal motion OFF.");
outstring(old?" (was on)\n":" (was off)\n");
if ( normal_motion_flag )
begin_normal_motion();
else end_normal_motion();
break;
case VIEW_4D_:
old = view_4D_flag;
view_4D_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(view_4D_flag ? "4D graphics ON." :
"4D graphics OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case PINNING_:
old = check_pinning_flag;
check_pinning_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(check_pinning_flag ? "Constraint pinning ON." :
"Constraint pinning OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case METRIC_CONVERSION_:
old = metric_convert_flag;
metric_convert_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(metric_convert_flag ? "Metric conversion ON." :
"Metric conversion OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case SELF_SIMILAR_:
old = self_similar_flag;
self_similar_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(self_similar_flag ? "Self similarity mode ON." :
"Self similarity mode OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case GV_BINARY_:
old = gv_binary_flag;
gv_binary_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(gv_binary_flag ? "Geomview binary mode ON." :
"Geomview binary mode OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case KUSNER_:
old = kusner_flag;
kusner_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
conf_edge_curv_flag = 0;
outstring(kusner_flag ? "Edge square curvature ON." :
"Edge square curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case BOUNDARY_CURVATURE_:
old = boundary_curvature_flag;
boundary_curvature_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(boundary_curvature_flag ? "Boundary curvature ON." :
"Boundary curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case CONF_EDGE_SQCURV_:
old = conf_edge_curv_flag;
conf_edge_curv_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
kusner_flag = 0;
outstring(conf_edge_curv_flag ?
"Conformal edge square curvature ON." :
"Conformal edge square curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case POST_PROJECT_:
old = post_project_flag;
post_project_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(post_project_flag ? "Post-projection ON." :
"Post-projection OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case MEAN_CURV_INT_:
old = mean_curv_int_flag;
mean_curv_int_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(mean_curv_int_flag ? "Mean curvature integral ON." :
"Mean curvature integral OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case AUTORECALC_:
old = autorecalc_flag;
autorecalc_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(autorecalc_flag ? "Autorecalc ON." : "Autorecalc OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case FORCE_POS_DEF_:
old = make_pos_def_flag;
make_pos_def_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(make_pos_def_flag ? "Force positive definite ON." :
"Force positive definite OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case ESTIMATE_:
old = estimate_flag;
estimate_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(estimate_flag ? "Estimation ON." : "Estimation OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case TRANSFORMS_:
old = transforms_flag;
transforms_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(transforms_flag ? "Transform showing ON." :
"Transform showing OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case DETURCK_:
old = unit_normal_flag;
unit_normal_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(sqgauss_flag ? "Unit normal motion ON." :
"Unit normal motion OFF.");
if ( unit_normal_flag )
{ sprintf(msg,"Enter unit normal weight factor(%g): ",
(DOUBLE)deturck_factor);
prompt(msg,response,sizeof(response));
const_expr(response,&deturck_factor);
}
outstring(old?" (was on)\n":" (was off)\n");
break;
case SQGAUSS_:
old = sqgauss_flag;
sqgauss_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(sqgauss_flag ? "Squared Gaussian curvature ON." :
"Squared Gaussian curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case STABILITY_TEST_:
stability_test();
break;
case AUTOPOP_:
old = autopop_flag;
autopop_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(autopop_flag ? "Autopopping ON.\n" : "Autopopping OFF.\n");
outstring(old?" (was on)\n":" (was off)\n");
if ( autopop_flag )
{ n = 0;
if ( web.representation == STRING )
sprintf(msg,"Number of vertices popped: %d\n",
web.vertex_pop_count = n=verpop_str());
else
sprintf(msg,"Number of vertices popped: %d\n",
web.vertex_pop_count = n = edgepop_film());
outstring(msg);
if ( n > 0 ) recalc();
}
break;
case AUTOPOP_QUARTIC_:
old = autopop_quartic_flag;
autopop_quartic_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(autopop_quartic_flag ? "Autopop quartic mode ON.\n" :
"Autopop quartic mode OFF.\n");
outstring(old?" (was on)\n":" (was off)\n");
break;
case IMMEDIATE_AUTOPOP_:
old = immediate_autopop_flag;
immediate_autopop_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(immediate_autopop_flag ? "Immediate autopop mode ON.\n" :
"Immediate autopop mode OFF.\n");
outstring(old?" (was on)\n":" (was off)\n");
break;
case AUTOCHOP_:
old = autochop_flag;
autochop_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
if ( autochop_flag )
{
sprintf(msg,"Autochopping ON. Chop length %g ",(DOUBLE)autochop_length);
outstring(msg);
outstring(old?" (was on)\n":" (was off)\n");
outstring("Set autochop length with AUTOCHOP := value\n");
}
else
{ outstring("Autochopping OFF.");
outstring(old?" (was on)\n":" (was off)\n");
}
break;
case UTEST_:
simplex_delaunay_test();
break;
case OLD_AREA_:
old = old_area_flag;
old_area_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(old_area_flag ? "old_area ON." : "old_area OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case APPROX_CURV_:
old = approx_curve_flag;
approx_curve_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(approx_curve_flag ? "approx_curvature ON." :
"approx_curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case H_INVERSE_METRIC_:
old = web.h_inverse_metric_flag;
web.h_inverse_metric_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(web.h_inverse_metric_flag ? "h_inverse_metric ON." :
"h_inverse_metric OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case ASSUME_ORIENTED_:
old = assume_oriented_flag;
assume_oriented_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(assume_oriented_flag ? "assume_oriented ON." :
"assume_oriented OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case OOGLFILE_:
strncpy(pix_file_name,*(char**)(stacktop--),sizeof(pix_file_name));
do_gfile('2',pix_file_name);
break;
case BINARY_OFF_FILE_:
strncpy(pix_file_name,*(char**)(stacktop--),sizeof(pix_file_name));
do_gfile('7',pix_file_name);
break;
case POSTSCRIPT_:
if ( ps_colorflag < 0 ) ps_colorflag = 0 ;
if ( gridflag < 0 ) gridflag = 0;
if ( crossingflag < 0 ) crossingflag = 0;
if ( labelflag < 0 ) labelflag = 0;
if ( torus_display_mode == TORUS_DEFAULT_MODE )
{ torus_display_mode = TORUS_RAW_MODE;
web.torus_body_flag = 0;
web.torus_clip_flag = 0;
}
strncpy(ps_file_name,*(char**)(stacktop--),sizeof(ps_file_name));
do_gfile('3',ps_file_name);
break;
case SET_CONSTRAINT_GLOBAL:
{ int connum = (int)(*stacktop--);
struct constraint *con = get_constraint(connum);
if ( !(con->attr & GLOBAL) )
{ vertex_id v_id;
con->attr |= GLOBAL;
web.con_global_map[web.con_global_count++] = (conmap_t)connum;
FOR_ALL_VERTICES(v_id)
set_v_constraint_map(v_id,connum);
}
}
break;
case UNSET_CONSTRAINT_GLOBAL:
{ int connum = (int)(*stacktop--);
struct constraint *con = get_constraint(connum);
con->attr &= ~GLOBAL;
for ( i = 0 ; i < web.con_global_count ; i++ )
if ( web.con_global_map[i] == connum )
{ web.con_global_map[i] =
web.con_global_map[--web.con_global_count];
break;
}
}
break;
case SET_CONSTRAINT_NAME_GLOBAL:
{ int connum = node->op3.connum;
struct constraint *con = get_constraint(connum);
if ( !(con->attr & GLOBAL) )
{ vertex_id v_id;
con->attr |= GLOBAL;
web.con_global_map[web.con_global_count++] = (conmap_t)connum;
FOR_ALL_VERTICES(v_id)
set_v_constraint_map(v_id,connum);
}
}
break;
case UNSET_CONSTRAINT_NAME_GLOBAL:
{ int connum = node->op3.connum;
struct constraint *con = get_constraint(connum);
con->attr &= ~GLOBAL;
for ( i = 0 ; i < web.con_global_count ; i++ )
if ( web.con_global_map[i] == connum )
{ web.con_global_map[i] =
web.con_global_map[--web.con_global_count];
break;
}
}
break;
case GEOMPIPE_: /* to command */
old = geompipe_flag;
do_gfile('C',*(char**)(stacktop--));
break;
case GEOMPIPE_TOGGLE_:
old = geompipe_flag;
do_gfile((node->op1.toggle_state==ON_) ? 'A' : 'B',NULL);
outstring(geompipe_flag ? "geompipe ON." :
"geompipe OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case GEOMVIEW_TOGGLE_:
old = geomview_flag;
if ( !geomview_flag && (node->op1.toggle_state==ON_) )
do_gfile( '8',NULL);
else if ( geomview_flag && !(node->op1.toggle_state==ON_) )
do_gfile( '9',NULL);
outstring(geomview_flag ? "geomview ON." :
"geomview OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case LOGFILE_TOGGLE_:
old = logfile_flag;
if ( !logfile_flag && (node->op1.toggle_state==ON_) )
start_logfile(NULL);
else if ( logfile_flag && (node->op1.toggle_state!=ON_) )
stop_logfile();
outstring(logfile_flag ? "Logfile ON." :
"Logfile OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case KEYLOGFILE_TOGGLE_:
old = keylogfile_flag;
if ( !keylogfile_flag && (node->op1.toggle_state==ON_) )
start_keylogfile(NULL);
else if ( keylogfile_flag && (node->op1.toggle_state!=ON_) )
stop_keylogfile();
outstring(keylogfile_flag ? "Keylogfile ON." :
"Keylogfile OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case JIGGLE_TOGGLE_:
old = web.jiggle_flag;
web.jiggle_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(web.jiggle_flag ? "jiggling ON." :
"jiggling OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case RIBIERE_CG_:
old = ribiere_flag;
ribiere_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(ribiere_flag ? "Polak-Ribiere conjugate gradient ON." :
"Polak-Ribiere conjugate gradient OFF.");
outstring(old?" (was on)\n":" (was off)\n");
reset_conj_grad();
break;
case CONJ_GRAD_:
old = conj_grad_flag;
conj_grad_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
reset_conj_grad();
if ( conj_grad_flag )
{
outstring("Conjugate gradient now ON.");
outstring(old?" (was on)\n":" (was off)\n");
if ( web.motion_flag )
{ sprintf(errmsg,
"Fixed scale is ON! Not a good idea with conjugate gradient.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1223,errmsg,WARNING);
}
}
else
{
outstring("Conjugate gradient now OFF.");
outstring(old?" (was on)\n":" (was off)\n");
}
break;
case MEAN_CURV_:
web.norm_check_flag = 0; /* default OFF */
old = web.area_norm_flag;
web.area_norm_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
if ( web.area_norm_flag )
{ outstring("Area normalization ON.");
}
else
{ outstring("Area normalization OFF.");
}
outstring(old?" (was on)\n":" (was off)\n");
calc_energy(); /* to make sure vertex areas set */
break;
case SHOW_ALL_QUANTITIES_:
flip_toggle(&show_all_quantities,node->op1.toggle_state,"show_all_quantities");
break;
case PSCOLORFLAG_:
flip_toggle(&ps_colorflag,node->op1.toggle_state,"pscolorflag");
break;
case GRIDFLAG_:
flip_toggle(&gridflag,node->op1.toggle_state,"gridflag");
break;
case CROSSINGFLAG_:
flip_toggle(&crossingflag,node->op1.toggle_state,"crossingflag");
break;
case LABELFLAG_:
flip_toggle(&labelflag,node->op1.toggle_state,"labelflag");
break;
case TORUS_FILLED_:
if ( !web.torus_flag )
{
sprintf(errmsg,
"torus_filled is invalid toggle because not in torus model.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2042,errmsg, WARNING);
break;
}
flip_toggle(&web.full_flag,node->op1.toggle_state,"torus_filled");
break;
case VERBOSE_:
old = verbose_flag;
verbose_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(verbose_flag ? "Verbose ON." : "Verbose OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case QUIET_:
old = quiet_flag;
quiet_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(quiet_flag ? "Quiet ON." : "Quiet OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case QUIETLOAD_:
old = quiet_load_flag;
quiet_load_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(quiet_load_flag ? "QuietLoad ON." : "QuietLoad OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case FUNCTION_QUANTITY_SPARSE_:
old = quantity_function_sparse_flag;
quantity_function_sparse_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(quantity_function_sparse_flag ?
"function_quantity_sparse ON." : "function_quantity_sparse OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case FORCE_DELETION_:
old = force_deletion;
force_deletion = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(force_deletion ?
"force_deletion ON." : "force_deletion OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case STAR_FINAGLING_:
old = star_finagling;
star_finagling = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(star_finagling ?
"star_finagling ON." : "star_finagling OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case SLICE_VIEW_:
old = slice_view_flag;
slice_view_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(slice_view_flag ? "slice_view ON." : "slice_view OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case CLIP_VIEW_:
old = clip_view_flag;
clip_view_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(clip_view_flag ? "clip_view ON." : "clip_view OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case BACKCULL_:
old = backcull_flag;
backcull_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(backcull_flag ? "backcull ON." : "backcull OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case VOLGRADS_EVERY_:
old = volgrads_every_flag;
volgrads_every_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(volgrads_every_flag ? "Volgrads_every ON." : "Volgrads_every OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case ZENER_DRAG_:
old = zener_drag_flag;
zener_drag_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(zener_drag_flag ? "Zener_drag ON." : "Zener_drag OFF.");
outstring(old?" (was on)":" (was off)");
{ int zd = lookup_global(ZENER_COEFF_NAME);
if ( zd >= 0 )
sprintf (msg," (%s: %g)\n",ZENER_COEFF_NAME,(double)globals(zd)->value.real);
else sprintf(msg," (%s not set)\n",ZENER_COEFF_NAME);
outstring(msg);
}
break;
case QUIETGO_:
old = quiet_go_flag;
quiet_go_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(quiet_go_flag ? "QuietGo ON." : "QuietGo OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case DIRICHLET_MODE_:
if ( !everything_quantities_flag )
{ convert_to_quantities();
recalc();
}
flip_toggle(&dirichlet_flag,node->op1.toggle_state,"Dirichlet area mode");
sobolev_flag = 0;
break;
case RGB_COLORS_FLAG_:
flip_toggle(&rgb_colors_flag,node->op1.toggle_state,"RGB colors");
update_display();
break;
case BREAK_AFTER_WARNING_:
flip_toggle(&break_after_warning,node->op1.toggle_state,
"Break after warning");
break;
case BLAS_FLAG_:
#ifdef BLAS
flip_toggle(&blas_flag,node->op1.toggle_state,"using BLAS");
#else
sprintf(errmsg,"This Evolver not compiled with BLAS.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2472,errmsg,WARNING);
#endif
break;
case AUGMENTED_HESSIAN_:
flip_toggle(&augmented_hessian_flag,node->op1.toggle_state,
"augmented Hessian");
if ( augmented_hessian_flag )
{ if ( !sparse_constraints_flag )
flip_toggle(&sparse_constraints_flag,node->op1.toggle_state,
"sparse constraints");
}
break;
case SPARSE_CONSTRAINTS_:
flip_toggle(&sparse_constraints_flag,node->op1.toggle_state,
"sparse constraints");
if ( !sparse_constraints_flag && augmented_hessian_flag )
flip_toggle(&augmented_hessian_flag,node->op1.toggle_state,
"augmented Hessian");
break;
case VISIBILITY_TEST_:
flip_toggle(&visibility_test,node->op1.toggle_state,"visibility test");
update_display();
break;
case CIRCULAR_ARC_DRAW_:
flip_toggle(&circular_arc_flag,node->op1.toggle_state,"Circular arc drawing");
break;
case KRAYNIKPOPVERTEX_FLAG_:
flip_toggle(&kraynikpopvertex_flag,node->op1.toggle_state,"Kraynik pop vertex mode");
break;
case KRAYNIKPOPEDGE_FLAG_:
flip_toggle(&kraynikpopedge_flag,node->op1.toggle_state,"Kraynik pop edge mode");
break;
case SMOOTH_GRAPH_:
flip_toggle(&smooth_graph_flag,node->op1.toggle_state,"smooth graph");
update_display();
break;
case FULL_BOUNDING_BOX_:
flip_toggle(&full_bounding_box_flag,node->op1.toggle_state,
"full_bounding_box");
update_display();
break;
case POP_TO_EDGE_:
flip_toggle(&pop_to_edge_flag,node->op1.toggle_state,"pop_to_edge");
if ( pop_to_edge_flag ) pop_to_face_flag = 0;
break;
case POP_TO_FACE_:
flip_toggle(&pop_to_face_flag,node->op1.toggle_state,"pop_to_face");
if ( pop_to_face_flag ) pop_to_edge_flag = 0;
break;
case POP_DISJOIN_:
flip_toggle(&pop_disjoin_flag,node->op1.toggle_state,"pop_disjoin");
if ( pop_disjoin_flag )
pop_enjoin_flag = 0;
break;
case POP_ENJOIN_:
flip_toggle(&pop_enjoin_flag,node->op1.toggle_state,"pop_enjoin");
if ( pop_enjoin_flag )
pop_disjoin_flag = 0;
break;
case BIG_ENDIAN_:
flip_toggle(&big_endian_flag,node->op1.toggle_state,"big_endian");
if ( big_endian_flag )
little_endian_flag = 0;
break;
case LITTLE_ENDIAN_:
flip_toggle(&little_endian_flag,node->op1.toggle_state,
"little_endian");
if ( little_endian_flag )
big_endian_flag = 0;
break;
case MPI_DEBUG_:
flip_toggle(&mpi_debug,node->op1.toggle_state,"mpi_debug");
update_display();
#ifdef MPI_EVOLVER
mpi_synch_mpi_debug();
#endif
break;
case BEZIER_BASIS_:
{ int dim,k;
old = bezier_flag;
bezier_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(bezier_flag ? "bezier_basis ON." :
"bezier_basis OFF.");
outstring(old?" (was on)\n":" (was off)\n");
/* wipe old polynomials and reinitialize */
for ( dim = 1 ; dim < MAXCOORD ; dim++ )
for ( k = 1 ; k <= maxgaussorder[dim] ; k++ )
{ struct gauss_lag *gl = &gauss_lagrange[dim][k];
if ( gl == NULL ) continue;
gauss_lagrange_setup(dim,web.lagrange_order,k);
}
if ( web.modeltype == LAGRANGE )
{ if ( !old && bezier_flag )
lagrange_to_bezier();
if ( old && !bezier_flag )
bezier_to_lagrange();
}
recalc();
break;
}
case SOBOLEV_MODE_:
if ( !everything_quantities_flag )
{ convert_to_quantities();
recalc();
}
flip_toggle(&dirichlet_flag,node->op1.toggle_state,"Sobolev area mode");
dirichlet_flag = 0;
break;
case HESSIAN_NORMAL_:
old = hessian_normal_flag;
hessian_normal_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_normal_flag ? "hessian_normal ON." :
"hessian_normal OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_SPECIAL_NORMAL_:
old = hessian_special_normal_flag;
if ( node->op1.toggle_state == ON_ &&
hessian_special_normal_expr[0].start == NULL )
kb_error(3835,"hessian_special_normal_vector not set.\n",
RECOVERABLE);
hessian_special_normal_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_special_normal_flag ? "hessian_special_normal ON." :
"hessian_special_normal OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_NORMAL_PERP_:
old = hessian_normal_perp_flag;
hessian_normal_perp_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_normal_perp_flag ? "hessian_normal_perp ON." :
"hessian_normal_perp OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_DOUBLE_NORMAL_:
old = hessian_double_normal_flag;
hessian_double_normal_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_double_normal_flag ? "hessian_double_normal ON." :
"hessian_double_normal OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_NORMAL_ONE_:
if ( node->op1.toggle_state==ON_ &&
((web.representation == SIMPLEX) || (SDIM - web.dimension > 1)))
{ sprintf(errmsg,
"HESSIAN_NORMAL_ONE only for STRING or SOAPFILM hypersurfaces.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2043,errmsg,RECOVERABLE);
}
old = hessian_normal_one_flag;
hessian_normal_one_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_normal_one_flag ? "hessian_normal_one ON." :
"hessian_normal_one OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_QUIET_:
old = hessian_quiet_flag;
hessian_quiet_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_quiet_flag ? "hessian_quiet ON." :
"hessian_quiet OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HESSIAN_DIFF_:
old = hessian_by_diff_flag;
if ( !web.pressure_flag && count_fixed_vol() )
{ sprintf(errmsg,
"Hessian_diff not implemented for constrained quants.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(3902,errmsg,RECOVERABLE);
}
hessian_by_diff_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(hessian_by_diff_flag ? "Hessian by differences ON." :
"Hessian by differences OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case INTERP_BDRY_PARAM_:
old = interp_bdry_param;
interp_bdry_param = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(interp_bdry_param ? "interpolation of boundary parameters ON." :
"interpolation of boundary parameters OFF (using extrapolation).");
outstring(old?" (was on)\n":" (was off)\n");
break;
case RITZ_:
{ int krydim; /* Krylov subspace dimension */
krydim = (int)*(stacktop--);
ritz_command(*(stacktop--),krydim);
}
break;
case LANCZOS_:
{ int krydim; /* Krylov subspace dimension */
if ( node->right ) krydim = (int)*(stacktop--);
else krydim = 100;
lanczos_command(*(stacktop--),krydim);
}
break;
case MOVE_:
calc_all_grads(CALC_VOLGRADS);
move_vertices(ACTUAL_MOVE,*(stacktop--));
vgrad_end();
#ifdef LONGDOUBLE
sprintf(msg,"1. energy: %*.*Lg stepsize: %g\n",DWIDTH,DPREC,
web.total_energy,(DOUBLE)stacktop[1]);
#else
sprintf(msg,"1. %s: %17.15g energy: %17.15g stepsize: %g\n",
areaname,web.total_area,web.total_energy,stacktop[1]);
#endif
outstring(msg);
update_display();
break;
case EIGENPROBE_:
{ int iters;
if ( node->right ) iters = (int)*(stacktop--);
else iters = 0;
eigenprobe_command(*(stacktop--),iters);
}
break;
case EXPRLIST_:
break; /* leave expression on stack */
case GET_TRANSFORM_EXPR_: /* put ptr in both halves */
{ int pp = (sizeof(REAL))/sizeof(char*);
int nn;
++stacktop;
for ( nn = 0 ; nn < pp ; nn++ )
((char **)stacktop)[nn] = transform_expr;
}
break;
case DATAFILENAME_: /* put ptr in both halves */
{ int pp = (sizeof(REAL))/sizeof(char*);
int nn;
++stacktop;
for ( nn = 0 ; nn < pp ; nn++ )
((char **)stacktop)[nn] = datafilename;
}
break;
case WARNING_MESSAGES_: /* put ptr in both halves */
{ int pp = (sizeof(REAL))/sizeof(char*);
int nn;
++stacktop;
for ( nn = 0 ; nn < pp ; nn++ )
((char **)stacktop)[nn] = warning_messages;
}
break;
case QUOTATION_: /* put ptr in both halves */
{ int pp = (sizeof(REAL))/sizeof(char*);
int nn;
*++stacktop = 0.0;
for ( nn = 0 ; nn < pp ; nn++ )
((char **)stacktop)[nn] = node->op1.string;
}
break;
case DATE_AND_TIME_:
{ time_t ltime;
time(<ime);
*(char**)(++stacktop) = ctime(<ime);
if ( strchr(*(char**)stacktop,'\n') )
*strchr(*(char**)stacktop,'\n') = 0;
break;
}
case PRINTFHEAD_:
case BINARY_PRINTFHEAD_:
if ( node->op1.string ) s = node->op1.string;
else s = *(char**)(stacktop--);
oldquiet = quiet_flag; quiet_flag = 0;
outstring(s);
quiet_flag = oldquiet;
break;
case ERRPRINTFHEAD_:
if ( node->op1.string ) s = node->op1.string;
else s = *(char**)(stacktop--);
erroutstring(s);
break;
case SPRINTFHEAD_:
if ( node->op1.string )
*(char **)(++stacktop) = node->op1.string;
/* else already on stack */
break;
case PRINTF_:
case ERRPRINTF_:
case SPRINTF_:
{ char format[1000];
char *newmsg;
int newmsgsize;
int formatcount = 0;
newmsgsize = 1000;
newmsg = temp_calloc(1,newmsgsize);
n = node[node->right].op1.argcount;
if ( node[node->left].op1.string )
s = node[node->left].op1.string;
else
s = *(char**)(stacktop-n);
/* remove old string munges */
{ char *p,*c;
/* strip %0.0s from format string */
while ( (c = strstr(s,"%0.0s")) != NULL )
{ for ( p = c+5 ; *p ; c++,p++ ) *c = *p;
*c = 0;
}
while ( (c = strstr(s,"%.0s")) != NULL )
{ for ( p = c+4 ; *p ; c++,p++ ) *c = *p;
*c = 0;
}
}
/* new way, parse through format string */
{ char *msgspot = newmsg;
char *sp = s;
while ( *sp )
{ char *f = format; /* for one format */
int nn;
struct treenode *nnode;
char *ss;
if ( (msgspot-newmsg) > (newmsgsize-500) )
{ size_t len = msgspot-newmsg;
newmsg = temp_realloc(newmsg,2*newmsgsize);
newmsgsize *= 2;
msgspot = newmsg + len;
}
if ( *sp != '%' )
{ *(msgspot++) = *(sp++);
continue;
}
/* now have % */
/* check for %%, which reduces to % */
if ( sp[1] == '%' )
{ *(msgspot++) = *(sp++);
(sp++);
continue;
}
/* find format character */
while ( *sp && !isalpha(*sp) )
*(f++) = *(sp++);
*(f++) = *(sp++); /* copy format character */
*f = 0; /* null terminator */
switch ( f[-1] )
{ case 's':
/* check that really have a string argument */
nnode = node;
for ( nn = 0 ; nn <= formatcount ; nn++ )
nnode += nnode->right;
nnode += nnode->left;
if ( !(nnode->flags & HAS_STRING) &&
!(nnode->type == STRINGGLOBAL_) &&
!(nnode->type == PERM_STRINGGLOBAL_) &&
!(nnode->type == SPRINTFHEAD_) &&
!(nnode->type == DATE_AND_TIME_) &&
!(nnode->type == DATAFILENAME_))
{ sprintf(errmsg,
"Argument %d: String format does not have string argument.\n",
formatcount+1);
strcat(errmsg,"Possibly % not followed by legal format?\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d; nnode->type %d)\n",
file_names[node->file_no],node->line_no,nnode->type);
kb_error(3111,errmsg,RECOVERABLE);
}
ss = *(char**)(stacktop-n+1+formatcount);
if ( ss == NULL ) ss = "(NULL)";
while ( (int)(msgspot-newmsg+strlen(ss))
> (int)(newmsgsize-10) )
{ size_t len = msgspot-newmsg;
newmsg = temp_realloc(newmsg,2*newmsgsize);
newmsgsize *= 2;
msgspot = newmsg + len;
}
sprintf(msgspot,format,ss);
++formatcount;
break;
case 'd': case 'u': case 'o': case 'x': case 'X': case 'p':
sprintf(msgspot,format,(int)(*(stacktop-n+ ++formatcount)));
break;
case 'f': case 'g': case 'e': case 'E': case 'G':
if ( fabs(*(stacktop-n+ (formatcount+1))) > 1e100 )
f[-1] = 'g'; /* prevent buffer overflow */
#ifdef LONGDOUBLE
f[0] = f[-1]; f[-1] = 'L'; f[1] = 0;
#endif
sprintf(msgspot,format,(*(stacktop-n+ ++formatcount)));
break;
default:
sprintf(msgspot,format,0,0,0,0); /* unrecognized */
}
msgspot += strlen(msgspot);
}
if ( formatcount > n )
{ sprintf(errmsg,
"Format string has %d formats, but there are only %d arguments.\n",
formatcount,n);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2044,errmsg,RECOVERABLE);
}
*msgspot = 0; /* null terminator */
stacktop -= n; /* pop args */
}
if ( node[node->left].op1.string == NULL ) stacktop--;
if ( node->type == PRINTF_ )
{ int old_flag = quiet_flag;
quiet_flag = 0;
outstring(newmsg);
quiet_flag = old_flag;
}
else if ( node->type == ERRPRINTF_ )
erroutstring(newmsg);
else /* SPRINTF_ */
{ char *str = mycalloc(strlen(newmsg)+2,1);
strcpy(str,newmsg);
*(char **)(++stacktop) = str;
}
temp_free(newmsg);
}
break;
case BINARY_PRINTF_:
{ char format[1000];
int formatcount = 0;
int byte_reverse = 0;
int test_int = 0x0124567;
if ( !big_endian_flag && !little_endian_flag )
{ kb_error(5387,
"binary_printf: you must set 'big_endian' or 'little_endian' toggles.",RECOVERABLE);
}
if ( big_endian_flag && (*(char*)&test_int)==0x67)
byte_reverse = 1;
if ( little_endian_flag && (*(char*)&test_int)==0x01)
byte_reverse = 1;
#ifdef WIN32
fflush(outfd);
_setmode(_fileno(outfd),_O_BINARY);
#endif
n = node[node->right].op1.argcount;
if ( node[node->left].op1.string )
s = node[node->left].op1.string;
else
s = *(char**)(stacktop-n);
/* parse through format string */
{ char *msgspot=NULL;
char *sp = s;
while ( *sp )
{ char *f = format; /* for one format */
int nn;
struct treenode *nnode;
if ( *sp != '%' )
{ fwrite(sp,1,1,outfd);
sp++;
continue;
}
while ( *sp && (!isalpha(*sp) || *sp=='l') )
*(f++) = *(sp++);
*(f++) = *(sp++); /* copy format character */
*f = 0; /* null terminator */
switch ( f[-1] )
{ case 's':
/* check that really have a string argument */
nnode = node;
for ( nn = 0 ; nn <= formatcount ; nn++ )
nnode += nnode->right;
nnode += nnode->left;
if ( !(nnode->flags & HAS_STRING) &&
!(nnode->type == STRINGGLOBAL_) &&
!(nnode->type == PERM_STRINGGLOBAL_) &&
!(nnode->type == SPRINTFHEAD_) &&
!(nnode->type == DATE_AND_TIME_) &&
!(nnode->type == DATAFILENAME_))
{ sprintf(errmsg,
"Argument %d: String format does not have string argument.\n",
formatcount+1);
strcat(errmsg,"Possibly % not followed by legal format?\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d; nnode->type %d)\n",
file_names[node->file_no],node->line_no,nnode->type);
kb_error(3212,errmsg,RECOVERABLE);
}
msgspot = *(char**)(stacktop-n+ ++formatcount);
fwrite(msgspot,1,strlen(msgspot),outfd);
break;
case 'c': /* one byte */
{ int c = (int)*(stacktop-n+ ++formatcount);
fwrite(&c,1,1,outfd);
}
break;
case 'd': case 'u': case 'o': case 'x': case 'X': case 'p':
if ( f[-2] == 'l' )
{ int m = (int)*(stacktop-n+ ++formatcount);
if ( byte_reverse )
{ char buf[4];
for ( i = 0 ; i < 4 ; i++ )
buf[i] = ((char*)&m)[4-1-i];
fwrite(buf,4,1,outfd);
}
else
fwrite(&m,4,1,outfd);
}
else /* 2-byte short */
{ short m = (short)*(stacktop-n+ ++formatcount);
if ( byte_reverse )
{ char buf[2];
for ( i = 0 ; i < 2 ; i++ )
buf[i] = ((char*)&m)[2-1-i];
fwrite(buf,2,1,outfd);
}
else
fwrite(&m,2,1,outfd);
}
break;
case 'f': case 'g': case 'e': case 'E': case 'G':
if ( f[-2] == 'l' )
{ /* 8-byte double */
double x = *(stacktop-n+ ++formatcount);
if ( byte_reverse )
{ char buf[8];
int i;
for ( i = 0 ; i < 8 ; i++ )
buf[i] = ((char*)&x)[7-i];
fwrite(buf,8,1,outfd);
}
else
fwrite(&x,8,1,outfd);
}
else /* 4-byte float */
{ float x = (float)*(stacktop-n+ ++formatcount);
if ( byte_reverse )
{ char buf[4];
int i;
for ( i = 0 ; i < 4 ; i++ )
buf[i] = ((char*)&x)[4-i];
fwrite(buf,4,1,outfd);
}
else
fwrite(&x,4,1,outfd);
}
break;
default:
sprintf(errmsg,"binary_printf format string has unrecognized format character '%c'\n",f[-1]);
break; /* unrecognized */
}
}
if ( formatcount > n )
{ sprintf(errmsg,
"Format string has %d formats, but there are only %d arguments.\n",
formatcount,n);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(4023,errmsg,RECOVERABLE);
}
stacktop -= n; /* pop args */
}
if ( node[node->left].op1.string == NULL ) stacktop--;
#ifdef WIN32
fflush(outfd);
_setmode(_fileno(outfd),_O_TEXT);
#endif
}
break;
case PRINT_: /* verb */
#ifdef LONGDOUBLE
sprintf(msg,"%*.*Lg\n",DWIDTH,DPREC,*(stacktop--));
#else
sprintf(msg,"%20.15g\n",*(stacktop--));
#endif
oldquiet = quiet_flag; quiet_flag = 0;
outstring(msg);
quiet_flag = oldquiet;
break;
case STRPRINT_: /* verb */
oldquiet = quiet_flag; quiet_flag = 0;
s = *(char**)(stacktop--);
outstring(s);
outstring("\n");
quiet_flag = oldquiet;
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
break;
case PRINT_LETTER_:
oldquiet = quiet_flag; quiet_flag = 0;
if ( single_redefine[node->op1.letter].start )
outstring(print_express(&single_redefine[node->op1.name_id],'X'));
else { sprintf(msg,"%c",node->op1.letter); outstring(msg);}
outstring("\n\n");
quiet_flag = oldquiet;
break;
case PRINT_PROCEDURE_:
oldquiet = quiet_flag; quiet_flag = 0;
outstring(print_express(&globals(node->op1.name_id)->value.proc,'X'));
outstring("\n\n");
quiet_flag = oldquiet;
break;
case PRINT_PERM_PROCEDURE_:
oldquiet = quiet_flag; quiet_flag = 0;
outstring(print_express(&perm_globals(node->op1.name_id)->value.proc,'X'));
outstring("\n\n");
quiet_flag = oldquiet;
break;
case EXPRINT_PROCEDURE_:
oldquiet = quiet_flag; quiet_flag = 0;
outstring(globals(node->op1.name_id)->attr.procstuff.proc_text);
outstring("\n\n");
quiet_flag = oldquiet;
break;
case EPRINT_: /* print and pass on value inside expression */
#ifdef LONGDOUBLE
sprintf(msg,"%*.*Lg\n",DWIDTH,DPREC,*stacktop);
#else
sprintf(msg,"%20.15g\n",*stacktop);
#endif
oldquiet = quiet_flag; quiet_flag = 0;
outstring(msg);
quiet_flag = oldquiet;
break;
case SHOWQ_:
display();
break;
case SET_THICKEN_ :
thickness = *(stacktop--);
break;
case JIGGLE_:
web.temperature = *(stacktop--);
jiggle();
recalc();
break;
case NOTCH_:
if ( web.representation == SIMPLEX )
{ sprintf(errmsg,"Notching not implemented for simplex representation.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1224,errmsg,RECOVERABLE);
}
web.max_angle = *(stacktop--);
if ( web.max_angle <= 0.0 )
{ sprintf(errmsg,"Notching angle not positive.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1225,errmsg,RECOVERABLE);
}
if ( web.representation == STRING )
{ sprintf(msg,"refine edge ee where max(ee.vertex,dihedral) > %f",
(DOUBLE)web.max_angle);
command(msg,NO_HISTORY);
web.notch_count = web.edge_refine_count;
}
else
{ web.notch_count = ridge_notcher(web.max_angle);
sprintf(msg,"Number of edges notched: %d\n",web.notch_count);
outstring(msg);
recalc();
}
break;
case SET_AUTOCHOP_:
autochop_length = *(stacktop--);
break;
case SET_AMBIENT_PRESSURE_:
web.pressure = *(stacktop--);
if ( web.pressure > 0.00000001 )
{ body_id b_id;
if ( !web.full_flag && !valid_id(web.outside_body) )
add_outside();
web.projection_flag = 0;
web.pressure_flag = 1;
if ( everything_quantities_flag )
FOR_ALL_BODIES(b_id) create_pressure_quant(b_id);
}
else
{
web.projection_flag = 1;
web.pressure_flag = 0;
}
recalc();
break;
case SET_DIFFUSION_:
old = web.diffusion_flag;
web.diffusion_const = *(stacktop--);
web.diffusion_flag = 1;
outstring(web.diffusion_flag ? "Diffusion ON." :
"Diffusion OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case AREAWEED_:
sprintf(msg,"Skinny triangles weeded: %d\n",
web.facet_delete_count = areaweed(*(stacktop--)));
outstring(msg);
energy_init = 0;
recalc();
break;
case METIS_:
case KMETIS_:
/*
metis_partition_dual((int)(*(stacktop--)),node->type);
*/
metis_partition_plain((int)(*(stacktop--)),node->type);
break;
case METIS_READJUST_:
metis_partition_dual((int)(*(stacktop--)),node->type);
/*
metis_partition_plain((int)(*(stacktop--)),node->type);
*/
break;
case BODY_METIS_:
metis_partition_body((int)(*(stacktop--)),METIS_);
break;
case OMETIS_:
if ( node->left )
metis_vertex_order((int)(*(stacktop--)));
else metis_vertex_order(100);
break;
case EDGEWEED_:
sprintf(msg,"Deleted edges: %d\n",
web.edge_delete_count = edgeweed(*(stacktop--)));
outstring(msg);
recalc();
break;
case OPTIMIZE_:
web.motion_flag = (node->op1.toggle_state==ON_) ? 0 : 1;
if ( web.motion_flag )
sprintf(msg,"Scale fixed at %g.\n",(DOUBLE)web.scale);
else sprintf(msg,"Scale optimizing with bound %g.\n",(DOUBLE)web.maxscale);
outstring(msg);
break;
case SET_OPTIMIZE_:
web.maxscale = *(stacktop--);
web.motion_flag = 0;
sprintf(msg,"Scale optimizing with bound %g.\n",(DOUBLE)web.maxscale);
outstring(msg);
break;
case SET_SCALE_:
web.scale = *(stacktop--);
web.motion_flag = 1;
sprintf(msg,"Scale fixed at %g.\n",(DOUBLE)web.scale);
outstring(msg);
break;
case SET_GRAVITY_:
switch ( node->op1.assigntype )
{ case ASSIGN_: web.grav_const = *(stacktop--); break;
case PLUSASSIGN_: web.grav_const += *(stacktop--); break;
case SUBASSIGN_: web.grav_const -= *(stacktop--); break;
case MULTASSIGN_: web.grav_const *= *(stacktop--); break;
case DIVASSIGN_: web.grav_const /= *(stacktop--); break;
}
old = web.gravflag;
if ( web.grav_const != 0.0 )
{ web.gravflag = 1;
sprintf(msg,"Gravity is now ON with gravitational constant %g.",
(DOUBLE)web.grav_const);
}
else
{ web.gravflag = 0;
sprintf(msg,"Gravity is now OFF.");
}
if (gravity_quantity_num >= 0 )
GEN_QUANT(gravity_quantity_num)->modulus =
web.gravflag ? web.grav_const : 0.0;
outstring(msg);
outstring(old?" (was on)\n":" (was off)\n");
recalc();
break;
case SET_MODEL_:
switch ( (int)*(stacktop--) )
{
case LINEAR:
if ( web.modeltype == QUADRATIC )
{ outstring("Changing to LINEAR model. (was QUADRATIC)\n");
quad_to_linear(); recalc(); }
else if ( web.modeltype == LAGRANGE )
{ outstring("Changing to LINEAR model. (was LAGRANGE)\n");
lagrange_to_linear(); recalc(); }
else outstring("Model already LINEAR.\n");
break;
case QUADRATIC:
if ( web.modeltype == LINEAR )
{ outstring("Changing to QUADRATIC model. (was LINEAR)\n");
linear_to_quad(); recalc(); }
else if ( web.modeltype == LAGRANGE )
{ outstring("Changing to QUADRATIC model. (was LAGRANGE)\n");
lagrange_to_quad(); recalc(); }
else outstring("Model already QUADRATIC.\n");
break;
default:
if ( stacktop[1] > 2. )
{ if ( web.modeltype == LINEAR )
{ outstring("Changing to LAGRANGE model. (was LINEAR)\n");
linear_to_lagrange((int)stacktop[1]); recalc(); }
else if ( web.modeltype == QUADRATIC )
{ outstring("Changing to LAGRANGE model. (was QUADRATIC)\n");
quad_to_lagrange((int)stacktop[1]); recalc(); }
else lagrange_to_lagrange((int)stacktop[1]);
}
else
{ sprintf(errmsg,
"Bad model choice. Legal: 1 (linear), 2 (quadratic), > 2 (Lagrange)\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1230,errmsg,RECOVERABLE);
}
}
recalc();
break;
case INVOKE_P_MENU_:
display_file((int)*(stacktop--));
break;
case EDGEDIVIDE_:
sprintf(msg,"New edges: %d\n",
web.edge_refine_count = articulate(*(stacktop--)));
outstring(msg);
recalc();
break;
case SET_SGLOBAL_:
{ struct global *g = globals(node->op1.name_id);
char *s,**ss;
if ( g->flags & GLOB_LOCALVAR )
ss = (char**)(localstack+g->value.offset);
else ss = &(g->value.string);
if ( *ss ) myfree(*ss);
s = *(char**)(stacktop--);
if ( s )
{ *ss = mycalloc(strlen(s)+1,sizeof(char));
strcpy(*ss,s);
}
else
{ *ss = mycalloc(1,sizeof(char)); /* empty */
}
g->flags |= STRINGVAL;
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
} break;
case SET_PERM_SGLOBAL_:
{ struct global *g = perm_globals(node->op1.name_id);
char *s;
if ( g->value.string ) free(g->value.string);
s = *(char**)(stacktop--);
if ( s )
{ g->value.string = calloc(strlen(s)+1,sizeof(char));
strcpy(g->value.string,s);
}
else
{ g->value.string = calloc(1,sizeof(char)); /* empty */
}
if ( node->left && (node[node->left].flags & DEALLOCATE_POINTER) )
myfree(s);
g->flags |= STRINGVAL;
} break;
case SET_PARAM_SCALE:
{ struct global *g = globals(node->op1.name_id);
REAL value = *(stacktop--);
switch ( node->op2.assigntype )
{ case ASSIGN_: g->attr.varstuff.pscale = value; break;
case PLUSASSIGN_: g->attr.varstuff.pscale += value; break;
case SUBASSIGN_: g->attr.varstuff.pscale -= value; break;
case MULTASSIGN_: g->attr.varstuff.pscale *= value; break;
case DIVASSIGN_: g->attr.varstuff.pscale /= value; break;
}
break;
}
case SET_DELTA_:
{ struct global *g = globals(node->op1.name_id);
REAL value = *(stacktop--);
switch ( node->op2.assigntype )
{ case ASSIGN_: g->attr.varstuff.delta = value; break;
case PLUSASSIGN_: g->attr.varstuff.delta += value; break;
case SUBASSIGN_: g->attr.varstuff.delta -= value; break;
case MULTASSIGN_: g->attr.varstuff.delta *= value; break;
case DIVASSIGN_: g->attr.varstuff.delta /= value; break;
}
break;
}
case DEFINE_IDENT_: break;
case DEFINE_ARRAY_:
{ int dim,size,i;
struct treenode *nnode = node;
struct global *g = globals(node->op1.name_id);
int itemsize;
int pointercount;
struct array *oldarray;
struct array **array_info;
if ( g->flags & GLOB_LOCALVAR )
{ localbase->flags |= LL_HAS_ARRAY;
array_info = (struct array **)(localstack+g->value.offset);
}
else array_info = &(g->attr.arrayptr);
oldarray = *array_info;
itemsize = datatype_size[node->op2.valtype];
pointercount = 1;
for ( size = 1, dim=0 ; dim < g->attr.arrayptr->dim ; dim++ )
{ size *= (int)stacktop[-dim];
if ( dim > 0 )
pointercount *= (int)stacktop[-dim];
}
if ( g->flags & GLOB_LOCALVAR )
*array_info = (struct array*)temp_calloc(
sizeof(struct array)+dim*sizeof(int)
+ (size+1)*itemsize+pointercount*sizeof(REAL*),1); /* extra for alignment */
else /* nonlocal */
*array_info = (struct array*)mycalloc(
sizeof(struct array)+dim*sizeof(int)
+ (size+1)*itemsize+pointercount*sizeof(REAL*),1); /* extra for alignment */
(*array_info)->dim = dim;
(*array_info)->itemsize = itemsize;
(*array_info)->datatype = node->op2.valtype;
(*array_info)->datacount = size;
for ( i=0, nnode = node ; i < dim ; nnode += nnode->left, i++ )
(*array_info)->sizes[i] = (int)stacktop[1-dim+i];
stacktop -= dim;
(*array_info)->datastart = sizeof(struct array) + dim*sizeof(int);
/* guarantee bus alignment */
if ( (*array_info)->datastart % itemsize )
(*array_info)->datastart =
(*array_info)->datastart + itemsize -
((*array_info)->datastart % itemsize );
/* copy old data */
if ( oldarray )
{ int oldoff,n;
for ( oldoff = 0 ; oldoff < oldarray->datacount ; oldoff ++ )
{ int newoff = 0;
int prod = 1;
int p,pp;
p = oldoff;
for ( n = dim-1 ; n >= 0 ; n-- )
{ int nd = (*array_info)->sizes[n];
int od = oldarray->sizes[n];
pp = p % od;
p = p / od;
if ( pp >= nd ) goto skip;
newoff += prod*pp;
prod *= nd;
}
memcpy((char*)(*array_info)+(*array_info)->datastart
+ newoff*(*array_info)->itemsize,
(char*)oldarray+oldarray->datastart
+ oldoff*oldarray->itemsize,
oldarray->itemsize);
skip: ;
}
}
if ( g->flags & GLOB_LOCALVAR )
temp_free((char*)oldarray);
else
myfree((char*)oldarray);
}
break;
case SET_ELEMENT_GLOBAL_:
{ struct global *g = globals(node->op1.name_id);
g->value.id = *(element_id*)(stacktop--);
break;
}
case ZOOM_:
if ( node->left ) /* have vertex number */
{ vertex_id v_id;
int vnum;
int found = 0;
web.zoom_radius = *(stacktop--);
vnum = (int)*(stacktop--);
FOR_ALL_VERTICES(v_id)
{ if ( vnum == (ordinal(v_id)+1) )
{ web.zoom_v = v_id; found = 1; break; }
}
if ( !found )
{ sprintf(errmsg,"Zoom vertex %d not found.\n",vnum);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1231,errmsg,RECOVERABLE);
}
}
else if ( !valid_element(web.zoom_v) )
{ sprintf(errmsg,"Zoom vertex not found.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1232,errmsg,RECOVERABLE);
}
zoom_vertex(web.zoom_v,web.zoom_radius);
/* resize(); */
recalc();
break;
case VIEW_MATRIX_LVALUE_: break; /* just to hold indices */
case SET_VIEW_MATRIX_:
{ int i = (int)(stacktop[-2]);
int k = (int)(stacktop[-1]);
REAL value = *stacktop;
stacktop -= 3;
if ( (k < 1) || (k > SDIM+1) || (i < 1) || (i > SDIM+1) )
{ sprintf(errmsg,
"Illegal index: view_matrix[%d][%d] (must be 1 to %d)\n",i,k,SDIM);
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2049,errmsg,RECOVERABLE);
}
i--;k--; /* convert to 0 based indexing */
switch ( node->op2.assigntype )
{ case ASSIGN_: view[i][k] = value; break;
case PLUSASSIGN_: view[i][k] += value; break;
case SUBASSIGN_: view[i][k] -= value; break;
case MULTASSIGN_: view[i][k] *= value; break;
case DIVASSIGN_:
if ( value == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2565,errmsg,RECOVERABLE);
}
view[i][k] /= value; break;
}
*update_display_flag = 1;
}
break;
case SET_QTARGET_:
{ struct gen_quant *q = GEN_QUANT(node->op1.quant_id);
switch ( node->op2.assigntype )
{ case ASSIGN_: q->target = *(stacktop--); break;
case PLUSASSIGN_: q->target += *(stacktop--); break;
case SUBASSIGN_: q->target -= *(stacktop--); break;
case MULTASSIGN_: q->target *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2588,errmsg,RECOVERABLE);
}
q->target /= *(stacktop--);
break;
}
if ( valid_id(q->b_id) )
set_body_fixvol(q->b_id,q->target);
}
break;
case SET_QMODULUS_:
{ REAL v = GEN_QUANT(node->op1.quant_id)->modulus;
switch ( node->op2.assigntype )
{ case ASSIGN_: v = *(stacktop--); break;
case PLUSASSIGN_: v += *(stacktop--); break;
case SUBASSIGN_: v -= *(stacktop--); break;
case MULTASSIGN_: v *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2589,errmsg,RECOVERABLE);
}
v /= *(stacktop--);
break;
}
GEN_QUANT(node->op1.quant_id)->modulus = v;
}
break;
case SET_QTOLERANCE_:
if ( *stacktop <= 0.0 )
kb_error(2050,"Tolerance must be positive.\n",RECOVERABLE);
{ REAL v = GEN_QUANT(node->op1.quant_id)->tolerance;
switch ( node->op2.assigntype )
{ case ASSIGN_: v = *(stacktop--); break;
case PLUSASSIGN_: v += *(stacktop--); break;
case SUBASSIGN_: v -= *(stacktop--); break;
case MULTASSIGN_: v *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2487,errmsg,RECOVERABLE);
}
v /= *(stacktop--);
break;
}
GEN_QUANT(node->op1.quant_id)->tolerance = v;
}
break;
case SET_MMODULUS_:
{ REAL v = METH_INSTANCE(node->op1.meth_id)->modulus;
switch ( node->op2.assigntype )
{ case ASSIGN_: v = *(stacktop--); break;
case PLUSASSIGN_: v += *(stacktop--); break;
case SUBASSIGN_: v -= *(stacktop--); break;
case MULTASSIGN_: v *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2488,errmsg,RECOVERABLE);
}
v /= *(stacktop--);
break;
}
METH_INSTANCE(node->op1.meth_id)->modulus = v;
}
break;
case SET_QVOLCONST_:
{ struct gen_quant *q =
GEN_QUANT(node->op1.quant_id);
switch ( node->op2.assigntype )
{ case ASSIGN_: q->volconst = *(stacktop--); break;
case PLUSASSIGN_: q->volconst += *(stacktop--); break;
case SUBASSIGN_: q->volconst -= *(stacktop--); break;
case MULTASSIGN_: q->volconst *= *(stacktop--); break;
case DIVASSIGN_:
if ( *stacktop == 0.0 )
{ sprintf(errmsg,"Division by zero.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2489,errmsg,RECOVERABLE);
}
q->volconst /= *(stacktop--);
break;
}
if ( valid_id(q->b_id) )
set_body_volconst(q->b_id,q->volconst);
}
break;
case RUNGE_KUTTA_:
old = runge_kutta_flag;
runge_kutta_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(runge_kutta_flag ? "Runge-Kutta ON." :
"Runge-Kutta OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case CHECK_INCREASE_:
old = check_increase_flag;
check_increase_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(check_increase_flag?"Increase check ON.":
"Increase check OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case HOMOTHETY_:
old = web.homothety;
web.homothety = (node->op1.toggle_state==ON_) ? 1 : 0;
if ( web.homothety && (web.skel[BODY].count == 0) )
{ web.homothety = 0;
sprintf(errmsg,"Cannot do homothety without bodies.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1233,errmsg,RECOVERABLE);
}
sprintf(msg,"Homothety adjustment is %s.",
web.homothety ? "ON" : "OFF");
outstring(msg);
outstring(old?" (was on)\n":" (was off)\n");
if ( web.homothety )
{ sprintf(msg,"Enter target size (%g): ",(DOUBLE)homothety_target);
prompt(msg,response,sizeof(response));
const_expr(response,&homothety_target);
}
break;
case COUNTS_: /* report count of elements and status */
memory_report();
break;
case EXTRAPOLATE_: extrapolate(); break;
case DIFFUSION_: /* Set diffusion */
old = web.diffusion_flag;
web.diffusion_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(web.diffusion_flag ? "Diffusion ON." :
"Diffusion OFF.");
outstring(old?" (was on)\n":" (was off)\n");
break;
case AUTODISPLAY_:
old = go_display_flag;
go_display_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring(go_display_flag ? "Autodisplay ON." :
"Autodisplay OFF.");
outstring(old?" (was on)\n":" (was off)\n");
if ( go_display_flag ) update_display();
break;
case SHOW_INNER_:
old = innerflag;
innerflag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring(innerflag ? "show inner ON." : "show inner OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case SHOW_OUTER_:
old = outerflag;
outerflag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring(outerflag ? "show outer ON." : "show outer OFF.");
outstring(old?" (was on)\n":" (was off)\n");
update_display();
break;
case INTERP_NORMALS_:
normflag = (node->op1.toggle_state == ON_) ? 1 : 0;
break;
case COLORMAP_:
colorflag = (node->op1.toggle_state == ON_) ? 1 : 0;
break;
case AMBIENT_PRESSURE_:
web.pressure_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
if ( web.pressure_flag)
{ if ( !web.full_flag && !valid_id(web.outside_body) )
add_outside();
web.projection_flag = 0;
sprintf(msg,"Ambient pressure ON; ambient pressure = %2.15g\n",
(double)web.pressure);
}
else
{
web.projection_flag = 1;
sprintf(msg,"Ambient pressure OFF.\n");
}
calc_energy();
outstring(msg);
break;
case EFFECTIVE_AREA_:
if ( SDIM > 3 )
{ sprintf(errmsg,"effective_area only for dimension 3.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2051,errmsg,RECOVERABLE);
}
old = effective_area_flag;
effective_area_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(effective_area_flag ? "effective_area ON." :
"effective_area OFF.");
outstring(old?" (was on)\n":" (was off)\n");
if ( effective_area_flag ) web.area_norm_flag = 1;
if ( square_curvature_flag ) calc_energy();
break;
case NORMAL_CURVATURE_:
if ( SDIM != 3 )
{ sprintf(errmsg,"Normal_curvature only for dimension 3.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2052,errmsg,RECOVERABLE);
}
old = normal_curvature_flag;
normal_curvature_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(normal_curvature_flag ? "normal_curvature ON." :
"normal_curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
if ( square_curvature_flag ) calc_energy();
break;
case DIV_NORMAL_CURVATURE_:
if ( SDIM != 3 )
{ sprintf(errmsg,"Div_normal_curvature only for dimension 3.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(2053,errmsg,RECOVERABLE);
}
old = div_normal_curvature_flag;
div_normal_curvature_flag = (node->op1.toggle_state==ON_) ? 1 : 0;
outstring(div_normal_curvature_flag ? "div_normal_curvature ON." :
"div_normal_curvature OFF.");
outstring(old?" (was on)\n":" (was off)\n");
if ( square_curvature_flag ) calc_energy();
break;
case LONG_JIGGLE_:
long_jiggle();
break;
case RAW_VERAVG_:
vertex_average(NOVOLKEEP);
recalc();
outstring("Vertex averaging done.\n");
break;
case RAWEST_VERAVG_:
vertex_average(RAWEST);
recalc();
outstring("Vertex averaging done.\n");
break;
case TEXT_SPOT_: /* just accumulate arguments */
break;
case DISPLAY_TEXT_:
{ char *text = *(char**)(stacktop--);
REAL yspot = *(stacktop--);
REAL xspot = *(stacktop--);
int length = strlen(text);
int text_id;
for ( text_id = 0 ; text_id < MAXTEXTS ; text_id++ )
{ if ( text_chunks[text_id].text == NULL )
{ text_chunks[text_id].text =
(char*)mycalloc(length+1,1);
break;
}
}
if ( text_id >= MAXTEXTS-1 )
{ kb_error(4998,"Too many display texts.\n",WARNING);
break;
}
strcpy(text_chunks[text_id].text,text);
text_chunks[text_id].start_x = xspot;
text_chunks[text_id].start_y = yspot;
display_text_count++;
*(++stacktop) = text_id+1;
*recalc_flag = 1;
break;
}
case DELETE_TEXT_:
{ int text_id = (int)*(stacktop--) - 1;
if ( (text_id < 0) || (text_id >= MAXTEXTS) )
{ sprintf(errmsg,"Text id must be between 1 and %d.\n",MAXTEXTS);
kb_error(7543,errmsg,RECOVERABLE);
}
if ( text_chunks[text_id].text )
{ myfree(text_chunks[text_id].text);
text_chunks[text_id].text = NULL;
display_text_count--;
*recalc_flag = 1;
}
break;
}
case REBODY_:
{ body_id b_id;
sprintf(msg,"New bodies: %d\n",rebody());
outstring(msg);
sprintf(msg,"Merged bodies: %d\n",merge_bodies());
outstring(msg);
calc_content(Q_FIXED|Q_INFO);
FOR_ALL_BODIES(b_id)
if ( get_battr(b_id) & FIXEDVOL )
set_body_fixvol(b_id,get_body_volume(b_id));
break;
}
case SUPPRESS_WARNING_:
{ int wnum = (int)*(stacktop--);
if ( warnings_suppressed_count < MAXSUPPRESS )
warnings_suppressed[warnings_suppressed_count++] = wnum;
else
kb_error(4535,"Too many warnings suppressed.\n",WARNING);
}
break;
case UNSUPPRESS_WARNING_:
{ int wnum = (int)*(stacktop--);
for ( i = 0 ; i < warnings_suppressed_count ; i++ )
if ( warnings_suppressed[i] == wnum )
{ warnings_suppressed[i] =
warnings_suppressed[--warnings_suppressed_count];
break;
}
}
break;
case ALICE_:
alice();
break;
case BURCHARD_:
burchard(node->op1.maxsteps);
break;
case DUMP_:
if ( node->left ) do_dump(*(char**)(stacktop--));
else do_dump(NULL);
break;
case SET_COLORMAP_:
strncpy(cmapname,*(char**)(stacktop--),sizeof(cmapname));
break;
case RAW_CELLS_:
web.torus_body_flag = 0; web.torus_clip_flag = 0;
torus_display_mode = TORUS_RAW_MODE;
update_display();
break;
case CONNECTED_CELLS_:
if ( web.skel[BODY].count == 0 )
{ sprintf(errmsg,"There are no bodies to display connectedly.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1234,errmsg,WARNING);
}
else { web.torus_body_flag = 1; web.torus_clip_flag = 0;
torus_display_mode = TORUS_CONNECTED_MODE;
update_display(); }
break;
case CLIPPED_CELLS_:
if ( !web.torus_flag && !web.torus_display_period )
{ sprintf(errmsg,
"CLIPPED mode has no effect since torus model not used.\n");
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
kb_error(1254,errmsg, WARNING);
}
torus_display_mode = TORUS_CLIPPED_MODE;
web.torus_body_flag = 0; web.torus_clip_flag = 1;
update_display();
break;
case THICKEN_:
thickenflag = (node->op1.toggle_state == ON_) ? 1 : 0;
update_display();
break;
case METRIC_CONVERT_:
metric_convert_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
if ( metric_convert_flag )
outstring("Converting form to vector using metric.\n");
else outstring("Not using metric to convert form to vector.\n");
break;
case QUANTITIES_ONLY_:
old = quantities_only_flag;
quantities_only_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring("Using quantities only ");
outstring(quantities_only_flag ? "ON.": "OFF.");
outstring(old ? "(was ON)\n" : "(was OFF)\n");
break;
case SQUARED_GRADIENT_:
old = min_square_grad_flag;
min_square_grad_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring("Squared gradient minimization with Hessian ");
outstring(min_square_grad_flag ? "ON.": "OFF.");
outstring(old ? "(was ON)\n" : "(was OFF)\n");
break;
case LINEAR_METRIC_:
old = hessian_linear_metric_flag;
hessian_linear_metric_flag = (node->op1.toggle_state == ON_) ? 1 : 0;
outstring("Linear interpolation metric with Hessian ");
outstring(hessian_linear_metric_flag ? "ON.": "OFF.");
outstring(old ? "(was ON)\n" : "(was OFF)\n");
break;
case YSMP_:
old = ysmp_flag;
ysmp_flag =
(node->op1.toggle_state == ON_) ? YSMP_FACTORING : MINDEG_FACTORING;
change_hessian_functions(old,ysmp_flag);
break;
case METIS_FACTOR_:
old = ysmp_flag;
#ifndef METIS
kb_error(2055,"This Evolver not compiled with METIS.\n",RECOVERABLE);
#else
ysmp_flag = METIS_FACTORING;
change_hessian_functions(old,ysmp_flag);
#endif
break;
case BUNCH_KAUFMAN_:
flip_toggle(&BK_flag,node->op1.toggle_state,
"Bunch-Kaufman version of minimal degree");
break;
case CONTINUE_:
case SET_PROC_END_:
case SET_FUNC_END_:
case SET_PERM_PROC_END_:
case SHOW_END_:
case ELSE_:
case COND_ELSE_:
/* just a continue node */
break;
default:
sprintf(errmsg,"Bad expression eval node type: %s.",
tokname(node->type));
if ( node->file_no >= 0 && node->file_no <= file_no_used )
sprintf(errmsg+strlen(errmsg),"(source file %s, line %d)\n",
file_names[node->file_no],node->line_no);
else
sprintf(errmsg+strlen(errmsg),"(appears to be corrupt node)\n");
kb_error(1235,errmsg,RECOVERABLE);
break;
}
} /* end more_other_stuff() */
/********************************************************************
*
* function: get_toggle_value()
*
* purpose: get boolean value of toggle for expression
*/
int get_toggle_value(tog)
int tog; /* type of toggle */
{
switch (tog)
{ case GEOMVIEW_: return geomview_flag;
case BEZIER_BASIS_: return bezier_flag;
case SMOOTH_GRAPH_: return smooth_graph_flag;
case FULL_BOUNDING_BOX_: return full_bounding_box_flag;
case POP_DISJOIN_: return pop_disjoin_flag;
case POP_ENJOIN_: return pop_enjoin_flag;
case POP_TO_EDGE_: return pop_to_edge_flag;
case POP_TO_FACE_: return pop_to_face_flag;
case MPI_DEBUG_: return mpi_debug;
case AMBIENT_PRESSURE_: return web.pressure_flag;
case ZENER_DRAG_: return zener_drag_flag;
case BACKCULL_: return backcull_flag;
case TORUS_FILLED_: return web.full_flag;
case VOLGRADS_EVERY_: return volgrads_every_flag;
case LOGFILE_: return logfile_flag;
case KEYLOGFILE_: return logfile_flag;
case LINEAR_: return (web.modeltype == LINEAR);
case QUADRATIC_: return (web.modeltype == QUADRATIC);
case LAGRANGE_: return (web.modeltype == LAGRANGE);
case KUSNER_: return kusner_flag;
case ESTIMATE_: return estimate_flag;
case DETURCK_: return unit_normal_flag;
case HOMOTHETY_: return web.homothety;
case SLICE_VIEW_: return slice_view_flag;
case CLIP_VIEW_: return clip_view_flag;
case SQGAUSS_: return sqgauss_flag;
case AUTOPOP_: return autopop_flag;
case IMMEDIATE_AUTOPOP_: return immediate_autopop_flag;
case AUTOPOP_QUARTIC_: return autopop_quartic_flag;
case AUTOCHOP_: return autochop_flag;
case QUIET_: return quiet_flag;
case HESSIAN_QUIET_: return hessian_quiet_flag;
case QUIETGO_: return quiet_go_flag;
case QUIETLOAD_: return quiet_load_flag;
case OLD_AREA_: return old_area_flag;
case APPROX_CURV_: return approx_curve_flag;
case RUNGE_KUTTA_: return runge_kutta_flag;
case CHECK_INCREASE_: return check_increase_flag;
case DEBUG_: return yydebug;
case MEAN_CURV_: return web.area_norm_flag;
case DIFFUSION_: return web.diffusion_flag;
case GRAVITY_: return web.gravflag;
case CONJ_GRAD_: return conj_grad_flag;
case TRANSFORMS_: return transforms_flag;
case CONF_EDGE_SQCURV_: return conf_edge_curv_flag;
case EFFECTIVE_AREA_: return effective_area_flag;
case RAW_CELLS_: return !web.torus_body_flag && !web.torus_clip_flag;
case CONNECTED_CELLS_: return web.torus_body_flag;
case CLIPPED_CELLS_: return web.torus_clip_flag;
case THICKEN_: return thickenflag;
case YSMP_: return ysmp_flag;
case LINEAR_METRIC_: return hessian_linear_metric_flag;
case METRIC_CONVERT_: return metric_convert_flag;
case BUNCH_KAUFMAN_: return BK_flag;
case SHOW_INNER_: return innerflag;
case SHOW_OUTER_: return outerflag;
case COLORMAP_: return colorflag;
case HESSIAN_DIFF_: return hessian_by_diff_flag;
case POST_PROJECT_: return post_project_flag;
case MEAN_CURV_INT_: return mean_curv_int_flag;
case OPTIMIZE_: return !web.motion_flag;
case NORMAL_CURVATURE_: return normal_curvature_flag;
case DIV_NORMAL_CURVATURE_: return div_normal_curvature_flag;
case SHADING_: return shading_flag;
case FACET_COLORS_: return color_flag;
case BOUNDARY_CURVATURE_: return boundary_curvature_flag;
case NORMAL_MOTION_: return normal_motion_flag;
case PINNING_: return check_pinning_flag;
case VIEW_4D_: return view_4D_flag;
case MEMDEBUG_: return memdebug;
case ITDEBUG_: return itdebug;
case METRIC_CONVERSION_: return metric_convert_flag;
case AUTORECALC_: return autorecalc_flag;
case FORCE_POS_DEF_: return make_pos_def_flag;
case GV_BINARY_: return gv_binary_flag;
case SELF_SIMILAR_: return self_similar_flag;
case AUTODISPLAY_: return go_display_flag;
case RIBIERE_CG_: return ribiere_flag;
case ASSUME_ORIENTED_: return assume_oriented_flag;
case DIRICHLET_MODE_: return dirichlet_flag;
case SOBOLEV_MODE_: return sobolev_flag;
case KRAYNIKPOPVERTEX_FLAG_: return kraynikpopvertex_flag;
case KRAYNIKPOPEDGE_FLAG_: return kraynikpopedge_flag;
case HESSIAN_NORMAL_: return hessian_normal_flag;
case HESSIAN_SPECIAL_NORMAL_: return hessian_special_normal_flag;
case HESSIAN_NORMAL_PERP_: return hessian_normal_perp_flag;
case HESSIAN_NORMAL_ONE_: return hessian_normal_one_flag;
case HESSIAN_DOUBLE_NORMAL_: return hessian_double_normal_flag;
case INTERP_BDRY_PARAM_: return interp_bdry_param;
case H_INVERSE_METRIC_: return web.h_inverse_metric_flag;
case PSCOLORFLAG_: return ps_colorflag;
case GRIDFLAG_: return gridflag;
case METIS_FACTOR_: return ysmp_flag == METIS_FACTORING;
case CROSSINGFLAG_: return crossingflag;
case LABELFLAG_: return labelflag;
case SHOW_ALL_QUANTITIES_: return show_all_quantities;
case QUANTITIES_ONLY_: return quantities_only_flag;
case VISIBILITY_TEST_: return visibility_test;
case SPARSE_CONSTRAINTS_: return sparse_constraints_flag;
case BLAS_FLAG_: return blas_flag;
case BREAK_AFTER_WARNING_ : return break_after_warning;
case AUGMENTED_HESSIAN_: return augmented_hessian_flag;
case VERBOSE_: return verbose_flag;
case FUNCTION_QUANTITY_SPARSE_: return quantity_function_sparse_flag;
case BIG_ENDIAN_: return big_endian_flag;
case LITTLE_ENDIAN_ : return little_endian_flag;
default:
sprintf(errmsg,"Internal error: Toggle value omitted for toggle %d.\n",tog);
kb_error(1236,errmsg,WARNING);
}
return 0;
} /* end get_toggle_value */
/*************************************************************************
*
* function: get_internal_variable()
*
* purpose: get value of various variables visible to user.
*/
REAL get_internal_variable(vartok)
int vartok; /* token number of variable */
{
switch(vartok)
{
case V_HIGH_BOUNDARY: return web.highbdry;
case V_HIGH_CONSTRAINT: return web.highcon;
case V_RANDOM: return kb_drand();
case V_MPI_MAXTASK:
#ifdef MPI_EVOLVER
return mpi_nprocs-1;
#else
return 1;
#endif
#ifdef MPI_EVOLVER
case V_CORONA_STATE:
return (REAL)mpi_corona_state;
#endif
case V_VERTEXCOUNT:
return (REAL)web.skel[VERTEX].count;
case V_EDGECOUNT:
return (REAL)web.skel[EDGE].count;
case V_FACETCOUNT:
return (REAL)web.skel[FACET].count;
case V_BODYCOUNT:
return (REAL)web.skel[BODY].count;
case V_FACETEDGECOUNT:
return (REAL)web.skel[FACETEDGE].count;
case V_ENERGY:
return web.total_energy;
case V_GAP_CONSTANT:
return web.spring_constant;
case V_TIME:
return total_time;
case V_JIG_TEMP:
return web.temperature;
case V_AREA:
case V_LENGTH:
return web.total_area;
case V_ITER_COUNTER:
return (REAL)gocount;
case V_AMBIENT_PRESSURE:
return web.pressure;
case V_DIFFUSION:
return web.diffusion_const;
case V_SCALE:
return web.scale;
case V_SCALE_SCALE:
return web.scale_scale;
case V_SPACE_DIMENSION:
return (REAL)SDIM;
case V_SURFACE_DIMENSION:
return (REAL)web.dimension;
case V_TORUS:
return (REAL)web.torus_flag;
case V_SYMMETRY_GROUP:
return (REAL)web.symmetry_flag;
case V_SIMPLEX:
return (REAL)(web.representation == SIMPLEX);
case V_INTEGRAL_ORDER:
return ((REAL)web.gauss1D_order+2)/2;
case V_INTEGRAL_ORDER_1D:
return (REAL)web.gauss1D_order;
case V_INTEGRAL_ORDER_2D:
return (REAL)web.gauss2D_order;
case V_TOLERANCE:
return web.tolerance;
case V_TARGET_TOLERANCE:
return web.target_tolerance;
case V_THICKNESS:
return thickness;
case V_HESSIAN_SLANT_CUTOFF:
return hessian_slant_cutoff;
case V_HESS_EPSILON:
return hessian_epsilon;
case GRAV_CONST_:
return web.grav_const;
case V_EQUI_COUNT:
return (REAL)web.equi_count;
case V_EDGESWAP_COUNT:
return (REAL)web.edgeswap_count;
case V_T1_EDGESWAP_COUNT:
return (REAL)web.t1_edgeswap_count;
case V_DELETE_COUNT:
return (REAL)web.edge_delete_count + web.facet_delete_count;
case V_EDGE_DELETE_COUNT:
return (REAL)web.edge_delete_count;
case V_FACET_DELETE_COUNT:
return (REAL)web.facet_delete_count;
case V_REFINE_COUNT:
return (REAL)web.edge_refine_count + web.facet_refine_count;;
case V_EDGE_REFINE_COUNT:
return (REAL)web.edge_refine_count;
case V_FACET_REFINE_COUNT:
return (REAL)web.facet_refine_count;
case V_NOTCH_COUNT:
return (REAL)web.notch_count;
case V_DISSOLVE_COUNT:
return (REAL)web.vertex_dissolve_count + web.edge_dissolve_count
+ web.facet_dissolve_count + web.body_dissolve_count;
case V_VERTEX_DISSOLVE_COUNT:
return (REAL)web.vertex_dissolve_count;
case V_EDGE_DISSOLVE_COUNT:
return (REAL)web.edge_dissolve_count;
case V_FACET_DISSOLVE_COUNT:
return (REAL)web.facet_dissolve_count;
case V_BODY_DISSOLVE_COUNT:
return (REAL)web.body_dissolve_count;
case V_EDGE_REVERSE_COUNT:
return (REAL)web.edge_reverse_count;
case V_FACET_REVERSE_COUNT:
return (REAL)web.facet_reverse_count;
case V_FIX_COUNT:
return web.fix_count;
case V_THIS_TASK:
return this_task;
case V_WINDOW_ASPECT_RATIO:
return window_aspect_ratio;
case V_STRING_CURVE_TOLERANCE:
return string_curve_tolerance;
case V_MINDEG_DEBUG_LEVEL:
return mindeg_debug_level;
case V_MINDEG_MARGIN:
return mindeg_margin;
case V_MINDEG_MIN_REGION_SIZE:
return mindeg_min_region_size;
case V_UNFIX_COUNT:
return web.unfix_count;
case V_POP_COUNT:
return web.vertex_pop_count + web.edge_pop_count;
case V_VERTEX_POP_COUNT:
return web.vertex_pop_count;
case V_EDGE_POP_COUNT:
return web.edge_pop_count;
case V_POP_TRI_TO_EDGE_COUNT:
return web.pop_tri_to_edge_count;
case V_POP_EDGE_TO_TRI_COUNT:
return web.pop_edge_to_tri_count;
case V_POP_QUAD_TO_QUAD_COUNT:
return web.pop_quad_to_quad_count;
case V_WHERE_COUNT:
return (REAL)web.where_count;
case V_EIGENPOS:
return (REAL)eigen_pos;
case V_EIGENNEG:
return (REAL)eigen_neg;
case V_EIGENZERO:
return (REAL)eigen_zero;
case V_CHECK_COUNT_:
return (REAL)check_count;
case V_VISIBILITY_DEBUG_:
return (REAL)visdebuglevel;
case V_SCROLLBUFFERSIZE_:
return (REAL)scrollbuffersize;
case V_BREAKFLAG_:
return (REAL)breakflag;
case V_PICKVNUM:
return (REAL)pickvnum;
case V_PICKENUM:
return (REAL)pickenum;
case V_PICKFNUM:
return (REAL)pickfnum;
case V_LINEAR_METRIC_MIX:
return linear_metric_mix;
case V_QUADRATIC_METRIC_MIX:
return quadratic_metric_mix;
case V_RANDOM_SEED:
return (REAL)random_seed;
case V_LAST_EIGENVALUE:
return last_eigenvalue;
case V_LAST_HESSIAN_SCALE:
return last_hessian_scale;
case V_LAGRANGE_ORDER:
return (REAL)web.lagrange_order;
case V_SCALE_LIMIT:
return web.maxscale;
case V_BRIGHTNESS:
return brightness;
case V_LAST_ERROR: return last_error;
case V_BACKGROUND: return background_color;
case V_PS_LABELSIZE_: return ps_labelsize;
case V_PS_STRINGWIDTH_: return ps_stringwidth;
case V_PS_FIXEDEDGEWIDTH_: return ps_fixededgewidth;
case V_PS_TRIPLEEDGEWIDTH_: return ps_tripleedgewidth;
case V_PS_CONEDGEWIDTH_: return ps_conedgewidth;
case V_PS_BAREEDGEWIDTH_: return ps_bareedgewidth;
case V_PS_GRIDEDGEWIDTH_: return ps_gridedgewidth;
case EVERYTHING_QUANTITIES_: return everything_quantities_flag;
case V_AUTOCHOP_LENGTH: return autochop_length;
case V_TRANSFORM_COUNT:
return transform_count == 0 ? 1 : transform_count;
case V_CLOCK:
#if defined (__SYS_TIMES_H__) && defined(HZ)
{ struct tms t;
times(&t);
return t.tms_utime/(REAL)HZ;
}
#else
#if defined (_SYS_TIMES_H) && defined(CLK_TCK)
{ struct tms t; /* SGI, anyway */
times(&t);
return t.tms_utime/(REAL)CLK_TCK;
}
#else
#ifdef CLOCKS_PER_SEC
return clock()/(REAL)CLOCKS_PER_SEC;
#else
return 0.0;
#endif
#endif
#endif
break;
case V_CPU_COUNTER:
{ int cycles[2];
PROF_NOW(cycles);
return PROF_CYCLES(cycles);
}
case V_MEMARENA:
#if defined(M_MXFAST) && defined(IRIS)
{ struct mallinfo m = mallinfo();
return (REAL)m.arena;
}
#else
#if defined(_UNISTD_H)
/* do this only on unix systems with unistd.h */
return (char*)sbrk(0)-(char*)&evolver_version;
#else
#ifdef MSC
{ struct _heapinfo hinfo;
long mem_use=0,mem_free=0;
hinfo._pentry = NULL;
while ( _heapwalk(&hinfo) == _HEAPOK )
if (hinfo._useflag) { mem_use+= hinfo._size; }
else { mem_free += hinfo._size; }
return (REAL)(mem_use+mem_free);
}
#else
#ifdef TC
{ struct heapinfo hinfo;
long mem_use=0,mem_free=0;
hinfo.ptr = NULL;
while ( heapwalk(&hinfo) == _HEAPOK )
if (hinfo.in_use) { mem_use+= hinfo.size; }
else { mem_free += hinfo.size; }
return (REAL)(mem_use+mem_free);
}
#else
return 0.0;
#endif
#endif
#endif
#endif
break;
case V_MEMUSED:
#if defined(M_MXFAST) && defined(IRIS)
{ struct mallinfo m = mallinfo();
return (REAL)(m.uordblks + m.usmblks);
}
#else
#ifdef WIN32
{ struct _heapinfo hinfo;
long mem_use=0,mem_free=0;
hinfo._pentry = NULL;
while ( _heapwalk(&hinfo) == _HEAPOK )
if (hinfo._useflag) { mem_use+= hinfo._size; }
else { mem_free += hinfo._size; }
return (REAL)(mem_use);
}
#else
return 0.0;
#endif
#endif
break;
default:
sprintf(errmsg,"Internal: illegal variable number %d.\n",vartok);
kb_error(1208, errmsg,RECOVERABLE);
}
return 0.0;
}
/**********************************************************************
*
* function: tree_copy()
*
* purpose: copy tree in linear postorder form
* allocates space for tree in destination
*
*/
void tree_copy(dest,src)
struct expnode *dest;
struct treenode *src;
{
struct treenode *enode;
size_t count,n;
if ( dest == NULL ) return;
if ( dest->start ) myfree((char*)dest->start);
if ( src == NULL )
{ dest->start = dest->root = NULL; return; }
enode=src;
while ( enode->left || enode->right )
{ if ( enode->left < enode->right ) enode+=enode->left;
else enode += enode->right;
}
count = src - enode + 1;
dest->start = (struct treenode *)mycalloc(count+3,sizeof(struct treenode));
dest->flag |= USERCOPY;
memcpy((char*)(dest->start+2),(char*)enode,count*sizeof(struct treenode));
dest->root = dest->start + count + 1;
dest->start[1].type = SETUP_FRAME_;
/* make copies of strings and locallists */
for ( enode=dest->start+2, n = 0 ; n < count ; enode++,n++ )
{ if ( enode->flags & HAS_STRING )
{ char *s = mycalloc(strlen(enode->op1.string)+1,sizeof(char));
strcpy(s,enode->op1.string);
enode->op1.string = s;
}
if ( enode->flags & HAS_STRING_5 )
{ char *s = mycalloc(strlen(enode->op5.string)+1,sizeof(char));
strcpy(s,enode->op5.string);
enode->op5.string = s;
}
if ( enode->flags & HAS_LOCALLIST )
{ struct locallist_t *locals =
(struct locallist_t *)mycalloc(1,sizeof(struct locallist_t));
*locals = *enode->op5.locals;
locals->list = (struct localvar_t *)mycalloc(enode->op5.locals->count,
sizeof(struct localvar_t));
memcpy(locals->list,enode->op5.locals->list,enode->op5.locals->count*
sizeof(struct localvar_t));
enode->op5.locals = locals;
}
}
/* copy root to first place */
dest->start[0] = *src;
if ( dest->start[0].left ) dest->start[0].left += (int)count+1;
if ( dest->start[0].right ) dest->start[0].right += (int)count+1;
/* FINISH node */
dest->start[count+2].type = FINISHED;
stack_usage(dest);
} /* end tree_copy() */
/**********************************************************************
*
* function: perm_tree_copy()
*
* purpose: copy tree in linear postorder form
* allocates permanent space for tree in destination
*
*/
void perm_tree_copy(dest,src)
struct expnode *dest;
struct treenode *src;
{
struct treenode *enode;
size_t count,n;
if ( dest == NULL ) return;
if ( dest->start ) free((char*)dest->start);
if ( src == NULL )
{ dest->start = dest->root = NULL; return; }
enode=src;
while ( enode->left || enode->right )
{ if ( enode->left < enode->right ) enode+=enode->left;
else enode += enode->right;
}
count = src - enode + 1;
dest->start = (struct treenode *)calloc(count+3,sizeof(struct treenode));
dest->flag |= USERCOPY;
memcpy((char*)(dest->start+2),(char*)enode,count*sizeof(struct treenode));
dest->root = dest->start + count + 1;
dest->start[1].type = SETUP_FRAME_;
/* make copies of strings */
for ( enode=dest->start+2, n = 0 ; n < count ; enode++,n++ )
{ if ( enode->flags & HAS_STRING )
{ char *s = calloc(strlen(enode->op1.string)+1,sizeof(char));
strcpy(s,enode->op1.string);
enode->op1.string = s;
}
enode->flags |= PERMNODE;
}
/* copy root to first place */
dest->start[0] = *src;
if ( dest->start[0].left ) dest->start[0].left += (int)count + 1;
if ( dest->start[0].right ) dest->start[0].right += (int)count + 1;
dest->start[0].flags |= PERMNODE;
/* FINISH node */
dest->start[count+2].type = FINISHED;
stack_usage(dest);
}
/*******************************************************************
*
* function: reduce_strings()
*
* purpose: converts escape sequences to ASCII in place
*
*/
void reduce_string(s)
char *s;
{ char *c = s;
while ( *s ) /* reduce escape sequences */
if ( *s == '\\' )
{
switch ( s[1] )
{ case 'n' : *(c++) = '\n'; s += 2; break;
case 't' : *(c++) = '\t'; s += 2; break;
case 'b' : *(c++) = '\b'; s += 2; break;
case 'r' : *(c++) = '\r'; s += 2; break;
case '\\' : *(c++) = '\\'; s += 2; break;
case 'q' : *(c++) = '"'; s += 2; break;
default: *(c++) = s[1]; s += 2; break;
}
}
else if (*s == '\n' ) s++; /* omit newlines */
else *(c++) = *(s++);
*c = '\0';
}
/***********************************************************************
*
* function: set_body()
*
* purpose: set facet body, or edge body in string model.
* Can set to NULLID.
*/
void set_body(id,b_id)
element_id id; /* edge or facet, inverted for backbody */
body_id b_id;
{
if ( id_type(id) == FACET )
{
body_id bb_id = get_facet_body(id);
int newp = valid_id(b_id) ? get_body_volmeth(b_id) : 0;
facetedge_id fe,start_fe;
set_facet_body(id,b_id);
if ( (web.representation == STRING) && everything_quantities_flag )
{ /* fix up edge volume quantities */
fe = start_fe = get_facet_fe(id);
do
{ edge_id e_id = get_fe_edge(fe);
if ( valid_id(bb_id) )
{ int oldp = get_body_volmeth(bb_id);
unapply_method(e_id,oldp);
}
if ( newp )
apply_method_num(e_id,newp);
else set_facet_area(id,0.0);
fe = get_next_edge(fe);
} while ( valid_id(fe) && !equal_id(fe,start_fe) );
}
return;
}
/* STRING model only hereafter! */
if ( (id_type(id) != EDGE) || (web.representation != STRING) )
{ sprintf(errmsg,"Trying to set body of wrong type element.\n");
kb_error(2056,errmsg,RECOVERABLE);
}
if ( !valid_id(b_id) )
{ facetedge_id fe,fe_id,next_fe,prev_fe;
facet_id f_id;
body_id bb_id;
/* unsetting edge body, so dissolving facetedge */
fe_id = get_edge_fe(id);
f_id = get_fe_facet(fe_id);
if ( !valid_id(f_id) ) return;
if ( inverted(f_id) )
{ fe_id = get_next_facet(fe_id);
f_id = get_fe_facet(fe_id);
}
if ( !valid_id(f_id) ) return;
if ( inverted(f_id) ) return;
/* check for being at beginning or end of edge arc */
fe = fe_id;
if ( valid_id(get_next_edge(fe)) && valid_id(get_prev_edge(fe)) )
{ /* check for full loop */
do { fe = get_next_edge(fe); }
while ( valid_id(fe) && !equal_id(fe,fe_id) );
if ( !valid_id(fe) )
{ if ( verbose_flag )
{ sprintf(msg,"Not unbodying edge %s since would make facet two arcs.\n",
ELNAME(id));
outstring(msg);
}
return;
}
}
/* Okay, ready to party. */
if ( everything_quantities_flag )
{ bb_id = get_facet_body(f_id);
if ( valid_id(bb_id) )
{ unapply_method(id,get_body_volmeth(bb_id));
}
}
next_fe = get_next_edge(fe_id);
prev_fe = get_prev_edge(fe_id);
if ( valid_id(next_fe) )
{ set_prev_edge(next_fe,NULLID);
set_facet_fe(f_id,next_fe);
}
if ( valid_id(prev_fe) )
set_next_edge(prev_fe,NULLID);
else if ( !valid_id(next_fe) )
set_facet_fe(f_id,NULLID);
if ( valid_id(get_next_facet(fe_id)) )
set_edge_fe(id,get_next_facet(fe_id));
set_next_facet(get_prev_facet(fe_id),get_next_facet(fe_id));
set_prev_facet(get_next_facet(fe_id),get_prev_facet(fe_id));
free_element(fe_id);
}
else /* valid id */
{ /* string model */
facet_id f_id = get_body_facet(b_id);
facetedge_id efe,eefe,fe,start_fe;
facetedge_id newfe;
body_id bb_id;
int inserted_flag=0; /* whether a linkup made */
if ( !valid_id(f_id) )
{ sprintf(errmsg,
"Need to set the body's facet before assigning edges.\n");
kb_error(2057,errmsg,RECOVERABLE);
}
if ( everything_quantities_flag )
{ bb_id = get_facet_body(f_id);
if ( valid_id(bb_id) )
{ unapply_method(id,get_body_volmeth(bb_id));
}
apply_method_num(id,get_body_volmeth(b_id));
}
newfe = new_facetedge(f_id,id);
efe = get_edge_fe(id);
if ( valid_id(get_fe_facet(efe)) )
{ eefe = get_next_facet(efe);
set_next_facet(efe,newfe);
set_next_facet(newfe,eefe);
set_prev_facet(eefe,newfe);
set_prev_facet(newfe,efe);
}
else
{ if (valid_id(efe)) free_element(efe);
set_next_facet(newfe,newfe);
set_prev_facet(newfe,newfe);
set_edge_fe(id,newfe);
}
/* see if can place at head or end of chain */
fe = start_fe = get_facet_fe(f_id);
if ( !valid_id(fe) )
{ /* naked facet */
set_facet_fe(f_id,newfe); inserted_flag = 1;
}
else
{ if ( !valid_id(get_prev_edge(fe)) )
{ if ( equal_id(get_fe_tailv(fe),get_edge_headv(id)) )
{ set_next_edge(newfe,fe); set_prev_edge(fe,newfe);
set_facet_fe(f_id,newfe); inserted_flag = 1;
}
}
while ( valid_id(get_next_edge(fe)) &&
!equal_id(get_next_edge(fe),start_fe) )
fe = get_next_edge(fe);
if ( !valid_id(get_next_edge(fe)) )
{ if ( equal_id(get_fe_headv(fe),get_edge_tailv(id)) )
{ set_next_edge(fe,newfe); set_prev_edge(newfe,fe);
inserted_flag = 1;
}
}
}
if ( !inserted_flag )
{ sprintf(errmsg,"Could not link edge %s onto facet %s chain.\n",
ELNAME(id),ELNAME1(f_id));
kb_error(2058,errmsg,WARNING);
}
}
} /* end set_body() */
/***************************************************************************
*
* function: change_hessian_functions()
*
* purpose: Switch sets of Hessian functions.
*/
void change_hessian_functions(oldh,newh)
int oldh,newh;
{
if ( oldh == newh ) return;
switch ( newh )
{ case MINDEG_FACTORING:
{
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = xmd_factor;
sp_solve_func = xmd_solve;
sp_solve_multi_func = xmd_solve_multi;
sp_ordering_func = NULL;
sp_CHinvC_func = sp_CHinvC;
outstring("Using alternate minimal degree. ");
switch ( oldh )
{ case YSMP_FACTORING: outstring("(was YSMP)\n"); break;
case MINDEG_FACTORING: outstring("(was alt min deg)\n"); break;
case METIS_FACTORING: outstring("(was metis)\n"); break;
}
}
break;
case YSMP_FACTORING:
{
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = ysmp_factor;
sp_CHinvC_func = sp_CHinvC;
sp_solve_func = ysmp_solve;
sp_solve_multi_func = ysmp_solve_multi;
sp_ordering_func = NULL;
outstring("Using YSMP. ");
switch ( oldh )
{ case YSMP_FACTORING: outstring("(was YSMP)\n"); break;
case MINDEG_FACTORING: outstring("(was alt min deg)\n"); break;
case METIS_FACTORING: outstring("(was metis)\n"); break;
}
#if defined(TC) && defined(LONGDOUBLE)
erroutstring("WARNING: YSMP is buggy in this long double version.\n");
#endif
}
break;
case METIS_FACTORING:
{
sp_mul_func = bk_mul;
sp_AIJ_setup_func= bk_AIJ_setup;
sp_constraint_setup_func = bk_constraint_setup;
sp_hess_project_setup_func= BK_hess_project_setup;
sp_factor_func = ysmp_factor;
sp_CHinvC_func = sp_CHinvC;
sp_solve_func = ysmp_solve;
sp_solve_multi_func = ysmp_solve_multi;
/*
tree stuff not working
sp_factor_func = tree_factor;
sp_solve_func = tree_solve;
sp_solve_multi_func = tree_solve_multi;
*/
sp_ordering_func = metis_order;
outstring("Using Metis ordering in ysmp factoring. ");
switch ( oldh )
{ case YSMP_FACTORING: outstring("(was YSMP)\n"); break;
case MINDEG_FACTORING: outstring("(was alt min deg)\n"); break;
case METIS_FACTORING: outstring("(was metis)\n"); break;
}
}
}
ysmp_flag = newh;
} /* end change_hessian_functions() */
evolver-2.30c.dfsg/src/meanint.c 0000644 0001753 0001753 00000215450 11410765113 017023 0 ustar hazelsct hazelsct /*************************************************************
* This file is part of the Surface Evolver source code. *
* Programmer: Ken Brakke, brakke@susqu.edu *
*************************************************************/
/*************************************************************
*
* file: meanint.c
*
* Purpose: Implements routines for integral of mean
* curvature over a surface. Computation is
* exact, as the integral can be defined for a
* polyhedral surface as edge dihedral angle
* times edge length. Mean curvature is average
* of sectional curvatures, not sum.
*
* Implemented as general quantity. Uses info
* passed in qinfo structure.
* qinfo has vertices: tail,head,left wing, right wing
* qinfo has sides: edge,left from tail, right from tail
* Basic formulas:
*
* cos(theta) = -
* _________________________________________________
* sqrt(