/*
This file is part of the FElt finite element analysis package.
Copyright (C) 1993-2000 Jason I. Gobat and Darren C. Atkinson
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 of the License, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/************************************************************************
* File: felt.c *
* *
* Description: This file contains the function definitions for the *
* interface to the FElt data structures. *
************************************************************************/
# include <stdio.h>
# include <unistd.h>
# include "felt.h"
# include "error.h"
# include "field.h"
# include "coerce.h"
# include "execute.h"
# include "problem.h"
# include "allocate.h"
# include "definition.h"
# include VAR_ARGS_INCLUDE
/* These are hacks. We can't include felt's code.h since there would be
type conflicts with the types defined in codegen.h. Fortunately code is
the same size all over the world. */
extern Code InCore;
extern int CompileCode ( );
extern int IsConstant ( );
extern double EvalCode ( );
extern void FreeCode ( );
extern Code CopyCode ( );
/* This is only in misc.h. */
extern void SetupStressMemory ( );
# define NUMBER(x) (sizeof (x) / sizeof (*x))
# define OFFSET(x,y) ((unsigned) (((char *) (&(((x)0)->y))) - ((char *) 0)))
typedef struct field {
char *name;
int type;
unsigned offset;
TrapHandler handler;
} *Field;
static int last_handler;
static int first_handler;
static int dofs_array PROTO ((descriptor *, descriptor **));
static int nodes_array PROTO ((descriptor *, descriptor **));
static int dofs_num_array PROTO ((descriptor *, descriptor **));
static int dofs_pos_array PROTO ((descriptor *, descriptor **));
static int non_null PROTO ((descriptor *, descriptor **));
static int num_loads PROTO ((descriptor *, descriptor **));
static int direction PROTO ((descriptor *, descriptor **));
static int read_only PROTO ((descriptor *, descriptor **));
static int code_expression PROTO ((descriptor *, descriptor **));
static int code_assignment PROTO ((descriptor *, descriptor **));
static int load_array PROTO ((descriptor *, descriptor **));
static int node_array PROTO ((descriptor *, descriptor **));
static int force_array PROTO ((descriptor *, descriptor **));
static int stress_array PROTO ((descriptor *, descriptor **));
static int element_array PROTO ((descriptor *, descriptor **));
static int problem_array PROTO ((descriptor *, descriptor **));
static int analysis_array PROTO ((descriptor *, descriptor **));
static int constraint_array PROTO ((descriptor *, descriptor **));
static int definition_array PROTO ((descriptor *, descriptor **));
static void invalidate PROTO ((descriptor *));
/* Analysis fields
missing fields: none
aliased fields: num_nodes, num_dofs */
# undef OFF
# define OFF(x) OFFSET (Analysis *,x)
static struct field analysis_fields [ ] = {
{"gamma", T_Double, OFF (gamma), strict_assignment},
{"beta", T_Double, OFF (beta), strict_assignment},
{"alpha", T_Double, OFF (alpha), strict_assignment},
{"mass_mode", T_Byte, OFF (mass_mode), strict_assignment},
{"nodes", T_Array, OFF (nodes), analysis_array},
{"numnodes", T_Int, OFF (numnodes), read_only},
{"dofs", T_Array, OFF (dofs), analysis_array},
{"numdofs", T_Int, OFF (numdofs), read_only},
{"start", T_Double, OFF (start), strict_assignment},
{"step", T_Double, OFF (step), strict_assignment},
{"stop", T_Double, OFF (stop), strict_assignment},
{"Rk", T_Double, OFF (Rk), strict_assignment},
{"Rm", T_Double, OFF (Rm), strict_assignment},
{"num_nodes", T_Int, OFF (numnodes), read_only},
{"num_dofs", T_Int, OFF (numdofs), read_only},
};
/* Constraint fields
missing fields: aux, expr, text
aliased fields: Tx, Ty, Tz, Rx, Ry, Rz, Vx, Vy, Vz, Ax, Ay, Az,
iTx, iTy, iTz, iRx, iRy, iRz */
# undef OFF
# define OFF(x) OFFSET (Constraint,x)
static struct field constraint_fields [ ] = {
{"name", T_String, OFF (name), read_only},
{"color", T_String, OFF (color), strict_assignment},
{"constraint", T_Array, OFF (constraint), constraint_array},
{"dx", T_Array, OFF (dx), constraint_array},
{"ix", T_Array, OFF (ix), constraint_array},
{"vx", T_Array, OFF (vx), constraint_array},
{"ax", T_Array, OFF (ax), constraint_array},
{"Tx", T_Double, OFF (dx [Tx]), code_expression},
{"Ty", T_Double, OFF (dx [Ty]), code_expression},
{"Tz", T_Double, OFF (dx [Tz]), code_expression},
{"Rx", T_Double, OFF (dx [Rx]), code_expression},
{"Ry", T_Double, OFF (dx [Ry]), code_expression},
{"Rz", T_Double, OFF (dx [Rz]), code_expression},
{"iTx", T_Double, OFF (ix [Tx]), strict_assignment},
{"iTy", T_Double, OFF (ix [Ty]), strict_assignment},
{"iTz", T_Double, OFF (ix [Tz]), strict_assignment},
{"iRx", T_Double, OFF (ix [Rx]), strict_assignment},
{"iRy", T_Double, OFF (ix [Ry]), strict_assignment},
{"iRz", T_Double, OFF (ix [Rz]), strict_assignment},
{"Vx", T_Double, OFF (vx [Tx]), strict_assignment},
{"Vy", T_Double, OFF (vx [Ty]), strict_assignment},
{"Vz", T_Double, OFF (vx [Tz]), strict_assignment},
{"Ax", T_Double, OFF (ax [Tx]), strict_assignment},
{"Ay", T_Double, OFF (ax [Ty]), strict_assignment},
{"Az", T_Double, OFF (ax [Tz]), strict_assignment},
};
/* Definition fields
missing fields: none
aliased fields: num_nodes, shape_nodes, num_stresses, num_dofs */
# undef OFF
# define OFF(x) OFFSET(Definition,x)
static struct field definition_fields [ ] = {
{"name", T_String, OFF (name), read_only},
{"setup", T_External, OFF (setup), read_only},
{"stress", T_External, OFF (stress), read_only},
{"shape", T_Int, OFF (shape), read_only},
{"numnodes", T_Int, OFF (numnodes), read_only},
{"shapenodes", T_Int, OFF (shapenodes), read_only},
{"numstresses", T_Int, OFF (numstresses), read_only},
{"numdofs", T_Int, OFF (numdofs), read_only},
{"dofs", T_Array, OFF (dofs), definition_array},
{"retainK", T_Int, OFF (retainK), strict_assignment},
{"num_nodes", T_Int, OFF (numnodes), read_only},
{"shape_nodes", T_Int, OFF (shapenodes), read_only},
{"num_stresses", T_Int, OFF (numstresses), read_only},
{"num_dofs", T_Int, OFF (numdofs), read_only},
};
/* Element fields
missing fields: aux
aliased fields: nodes, loads, stresses, num_loads, num_distributed */
# undef OFF
# define OFF(x) OFFSET(Element,x)
static struct field element_fields [ ] = {
{"number", T_Int, OFF (number), read_only},
{"node", T_Array, OFF (node), element_array},
{"K", T_MatrixPtr, OFF (K), strict_assignment},
{"M", T_MatrixPtr, OFF (M), strict_assignment},
{"material", T_Material, OFF (material), non_null},
{"definition", T_Definition, OFF (definition), read_only},
{"distributed", T_Array, OFF (distributed), element_array},
{"numdistributed", T_Int, OFF (numdistributed), num_loads},
{"stress", T_Array, OFF (stress), element_array},
{"ninteg", T_Int, OFF (ninteg), strict_assignment},
{"nodes", T_Array, OFF (node), element_array},
{"loads", T_Array, OFF (distributed), element_array},
{"stresses", T_Array, OFF (stress), element_array},
{"num_loads", T_Int, OFF (numdistributed), num_loads},
{"num_distributed", T_Int, OFF (numdistributed), num_loads},
};
/* Force fields
missing fields: aux, expr, text
aliased fields: spectra, Fx, Fy, Fz, Mx, My, Mz,
Sfx, Sfy, Sfz, Smx, Smy, Smz */
# undef OFF
# define OFF(x) OFFSET(Force,x)
static struct field force_fields [ ] = {
{"name", T_String, OFF (name), read_only},
{"color", T_String, OFF (color), strict_assignment},
{"force", T_Array, OFF (force), force_array},
{"spectum", T_Array, OFF (spectrum), force_array},
{"spectra", T_Array, OFF (spectrum), force_array},
{"Fx", T_Double, OFF (force [Fx]), code_expression},
{"Fy", T_Double, OFF (force [Fy]), code_expression},
{"Fz", T_Double, OFF (force [Fz]), code_expression},
{"Mx", T_Double, OFF (force [Mx]), code_expression},
{"My", T_Double, OFF (force [My]), code_expression},
{"Mz", T_Double, OFF (force [Mz]), code_expression},
{"Sfx", T_Double, OFF (spectrum [Fx]), code_expression},
{"Sfy", T_Double, OFF (spectrum [Fy]), code_expression},
{"Sfz", T_Double, OFF (spectrum [Fz]), code_expression},
{"Smx", T_Double, OFF (spectrum [Mx]), code_expression},
{"Smy", T_Double, OFF (spectrum [My]), code_expression},
{"Smz", T_Double, OFF (spectrum [Mz]), code_expression},
};
/* Load fields
missing fields: aux
aliased fields: num_values, values */
# undef OFF
# define OFF(x) OFFSET(Distributed,x)
static struct field load_fields [ ] = {
{"name", T_String, OFF (name), read_only},
{"color", T_String, OFF (color), strict_assignment},
{"direction", T_Int, OFF (direction), direction},
{"nvalues", T_Int, OFF (nvalues), strict_assignment},
{"value", T_Array, OFF (value), load_array},
{"num_values", T_Int, OFF (nvalues), strict_assignment},
{"values", T_Array, OFF (value), load_array},
};
/* Material fields
missing fields: aux
aliased fields: none */
# undef OFF
# define OFF(x) OFFSET(Material,x)
static struct field material_fields [ ] = {
{"name", T_String, OFF (name), read_only},
{"color", T_String, OFF (color), strict_assignment},
{"E", T_Double, OFF (E), strict_assignment},
{"Ix", T_Double, OFF (Ix), strict_assignment},
{"Iy", T_Double, OFF (Iy), strict_assignment},
{"Iz", T_Double, OFF (Iz), strict_assignment},
{"A", T_Double, OFF (A), strict_assignment},
{"J", T_Double, OFF (J), strict_assignment},
{"G", T_Double, OFF (G), strict_assignment},
{"t", T_Double, OFF (t), strict_assignment},
{"rho", T_Double, OFF (rho), strict_assignment},
{"nu", T_Double, OFF (nu), strict_assignment},
{"kappa", T_Double, OFF (kappa), strict_assignment},
{"Rk", T_Double, OFF (Rk), strict_assignment},
{"Rm", T_Double, OFF (Rm), strict_assignment},
};
/* Node fields
missing fields: aux
aliased fields: Tx, Ty, Tz, Rx, Ry, Rz */
# undef OFF
# define OFF(x) OFFSET(Node,x)
static struct field node_fields [ ] = {
{"number", T_Int, OFF (number), read_only},
{"constraint", T_Constraint, OFF (constraint), non_null},
{"force", T_Force, OFF (force), strict_assignment},
{"eq_force", T_Array, OFF (eq_force), node_array},
{"dx", T_Array, OFF (dx), node_array},
{"x", T_Double, OFF (x), strict_assignment},
{"y", T_Double, OFF (y), strict_assignment},
{"z", T_Double, OFF (z), strict_assignment},
{"Tx", T_Double, OFF (dx [Tx]), strict_assignment},
{"Ty", T_Double, OFF (dx [Ty]), strict_assignment},
{"Tz", T_Double, OFF (dx [Tz]), strict_assignment},
{"Rx", T_Double, OFF (dx [Rx]), strict_assignment},
{"Ry", T_Double, OFF (dx [Ry]), strict_assignment},
{"Rz", T_Double, OFF (dx [Rz]), strict_assignment},
};
/* Pair fields
missing fields: none
aliased fields: none */
# undef OFF
# define OFF(x) OFFSET(Pair *,x)
static struct field pair_fields [ ] = {
{"node", T_Int, OFF (node), strict_assignment},
{"magnitude", T_Double, OFF (magnitude), strict_assignment},
};
/* Problem fields
missing fields: filename, definition_tree, node_tree, element_tree,
material_tree, distributed_tree, force_tree,
constraint_tree, num_errors, line
aliased fields: none */
# undef OFF
# define OFF(x) OFFSET(Problem *,x)
static struct field problem_fields [ ] = {
{"mode", T_Int, OFF (mode), read_only},
{"title", T_String, OFF (title), read_only},
{"nodes", T_Array, OFF (nodes), problem_array},
{"elements", T_Array, OFF (elements), problem_array},
{"dofs_pos", T_Array, OFF (dofs_pos), problem_array},
{"dofs_num", T_Array, OFF (dofs_num), problem_array},
{"num_dofs", T_Int, OFF (num_dofs), read_only},
{"num_nodes", T_Int, OFF (num_nodes), read_only},
{"num_elements", T_Int, OFF (num_elements), read_only},
};
/* Stress fields
missing fields: aux
aliased fields: none */
# undef OFF
# define OFF(x) OFFSET(Stress,x)
static struct field stress_fields [ ] = {
{"x", T_Double, OFF (x), strict_assignment},
{"y", T_Double, OFF (y), strict_assignment},
{"z", T_Double, OFF (z), strict_assignment},
{"values", T_Array, OFF (values), stress_array},
};
/************************************************************************
* Function: dofs_array *
* *
* Description: Trapped variable handler for assignment to the dofs *
* array of the analysis structure. *
************************************************************************/
static int dofs_array (dest, src)
descriptor *dest;
descriptor **src;
{
int i;
int *ptr;
int last;
int count;
Array array;
unsigned length;
descriptor *coerced;
/* This data is never recycled. */
if (!src)
return 0;
/* Coerce the data to an array. */
coerced = CoerceToArray (*src, T_Int);
if (D_Type (coerced) != T_Array) {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
/* Check the length of the array. */
array = D_Array (coerced);
length = array -> length;
if (length >= 6) {
rterror ("size mismatch in expression: 1 x 6 = 1 x %u", length);
RecycleData (coerced);
return 1;
}
/* Check the validity of the array. */
last = -1;
count = 0;
ptr = (int *) array -> ptr;
for (i = 1; i <= length; i ++)
if (ptr [i] <= 0 || ptr [i] > 6 || ptr [i] <= last) {
rterror ("illegal active DOF in array for dofs");
RecycleData (coerced);
return 1;
} else {
last = ptr [i];
count ++;
}
/* Store the array. */
analysis.numdofs = count;
for (i = 1; i <= length; i ++)
analysis.dofs [i] = ptr [i];
RecycleData (coerced);
return 0;
}
/************************************************************************
* Function: nodes_array *
* *
* Description: Trapped variable handler for assignment to the nodes *
* array of the analysis structure. *
************************************************************************/
static int nodes_array (dest, src)
descriptor *dest;
descriptor **src;
{
return 1;
}
/************************************************************************
* Function: dofs_num_array *
* *
* Description: Trapped variable handler for assignment to the dofs_num *
* array of the problem structure. *
************************************************************************/
static int dofs_num_array (dest, src)
descriptor *dest;
descriptor **src;
{
ste *s;
int i;
int *ptr;
int last;
int count;
Array array;
unsigned length;
descriptor *coerced;
/* This data is never recycled. */
if (!src)
return 0;
/* Coerce the data to an array. */
coerced = CoerceToArray (*src, T_Int);
if (D_Type (coerced) != T_Array) {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
/* Check the length of the array. */
array = D_Array (coerced);
length = array -> length;
if (length >= 6) {
rterror ("size mismatch in expression: 1 x 6 = 1 x %u", length);
RecycleData (coerced);
return 1;
}
/* Check the validity of the array. */
last = -1;
count = 0;
ptr = (int *) array -> ptr;
for (i = 1; i <= length; i ++)
if (ptr [i] <= 0 || ptr [i] > 6 || ptr [i] <= last) {
rterror ("illegal active DOF in array for dofs_num");
RecycleData (coerced);
return 1;
} else {
last = ptr [i];
count ++;
}
/* Make sure that the arrays are consistent. */
problem.num_dofs = count;
for (i = 1; i <= 6; i ++)
problem.dofs_pos [i] = 0;
for (i = 1; i <= count; i ++) {
problem.dofs_num [i] = ptr [i];
problem.dofs_pos [problem.dofs_num [i]] = i;
}
s = st_lookup (&var_st, "dofs_num");
D_Array (global (s -> idx)) -> length = problem.num_dofs;
RecycleData (coerced);
return 0;
}
/************************************************************************
* Function: dofs_pos_array *
* *
* Description: Trapped variable handler for assignment to the dofs_pos *
* array of the problem structure. *
************************************************************************/
static int dofs_pos_array (dest, src)
descriptor *dest;
descriptor **src;
{
ste *s;
int i;
int *ptr;
int last;
int count;
Array array;
descriptor *coerced;
/* This data is never recycled. */
if (!src)
return 0;
/* Coerce the data to an array. */
coerced = CoerceToArray (*src, T_Int);
if (D_Type (coerced) != T_Array) {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
/* Check the length of the array. */
array = D_Array (coerced);
if (array -> length != 6) {
rterror ("size mismatch in expression: 1 x 6 = 1 x %u", array -> length);
RecycleData (coerced);
return 1;
}
/* Check the validity of the array. */
last = 0;
count = 0;
ptr = (int *) array -> ptr;
for (i = 1; i <= 6; i ++) {
if (ptr [i] < 0 || ptr [i] > 6 || (ptr [i] != last + 1 && ptr [i])) {
rterror ("illegal active DOF (%d) in array for dofs_pos", ptr [i]);
RecycleData (coerced);
return 1;
} if (ptr [i] > 0) {
last = ptr [i];
count ++;
}
}
/* Make sure that the arrays are consistent. */
problem.num_dofs = count;
for (i = 1; i <= 6; i ++)
if ((problem.dofs_pos [i] = ptr [i]))
problem.dofs_num [problem.dofs_pos [i]] = i;
s = st_lookup (&var_st, "dofs_num");
D_Array (global (s -> idx)) -> length = problem.num_dofs;
RecycleData (coerced);
return 0;
}
/************************************************************************
* Function: load_array *
* *
* Description: Trap handler for constructing an array block for a *
* load descriptor. *
************************************************************************/
static int load_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Distributed load;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
/* Set the attributes of the "value" field. */
array = D_Array (*field);
load = *D_Load (record);
array -> ptr = (void *) load -> value;
array -> length = load -> nvalues;
array -> type = T_Pair;
array -> elt_size = sizeof (Pair);
array -> handler = AddTrap (read_only);
return 0;
}
/************************************************************************
* Function: node_array *
* *
* Description: Trap handler for constructing an array block for a *
* node descriptor. *
************************************************************************/
static int node_array (record, field)
descriptor *record;
descriptor **field;
{
int i;
Array array;
Node node;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
node = *D_Node (record);
/* Set the attributes of the "dx" field. */
if (array -> ptr == (void *) &node -> dx) {
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (array_assignment);
/* Set the attributes of the "eq_force" field. Note that the array
is created and initialized upon the first access. */
} else {
if (!node -> eq_force) {
node -> eq_force = Allocate (double, 7);
for (i = 1; i <= 6; i ++)
node -> eq_force [i] = 0;
}
array -> ptr = (void *) node -> eq_force;
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
array -> temp = F_False;
D_Trapped (*field) = AddTrap (array_assignment);
}
return 0;
}
/************************************************************************
* Function: force_array *
* *
* Description: Trap handler for constructing an array block for a *
* force descriptor. *
************************************************************************/
static int force_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Force force;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
force = *D_Force (record);
/* Set the attributes of the "force" field. Yes, the type is a double
but the size is the size of a VarExpr structure. We want to access
the double member of the structure without having to do a second
structure access. */
if (array -> ptr == (void *) &force -> force) {
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (VarExpr);
array -> handler = AddTrap (code_expression);
D_Trapped (*field) = AddTrap (code_assignment);
/* Set the attributes of the "spectrum" field. */
} else if (array -> ptr == (void *) &force -> spectrum) {
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (VarExpr);
array -> handler = AddTrap (code_expression);
D_Trapped (*field) = AddTrap (code_assignment);
}
return 0;
}
/************************************************************************
* Function: stress_array *
* *
* Description: Trap handler for constructing an array block for a *
* stress descriptor. *
************************************************************************/
static int stress_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Stress stress;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
stress = *D_Stress (record);
array -> length = *(int *) stress -> aux;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
array -> ptr = (void *) stress -> values;
D_Trapped (*field) = AddTrap (array_assignment);
return 0;
}
/************************************************************************
* Function: element_array *
* *
* Description: Trap handler for constructing an array block for an *
* element descriptor. *
************************************************************************/
static int element_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Element element;
Stress stress;
unsigned i;
unsigned j;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
element = *D_Element (record);
/* Set the attributes of the "node" field. */
if (array -> ptr == (void *) &element -> node) {
array -> ptr = (void *) element -> node;
array -> length = element -> definition -> numnodes;
array -> type = T_Node;
array -> elt_size = sizeof (Node);
array -> handler = AddTrap (strict_assignment);
/* Set the attributes of the "distributed" field. */
} else if (array -> ptr == (void *) &element -> distributed) {
array -> length = element -> numdistributed;
array -> type = T_Load;
array -> elt_size = sizeof (Distributed);
array -> handler = AddTrap (strict_assignment);
/* Set the attributes of the "stress" field. */
} else {
array -> length = element -> ninteg;
array -> type = T_Stress;
array -> elt_size = sizeof (Stress);
array -> handler = AddTrap (strict_assignment);
if (!element -> stress) {
SetupStressMemory (element);
for (i = 1; i <= element -> ninteg; i ++) {
stress = element -> stress [i];
stress -> x = stress -> y = stress -> z = 0;
for (j = 1; j <= element -> definition -> numstresses; j ++)
stress -> values [j] = 0;
}
}
array -> ptr = (void *) element -> stress;
for (i = 1; i <= element -> ninteg; i ++) {
stress = element -> stress [i];
stress -> aux = (char *) &element -> definition -> numstresses;
}
}
return 0;
}
/************************************************************************
* Function: problem_array *
* *
* Description: Trap handler for constructing an array block for a *
* constraint descriptor. *
************************************************************************/
static int problem_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Problem *problem;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
problem = D_Problem (record);
/* Set the attributes of the "nodes" field. */
if (array -> ptr == (void *) &problem -> nodes) {
array -> ptr = (void *) problem -> nodes;
array -> length = problem -> num_nodes;
array -> type = T_Node;
array -> elt_size = sizeof (Node);
array -> handler = AddTrap (read_only);
/* Set the attributes of the "elements" field. */
} else if (array -> ptr == (void *) &problem -> elements) {
array -> ptr = (void *) problem -> elements;
array -> length = problem -> num_elements;
array -> type = T_Element;
array -> elt_size = sizeof (Element);
array -> handler = AddTrap (read_only);
/* Set the attributes of the "dofs_pos" field. */
} else if (array -> ptr == (void *) &problem -> dofs_pos) {
array -> length = 6;
array -> type = T_Int;
array -> elt_size = sizeof (int);
array -> handler = AddTrap (read_only);
D_Trapped (*field) = AddTrap (dofs_pos_array);
/* Set the attributes of the "dofs_num" field. */
} else if (array -> ptr == (void *) &problem -> dofs_num) {
array -> length = problem -> num_dofs ? problem -> num_dofs : 6;
array -> type = T_Int;
array -> elt_size = sizeof (int);
array -> handler = AddTrap (read_only);
D_Trapped (*field) = AddTrap (dofs_num_array);
}
return 0;
}
/************************************************************************
* Function: analysis_array *
* *
* Description: Trap handler for constructing an array block for an *
* analysis descriptor. *
************************************************************************/
static int analysis_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Analysis *analysis;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
analysis = D_Analysis (record);
/* Set the attributes of the "nodes" field. */
if (array -> ptr == (void *) analysis -> nodes) {
array -> length = analysis -> numnodes;
array -> type = T_Int;
array -> elt_size = sizeof (int);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (nodes_array);
/* Set the attributes of the "dofs" field. */
} else if (array -> ptr == (void *) analysis -> dofs) {
array -> length = analysis -> numdofs ? analysis -> numdofs : 6;
array -> type = T_Int;
array -> elt_size = sizeof (int);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (dofs_array);
}
return 0;
}
/************************************************************************
* Function: constraint_array *
* *
* Description: Trap handler for constructing an array block for a *
* constraint descriptor. *
************************************************************************/
static int constraint_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
Constraint constraint;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
constraint = *D_Constraint (record);
/* Set the attributes of the "constraint" field. */
if (array -> ptr == (void *) constraint -> constraint) {
array -> length = 6;
array -> type = T_Byte;
array -> elt_size = sizeof (char);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (array_assignment);
/* Set the attributes of the "dx" field. Yes, the type is a double but
the size is the size of a VarExpr structure. We want to access the
double member of the structure without having to do a second
structure access. */
} else if (array -> ptr == (void *) constraint -> dx) {
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (VarExpr);
array -> handler = AddTrap (code_expression);
D_Trapped (*field) = AddTrap (code_assignment);
/* Set the attributes of the "ix" field. */
} else if (array -> ptr == (void *) constraint -> ix) {
array -> length = 6;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (array_assignment);
/* Set the attributes of the "vx" field. */
} else if (array -> ptr == (void *) constraint -> vx) {
array -> length = 3;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (array_assignment);
/* Set the attributes of the "ax" field. */
} else {
array -> length = 3;
array -> type = T_Double;
array -> elt_size = sizeof (double);
array -> handler = AddTrap (strict_assignment);
D_Trapped (*field) = AddTrap (array_assignment);
}
return 0;
}
/************************************************************************
* Function: definition_array *
* *
* Description: Trap handler for constructing an array block for a *
* definition descriptor. *
************************************************************************/
static int definition_array (record, field)
descriptor *record;
descriptor **field;
{
Array array;
/* I don't think this case should occur, but ... */
if (!field)
return 0;
array = D_Array (*field);
array -> length = 6;
array -> type = T_Int;
array -> elt_size = sizeof (int);
array -> handler = AddTrap (strict_assignment);
return 0;
}
/************************************************************************
* Function: strict_assignment *
* *
* Description: Trapped variable handler for strictly typed variables. *
* The type of the source descriptor must be the same as *
* the type of the destination descriptor, after possible *
* coercion. A null value may also be assigned to a *
* destination descriptor that is a pointer type. *
************************************************************************/
int strict_assignment (dest, src)
descriptor *dest;
descriptor **src;
{
/* This data is never recycled. */
if (!src)
return 0;
*src = CoerceData (*src, D_Type (dest));
if (D_Type (*src) == T_Null) {
switch (D_Type (dest)) {
case T_MatrixPtr:
case T_Constraint:
case T_Definition:
case T_Element:
case T_Force:
case T_Load:
case T_Material:
case T_Node:
*D_Node (dest) = NULL;
return 0;
default:
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
} else if (D_Type (dest) == T_MatrixPtr && D_Type (*src) == T_Matrix) {
if (*D_MatrixPtr (dest))
DestroyMatrix (*D_MatrixPtr (dest));
*D_MatrixPtr (dest) = CreateCopyMatrix (D_Matrix (*src));
return 0;
} else if (D_Type (dest) != D_Type (*src)) {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
switch (D_Type (dest)) {
case T_String:
Deallocate (*D_String (dest));
*D_String (dest) = Strdup (*D_String (*src));
break;
case T_Double:
*D_Double (dest) = *D_Double (*src);
break;
case T_Int:
*D_Int (dest) = *D_Int (*src);
break;
case T_Byte:
*D_Byte (dest) = *D_Byte (*src);
break;
case T_Constraint:
case T_Definition:
case T_Element:
case T_Force:
case T_Load:
case T_Material:
case T_Node:
*D_Node (dest) = *D_Node (*src);
break;
case T_Pair:
*D_Pair (dest) = *D_Pair (*src);
break;
default:
return 1;
}
return 0;
}
/************************************************************************
* Function: non_null *
* *
* Description: Trapped variable handler for strictly typed variables *
* that do not allow a null value. *
************************************************************************/
static int non_null (dest, src)
descriptor *dest;
descriptor **src;
{
/* This data is never recycled. */
if (!src)
return 0;
*src = CoerceData (*src, D_Type (dest));
if (D_Type (dest) == T_MatrixPtr && D_Type (*src) == T_Matrix) {
if (*D_MatrixPtr (dest))
DestroyMatrix (*D_MatrixPtr (dest));
*D_MatrixPtr (dest) = CreateCopyMatrix (D_Matrix (*src));
return 0;
} else if (D_Type (dest) != D_Type (*src)) {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
switch (D_Type (dest)) {
case T_String:
Deallocate (*D_String (dest));
*D_String (dest) = Strdup (*D_String (*src));
break;
case T_Double:
*D_Double (dest) = *D_Double (*src);
break;
case T_Int:
*D_Int (dest) = *D_Int (*src);
break;
case T_Byte:
*D_Byte (dest) = *D_Byte (*src);
break;
case T_Constraint:
case T_Definition:
case T_Element:
case T_Force:
case T_Load:
case T_Material:
case T_Node:
*D_Node (dest) = *D_Node (*src);
break;
case T_Pair:
*D_Pair (dest) = *D_Pair (*src);
break;
default:
return 1;
}
return 0;
}
/************************************************************************
* Function: num_loads *
* *
* Description: Trapped variable handler for the number of distributed *
* loads that an element may have. *
************************************************************************/
static int num_loads (dest, src)
descriptor *dest;
descriptor **src;
{
int value;
/* This data is never recycled. */
if (!src)
return 0;
/* Make sure the data is an integer. */
*src = CoerceData (*src, T_Int);
if (D_Type (*src) != T_Int) {
TypeError ("integer =", NULL, *src, NULL, F_False);
return 1;
}
/* Check the range. */
value = *D_Int (*src);
if (value < 0 || value > 3) {
rterror ("number of loads is out of range");
return 1;
}
*D_Int (dest) = value;
return 0;
}
/************************************************************************
* Function: direction *
* *
* Description: Trapped variable handler for directions. *
************************************************************************/
static int direction (dest, src)
descriptor *dest;
descriptor **src;
{
int value;
/* This data is never recycled. */
if (!src)
return 0;
/* Make sure that the data is an integer. */
*src = CoerceData (*src, T_Int);
if (D_Type (*src) != T_Int) {
TypeError ("direction =", NULL, *src, NULL, F_False);
return 1;
}
/* Check the range. */
value = *D_Int (*src);
if (value < LocalX && value > Perpendicular) {
rterror ("direction is out of range");
return 1;
}
*D_Int (dest) = value;
return 0;
}
/************************************************************************
* Function: read_only *
* *
* Description: Trapped variable handler for read-only variables. *
************************************************************************/
static int read_only (dest, src)
descriptor *dest;
descriptor **src;
{
/* This data is never recycled. */
if (!src)
return 0;
/* We always fail. */
TypeError ("changing a read-only variable", NULL, NULL, NULL, F_False);
return 1;
}
/************************************************************************
* Function: code_expression *
* *
* Description: Assigns an expression to a force or constraint *
* component. The expression may be a double value or a *
* string value designating a valid felt expression. *
* Actually, we're pointing at the double value in the *
* structure, but since a pointer to the first member of a *
* structure is the same as a pointer to the structure *
* itself, this is legal, if a bit of a hack. The idea is *
* that we want to update all three fields of the *
* structure when we assign to the value field, just like *
* the FElt parser does. *
************************************************************************/
static int code_expression (dest, src)
descriptor *dest;
descriptor **src;
{
int status;
int type_error;
VarExpr *var_ptr;
/* This data is never recycled. */
if (!src)
return 0;
status = 0;
type_error = F_False;
*src = CoerceData (*src, T_Double);
var_ptr = (VarExpr *) D_Pointer (dest);
switch (D_Type (*src)) {
case T_Double:
FreeCode (var_ptr -> expr);
Deallocate (var_ptr -> text);
var_ptr -> value = *D_Double (*src);
var_ptr -> expr = NULL;
var_ptr -> text = NULL;
break;
case T_String:
if (!CompileCode (*D_String (*src))) {
FreeCode (var_ptr -> expr);
Deallocate (var_ptr -> text);
var_ptr -> value = EvalCode (InCore, 0.0);
var_ptr -> expr = IsConstant (InCore) ? NULL : CopyCode (InCore);
var_ptr -> text = Strdup (*D_String (*src));
} else {
TypeError ("improper variable expression", NULL, NULL, NULL, F_False);
status = 1;
}
break;
default:
type_error = F_True;
break;
}
if (type_error == F_True)
TypeError ("=", dest, *src, NULL, F_False);
return type_error == F_True || status != 0;
}
/************************************************************************
* Function: code_assignment *
* *
* Description: Trapped variable handler for assigning to an array of *
* code structures. *
************************************************************************/
static int code_assignment (dest, src)
descriptor *dest;
descriptor **src;
{
int i;
Array s_array;
Array d_array;
char s_size [32];
char d_size [32];
double *s_ptr;
VarExpr *d_ptr;
descriptor *coerced;
/* This data is never recycled. */
if (!src)
return 0;
/* The source object is coerced to an array. If the sizes and types
match then the assignment is performed. */
d_array = D_Array (dest);
coerced = CoerceToArray (*src, d_array -> type);
if (D_Type (coerced) == T_Array) {
s_array = D_Array (coerced);
if (s_array -> length == d_array -> length) {
s_ptr = (double *) s_array -> ptr;
d_ptr = (VarExpr *) d_array -> ptr;
for (i = 1; i <= 6; i ++) {
d_ptr [i].value = s_ptr [i];
d_ptr [i].expr = NULL;
d_ptr [i].text = NULL;
}
RecycleData (coerced);
return 0;
} else {
sprintf (s_size, "1 x %u", s_array -> length);
sprintf (d_size, "1 x %u", d_array -> length);
rterror ("size mismatch in expression: %s = %s", d_size, s_size);
RecycleData (coerced);
return 1;
}
} else {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
}
/************************************************************************
* Function: array_assignment *
* *
* Description: Trapped variable handler for an array. The source *
* is coerced to an array if possible and if the type and *
* length match then the data of the source is copied into *
* the memory of the destination. *
************************************************************************/
int array_assignment (dest, src)
descriptor *dest;
descriptor **src;
{
Array s_array;
Array d_array;
char s_size [32];
char d_size [32];
void *s_ptr;
void *d_ptr;
descriptor *coerced;
/* This data is never recycled. */
if (!src)
return 0;
/* The source object is coerced to an array. If the sizes and types
match then the assignment is performed. */
d_array = D_Array (dest);
coerced = CoerceToArray (*src, d_array -> type);
if (D_Type (coerced) == T_Array) {
s_array = D_Array (coerced);
if (s_array -> length == d_array -> length) {
s_ptr = (char *) s_array -> ptr + s_array -> elt_size;
d_ptr = (char *) d_array -> ptr + d_array -> elt_size;
memcpy (d_ptr, s_ptr, s_array -> elt_size * s_array -> length);
RecycleData (coerced);
return 0;
} else {
sprintf (s_size, "1 x %u", s_array -> length);
sprintf (d_size, "1 x %u", d_array -> length);
rterror ("size mismatch in expression: %s = %s", d_size, s_size);
RecycleData (coerced);
return 1;
}
} else {
TypeError ("=", dest, *src, NULL, F_False);
return 1;
}
}
/************************************************************************
* Function: invalidate *
* *
* Description: Invalidates a descriptor if it refers to a FElt object. *
************************************************************************/
static void invalidate (d)
descriptor *d;
{
int h;
int remove;
switch (D_Type (d)) {
case T_Array:
case T_Constraint:
case T_Element:
case T_Force:
case T_Load:
case T_Material:
case T_Node:
case T_Pair:
case T_Stress:
remove = F_True;
break;
default:
remove = F_False;
break;
}
h = D_Trapped (d);
if (remove == F_True || (first_handler <= h && h <= last_handler)) {
D_Type (d) = T_Null;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Variable (d) = NULL;
}
}
/************************************************************************
* Function: init_felt *
* *
* Description: Initializes the interface to the FElt data structures. *
* Record fields are added for each of the primary FElt *
* structures and global variable are created representing *
* the arrays of nodes and elements. *
************************************************************************/
int init_felt (argc, argv)
int *argc;
char *argv [ ];
{
unsigned i;
Field f;
ste *s;
Array a;
descriptor *d;
int h;
/* Initialize the FElt library. */
add_all_definitions ( );
if (ParseCppOptions (argc, argv))
return 1;
/* Add the fields of the FElt structures. */
first_handler = NumTraps ( ) + 1;
for (i = 0; i < NUMBER (analysis_fields); i ++) {
f = &analysis_fields [i];
add_field (T_Analysis, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (constraint_fields); i ++) {
f = &constraint_fields [i];
add_field (T_Constraint, f -> name, f -> type, f -> offset, f->handler);
}
for (i = 0; i < NUMBER (definition_fields); i ++) {
f = &definition_fields [i];
add_field (T_Definition, f -> name, f -> type, f -> offset, f->handler);
}
for (i = 0; i < NUMBER (element_fields); i ++) {
f = &element_fields [i];
add_field (T_Element, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (force_fields); i ++) {
f = &force_fields [i];
add_field (T_Force, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (load_fields); i ++) {
f = &load_fields [i];
add_field (T_Load, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (material_fields); i ++) {
f = &material_fields [i];
add_field (T_Material, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (node_fields); i ++) {
f = &node_fields [i];
add_field (T_Node, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (node_fields); i ++) {
f = &node_fields [i];
add_field (T_Node, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (pair_fields); i ++) {
f = &pair_fields [i];
add_field (T_Pair, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (problem_fields); i ++) {
f = &problem_fields [i];
add_field (T_Problem, f -> name, f -> type, f -> offset, f -> handler);
}
for (i = 0; i < NUMBER (stress_fields); i ++) {
f = &stress_fields [i];
add_field (T_Stress, f -> name, f -> type, f -> offset, f -> handler);
}
last_handler = NumTraps ( );
/* Create global variables representing the arrays. */
h = AddTrap (read_only);
s = add_literal (&var_st, "nodes", GlblOp);
a = CreateArray (problem.nodes, T_Node, problem.num_nodes, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Array (d) = a;
s = add_literal (&var_st, "elements", GlblOp);
a = CreateArray (problem.elements, T_Element, problem.num_elements, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Array (d) = a;
s = add_literal (&var_st, "dofs_pos", GlblOp);
a = CreateArray (problem.dofs_pos, T_Int, 6, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = AddTrap (dofs_pos_array);
D_Array (d) = a;
s = add_literal (&var_st, "dofs_num", GlblOp);
a = CreateArray (problem.dofs_num, T_Int, problem.num_dofs, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = AddTrap (dofs_num_array);
D_Array (d) = a;
/* Create global variables representing the structures. */
s = add_literal (&var_st, "problem", GlblOp);
d = global (s -> idx);
D_Type (d) = T_Problem;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
d->u.ptr = &problem;
s = add_literal (&var_st, "analysis", GlblOp);
d = global (s -> idx);
D_Type (d) = T_Analysis;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
d->u.ptr = &analysis;
return 0;
}
/************************************************************************
* Function: read_felt *
************************************************************************/
int read_felt (file)
char *file;
{
ste *s;
int h;
Array a;
descriptor *d;
/* Read the file. */
if (ReadFeltFile (file))
return 1;
/* Invalidate any previously assigned variables. */
for (d = stack; d <= sp; d ++)
invalidate (d);
for (d = var_array; is_global (d); d ++)
invalidate (d);
/* Reset the properties of the arrays. */
h = AddTrap (read_only);
s = add_literal (&var_st, "nodes", GlblOp);
a = CreateArray (problem.nodes, T_Node, problem.num_nodes, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Array (d) = a;
s = add_literal (&var_st, "elements", GlblOp);
a = CreateArray (problem.elements, T_Element, problem.num_elements, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Array (d) = a;
s = add_literal (&var_st, "dofs_pos", GlblOp);
a = CreateArray (problem.dofs_pos, T_Int, 6, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = AddTrap (dofs_pos_array);
D_Array (d) = a;
s = add_literal (&var_st, "dofs_num", GlblOp);
a = CreateArray (problem.dofs_num, T_Int, problem.num_dofs, h);
d = global (s -> idx);
D_Type (d) = T_Array;
D_Temp (d) = F_False;
D_Trapped (d) = AddTrap (dofs_num_array);
D_Array (d) = a;
return 0;
}
/************************************************************************
* Function: error *
* *
* Description: Prints an error message (for library compatibility *
* only). *
************************************************************************/
# ifdef UseFunctionPrototypes
void error (char *format, ...)
# else
void error (format, va_alist)
char *format;
va_dcl
# endif
{
va_list ap;
VA_START (ap, format);
if (problem.line)
fprintf (stderr, "%s:%d: ", problem.filename, problem.line);
else
fprintf (stderr, "%s:%d: ", curr_file_name, curr_line_num);
vfprintf (stderr, format, ap);
fprintf (stderr, "\n");
va_end (ap);
}
/************************************************************************
* Function: Fatal *
* *
* Description: Prints an error message and exits the program (for *
* library compatibility only). *
************************************************************************/
# ifdef UseFunctionPrototypes
void Fatal (char *format, ...)
# else
void Fatal (format, va_alist)
char *format;
va_dcl
# endif
{
va_list ap;
VA_START (ap, format);
fprintf (stderr, "burlap: ");
vfprintf (stderr, format, ap);
fprintf (stderr, "\n");
va_end (ap);
exit (1);
}
syntax highlighted by Code2HTML, v. 0.9.1