Logo Search packages:      
Sourcecode: felt version File versions  Download package

felt.c

/*
    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_Problem (d) = &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_Analysis (d) = &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);
}

Generated by  Doxygen 1.6.0   Back to index