/*
    This file is part of the FElt finite element analysis package.
    Copyright (C) 1993 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:		fe.c
*
* Description:	Contains code to implement various mathematical features of 
*		the finite element method.
*
* History:	v1.0 by Jason Gobat and Darren Atkinson	
*
***************************************************************************/

# include <stdio.h>
# include <math.h>
# include "allocate.h"
# define  ELEMENTS
# include "element.h"


/**************************************************************************
*
* Function:	FindDOFS
*
* Parameters:  	element  	array of elements
*		numelts  	number of elements
*		dofs 		master array of affected DOFs 
*
* Return value:	the total number of affected DOFs.  The master list
*		is created and placed in the dofs array.
* 
* Calls:	None
*
* Called by:	FELT driver application
*
* Global data:  None
*
* Description:  FindDOFS will search through all of the elements for a
*		problem and determine which DOFs (out of the six that
*		are physically possible) must be considered in this
*		problem based on the different element types.  The
*		list of affected DOFs is built and put into the dofs
*		array where a non-zero value in the ith position 
*		indicates that the ith DOF must be considered and the
*		value in the ith position of dofs is the problem DOF
*		number for this physical DOF.
*	
*****************************************************************************/

unsigned FindDOFS (element,numelts,dofs)
   Element	*element;
   unsigned	numelts;
   unsigned	*dofs;
{
   unsigned	i,
		j;
   int		type,
		otype;
   unsigned	flag[7];
   unsigned	count;

   for (i = 1 ; i <= 6 ; i++) {
      flag[i] = 0;
      dofs[i] = 0;
   }

   otype = -1;	
 
   for (i = 1 ; i <= numelts ; i++) {

      type = element[i] -> definition -> type;
      if (type != otype) {
       
         for (j = 1 ; j <= element[i] -> definition -> numdofs ; j++) 
            flag [(int) (element[i] -> definition -> dofs[j])] = 1;

         otype = type;
      }
   }

   count = 0;

   for (i = 1 ; i <= 6 ; i++) {

      if (flag[i]) 
         dofs[i] = ++count;
   }

   return count;
}
      
/****************************************************************************
*
* Function:	AssembleStiffness
*
* Parameters:	element		array of elements
*		numelts		total number of elements
*		numnodes	total number of nodes
*		count		number of DOFs per node
*		dofs		master index of affected DOFs
*		status		on input, status is a pointer to 
*				a flag which indicates whether or not
*			   	element stiffness matrices should
*				be destroyed after assembling.  on 
*				output, it is a pointer to the
*				number of errors encountered in 
*				building elt stiffnesses.
*
* Return value: the global stiffness matrix, K
*
* Calls:	CreateMatrix, ScaleMatrix
*
* Called by:	FELT driver application
*
* Global data:	None
*
* Description: 	For a given set of elements (possibly of varying types)
*		this will assemble all element stiffness matrices into
*		the global stiffness matrix according to what DOFs each
*		individual element affects (a function of both its node
*		numbers and the DOFs that it affects and their relation
*		to the global DOFs as indexed by dofs).
*
****************************************************************************/

Matrix AssembleStiffness (element,numelts,numnodes,count,dofs,status)
   Element	*element;
   unsigned	numelts,
		numnodes;
   unsigned	count;
   unsigned	*dofs;
   int		*status;
{
   unsigned	row,
		col,
		i,
		j,
		l,
		k,
		m;
   unsigned	size,
		ndofs,
		nodes;
   unsigned	base_row,
		base_col,
		affected_row_dof,
		affected_col_dof;
   Matrix 	K;
   int	 	err,
		err_count;
 
   size = numnodes*count;
     
   K = CreateMatrix(size,size);

   if (K == NullMatrix)
      Fatal ("allocation error creating global stiffness matrix");

   ScaleMatrix (K,K,0.0,0.0);

   err_count = 0;
 
   for (i = 1 ; i <= numelts ; i++) {
      err = EltStiffness (element [i], i);
      if (err) {
         err_count += err;
         continue;
      } 
         
      ndofs = element[i] -> definition -> numdofs;
      nodes = element[i] -> definition -> numnodes;
      
      for (j = 1 ; j <= nodes ; j++) {
         if (element [i] -> node[j] == NULL) continue;
         base_row = (element[i] -> node[j] -> number - 1)*count + 1;

         for (k = 1 ; k <= nodes ; k++) {
            if (element [i] -> node[k] == NULL) continue;
            base_col = (element[i] -> node[k] -> number - 1)*count + 1;

            for (l = 1 ; l <= ndofs ; l++) {
               affected_row_dof = dofs[element[i] -> definition -> dofs[l]];
               row = base_row + affected_row_dof - 1;

               for (m = 1 ; m <= ndofs ; m++) {
                  affected_col_dof = dofs[element[i] -> definition -> dofs[m]];
                  col = base_col + affected_col_dof - 1;
                  MatrixData (K) [row][col] +=
                     MatrixData (element[i] -> K) [(j-1)*ndofs + l]
                                                  [(k-1)*ndofs + m]; 
               }
            }
         }
      }
      
      if (!element[i] -> definition -> retainK) {
         DestroyMatrix (element[i] -> K);
         element[i] -> K = NullMatrix;
      }

   } /* end loop over elements */

   *status = err_count;
   return K;
}

/****************************************************************************
*
* Function:	ResolveConstraints
*
* Parameters:	K		the global stiffness matrix
*		F		the global nodal force vector
*		*Kc		on return, the condensed stiffness matrix
*		*Fc		on return, the condensed force vector 
*		node		array of nodes
*		numnodes	total number of nodes in problem
*		count		number of DOFs per node
*		dofs		master index of affected DOFs
*
* Return value:	the condensed stiffness matrix, Kcond
*
* Calls:	AssignMatrix, ZeroRowCol, AdjustForceVector
*
* Called by:	FELT driver application
*
* Global data: 	None
*
* Description:  For a fixed BC at a given DOF all we'll do is zero
*		out the rows and columns of the stiffness matrix
*		associated with that DOF (with a one on the diagonal
*		for stability).  For a displacement BC, we'll need
*		to adjust the force vector, also, we should put
*		the displacement into the force vector so when we
*		go to solve, we'll just go ahead and get that
*		displacement right back.  We don't deal with hinges
*		here really because we already dealt with them when we had
*		the element stiffness matrix laying around.  All we'll
*		do here is make sure that the displacement will come 
*		out zero.
*
****************************************************************************/

void ResolveConstraints (K,F,Kc,Fc,node,numnodes,count,dofs)
   Matrix	K;
   Matrix	*Kc;
   Vector	F;
   Vector	*Fc; 
   Node		*node;
   unsigned	numnodes,
		count;
   unsigned	*dofs;
{
   Matrix	Kcond;
   Vector	Fcond;
   unsigned	i,j,
		affected_dof,
		base_dof;

	/*
	 * allocate and copy the condensed objects
	 */

   Kcond = AssignMatrix (NullMatrix,K);
   Fcond = AssignMatrix (NullMatrix,F);

   if (Kcond == NullMatrix || Fcond == NullMatrix)
      Fatal ("allocation error resolving constraint conditions");
   
   for (i = 1 ; i <= numnodes ; i++) {

      base_dof = count*(node[i] -> number - 1) + 1;

      for (j = 1 ; j <= 6 ; j++) {
         if (dofs[j]) {
            if (node[i] -> constraint -> constraint[j]) {
               affected_dof = base_dof + dofs[j] - 1;

               if (node[i] -> constraint -> dx[j] == 0.0 ||
                   node[i] -> constraint -> constraint[j] == 'h') {
                  VectorData (Fcond) [affected_dof] = 0; 
                  Kcond = ZeroRowCol (Kcond,affected_dof); 
               }
               else {
                  Fcond = AdjustForceVector (Fcond, Kcond, affected_dof,
                                             node[i] -> constraint -> dx[j],
                                             numnodes*count);
                  Kcond = ZeroRowCol (Kcond, affected_dof); 
                  VectorData (Fcond) [affected_dof] = 
                                             node[i] -> constraint -> dx[j];
               }
            }
         }
      }
   }
   *Kc = Kcond;
   *Fc = Fcond;

   return;
}

/****************************************************************************
*
* Function:	AdjustForceVector
*
* Parameters:	Kcond		the condensed stiffness matrix
*		Fcond		the condensed force vector 
*		affected_dof	the DOF which has a displacement condition
*		dx		displacement condition at above DOF
*		size		total number of DOFs in the problem
*
* Return value:	the adjusted F vector, Fcond
*
* Calls:	
*
* Called by:	ResolveConstraints
*
* Global data: 	None
*
* Description:  Given a displacement boundary condition, we can't just
*		knock out the rows and columns of K for that DOF.  We
*		need to adjust the force vector by adding the effect
*		of the stiffness in that DOF times the given displacement
*		to the external force vector.  The simplest way to do
*		that is to just loop over all DOFs and adjust them
*		as appropriate.  In some cases the adjustment is unnecessary
*		because the displaced DOF may not affect all DOFs or
*		a given DOF may be fixed anyways.  It won't hurt to
*		operate in these cases anyways though, so that's what I do.
*		
****************************************************************************/

Vector AdjustForceVector (Fcond, Kcond, affected_dof, dx, size)
    Vector	Fcond;
    Matrix	Kcond;
    unsigned	affected_dof;
    unsigned	size;
    double	dx;
{
    unsigned	i;
    unsigned	base_dof;

    for (i = 1 ; i <= size ; i++) 
       VectorData (Fcond) [i] -= MatrixData (Kcond) [i][affected_dof]*dx;

    return Fcond;
                                 
}

/****************************************************************************
*
* Function:	ZeroRowCol
*
* Parameters:	K		a stiffness matrix
*		dof		row and column to eliminate
*
* Return value:	a condensed matrix, K (input is trashed)
*
* Calls:	None
*
* Called by:	ZeroConstrainedDOFS
*
* Global data:	None
*
* Description:	Zeros out the row and column given by dof.  Places
*		a one on the diagonal.
*
****************************************************************************/

Matrix ZeroRowCol (K,dof)
   Matrix	K;
   unsigned	dof;
{
   unsigned	i,
		size;

   size = MatrixRows (K);

   for (i = 1 ; i <= size ; i++) {

      MatrixData (K) [i][dof] = 0;
      MatrixData (K) [dof][i] = 0; 
      
   }

   MatrixData (K) [dof][dof] = 1;

   return K;
} 

/****************************************************************************
*
* Function:	ConstructForceVector		
*
* Parameters:	node		array of nodes
*		numnodes 	total number of nodes in problem
*		count		number of DOFs per node
*		dofs		master index of affected DOFs
*
* Return value:	a vector of global nodal forces, F
*
* Calls:	CreateVector
*
* Called by:	FELT driver application
*
* Global data:	None
*
* Description:	Constructs the global nodal force vector based on all
*		nodal forces and the global DOFs active at those nodes.
*		Global DOF determination is by node number and the
*		and the relationship between the force and its actual
*		physical DOF and the location of this DOF in problem space.
*
****************************************************************************/

Vector ConstructForceVector (node,numnodes,count,dofs)
   Node		*node;
   unsigned	numnodes,
		count;
   unsigned	*dofs;
{
   unsigned	i,j,
		base_dof;
   unsigned	size;
   double	force;
   Vector	F;

   size = numnodes*count;

   F = CreateVector (size);

   if (F == NullVector)
      Fatal ("allocation error constructing global nodal force vector");

   for (i = 1 ; i <= size ; i++) 
      VectorData (F) [i] = 0;

   for (i = 1 ; i <= numnodes ; i++) {

      base_dof = count*(node[i] -> number - 1) + 1;

      for (j = 1 ; j <= 6 ; j++) {
         if (dofs[j]) {
            force = 0.0;
            if (node[i] -> force != NULL) {
               if (node[i] -> force -> force[j]) 
                  force += node[i] -> force -> force[j];
            }
            if (node[i] -> eq_force != NULL) {
               if (node[i] -> eq_force[j])
                  force += node[i] -> eq_force[j];
            }
            VectorData (F) [base_dof + dofs[j] - 1] = force; 
         }
      }
   }

   return F;
}

void ClearNodes (node, numnodes)
   Node		*node;
   unsigned	numnodes;
{
   unsigned	i,j;

   for (i = 1 ; i <= numnodes ; i++) {
      for (j = 1 ; j <= 6 ; j++)
         node[i] -> dx[j] = 0.0;

      if (node[i] -> eq_force != NULL)
         for (j = 1 ; j <= 6 ; j++)
            node[i] -> eq_force[j] = 0.0;
   }
}
  

/****************************************************************************
*
* Function:	SolveForDisplacements
*
* Parameters:	K 		global (condensed) stiffness matrix
*		F		global nodal force vector
*		node		array of nodes
*		numnodes	total number of nodes 
*		count		number of DOFs per node
*
* Return value: d, a vector of nodal displacements.  There will be count
*		of them for every node.  The nodal displacements are
*		also set into the node structure.
*
* Calls:	CreateVector, CreateMatrix, LUDecomposition,
*		LUBackSolve, DestroyMatrix, DestroyVector
*
* Called by:	FELT driver application
*
* Global data:	None
*
* Description:  Solves the linear system Kd=F for the vector of global
*		nodal displacements.  The system must not be singular
*		(i.e. K and F should be condensed).
*
****************************************************************************/

Vector SolveForDisplacements (K,F,node,numnodes,count,dofs)
   Matrix	K;
   Vector	F;
   Node		*node;
   unsigned     numnodes;
   unsigned	*dofs;
   unsigned	count;
{
   unsigned	i,j,
		base_dof,
 		prob_dof,
		size;
   unsigned	*diag;
   Vector	colK;

   size = count*numnodes;

   for (i = 1 ; i <= size ; i++) {
      if (MatrixData (K) [i][i] == 0.0) {
         error ("zero on the diagonal (row %d) of stiffness matrix",i);
         return NullVector;
      }
   }

   diag = (unsigned *) malloc (sizeof (unsigned) * (size + 1));
   if (diag == NULL)
      Fatal ("allocation error creating diagonal address array");

   colK = MakeCompactColumns (K, diag);
   if (CroutFactorization (colK, diag, size)) {
      error ("global stiffness matrix is singular");
      free (diag);
      DestroyVector (colK);
      return NullVector;
   }
 
   if (CompactForwardBack (colK, F, diag, size)) {
      error ("global stiffness matrix is singular");
      free (diag);
      DestroyVector (colK);
      return NullVector;
   }
 
   for (i = 1 ; i <= numnodes ; i++) {
      base_dof = count*(node[i] -> number - 1) + 1;
      prob_dof = 1;
      for (j = 1 ; j <= 6 ; j++) {
         if (dofs[j]) {
            node[i] -> dx[j] = VectorData (F) [base_dof + prob_dof - 1];
            prob_dof++;
         }
         else
            node[i] -> dx[j] = 0;
      }
   }

   free (diag);
   DestroyVector (colK);

   return F;
}

/***************************************************************************
*
* Function:	SolveForReactions
*
* Parameters:	K	  the global (non-condensed) stiffness matrix
*		d	  the global vector of nodal displacements
*		node	  the global node array	
*		numnodes 
*		count
*		dofs
*
* Return value: a vector of reaction forces at constrained DOFs
*
* Calls:	
*
* Called by:	FELT driver application
*
* Global data:	
*
* Description:	
*
****************************************************************************/

unsigned SolveForReactions (K, d, node, numnodes, count, dofs, reac)
   Matrix	K;
   Vector	d;
   Node		*node;
   unsigned	numnodes,
		count,
		*dofs;
   Reaction	**reac;
{
   unsigned	i,j,k,m,
		affected_dof,
		base_dof,
		num_reactions;
   double	sum;

   num_reactions = 0; 
   for (i = 1 ; i <= numnodes ; i++) {
      for (j = 1 ; j <= 6 ; j++) {
         if (dofs[j]) {
            if (node[i] -> constraint -> constraint[j] == 1) 
               num_reactions++; 
         }
      }
   }

   if (num_reactions == 0) 
      return 0;

   if (!(*reac = Allocate(Reaction, num_reactions))) 
      Fatal ("allocation error finding reactions");

   UnitOffset (*reac);

   for (i = 1 ; i <= num_reactions ; i++) {
      if (!((*reac) [i] = Allocate (struct reaction, 1)))
         Fatal ("allocation error finding reactions");
   }    

   m = 1;
   for (i = 1 ; i <= numnodes ; i++) {

      base_dof = count*(node[i] -> number - 1) + 1;

      for (j = 1 ; j <= 6 ; j++) {
         if (dofs[j]) {
            if (node[i] -> constraint -> constraint[j] == 1) {
               sum = 0;
               affected_dof = base_dof + dofs[j] - 1;

               for (k = 1 ; k <= MatrixCols (K) ; k++) 
                  sum += MatrixData (K) [affected_dof][k]*VectorData (d) [k];                        
               (*reac) [m] -> node = node[i] -> number;
               (*reac) [m] -> dof = j;
               if (node [i] -> eq_force != NULL)
                  sum -= node [i] -> eq_force [j];
               (*reac) [m++] -> force = sum; 
            }
         }
      }
   }

   return num_reactions ;
}

/***************************************************************************
*
* Function:	EltStiffness
*
* Parameters:	element		element
*
* Return value: number of Fatal errors encountered in building element
*		stiffness matrix.
*
* Calls:	various element stiffness definition functions
*
* Called by:	FELT driver application
*
* Global data:	ElementArray is used
*
* Description:	calls the appropriate function to assemble the element
*		stiffness matrix for an element.  Each element stiffness
*		function should be of the form: xEltStiffness (element,number)
*		where x is the element type (as defined in element.h)
*		element is the element to assemble the stiffness for
*		and number is the global element number of that element.
*
****************************************************************************/

int EltStiffness (element, number)
   Element	element;
   unsigned	number;
{
    int		status;
  
    status = ElementArray [element -> definition -> type].stiffness 
                (element, number);

    return status;
}

/***************************************************************************
*
* Function:	EltStresses
*
* Parameters:	element		array of elements
*		numelts		number of elements in problem
*
* Return value: number of Fatal errors encountered in calculating element
*		stresses.
*
* Calls:	various element stress functions
*
* Called by:	FELT driver application
*
* Global data:	ElementArray is used
*
* Description:	
*
****************************************************************************/

int EltStresses (element,numelts)
   Element	*element;
   unsigned	 numelts;
{
    int		i, status;
  
    status = 0;

    for (i = 1 ; i <= numelts ; i++)
	status += ElementArray [element [i] -> definition -> type].stress
		  (element [i]);

    return status;
}

/**************************************************************************
*
* Function:	ComputeMaterialStatistics	
*
* Parameters:	element		array of elements
*		numelts		number of elements
*
* Return value:	none	
*
***************************************************************************/

int ComputeMaterialStatistics (element, numelts, output)
   Element	*element;
   unsigned	numelts;
   FILE		*output;
{
   unsigned	i,j,
 		num_materials,
		number [50];
   char		*names [50];
   unsigned	flag;
   double	length [50],
                volume [50],
		area [50],
  		weight [50],
		l,v,a,
		tot_weight;

   num_materials = 0;

   for (i = 0 ; i < 50 ; i++) {
      number [i] = length [i] = area [i] = volume [i] = weight [i] = 0;
      names [i] = NULL;
   }

   for (i = 1 ; i <= numelts ; i++) {
      flag = 0;
      for (j = 0 ; j < num_materials ; j++) {
         if (element [i] -> material -> name == names [j]) {
            flag = 1;
            break;
          }
      } 
      
      if (!flag)
         names [num_materials++] = element [i] -> material -> name;

      if (num_materials >= 50) {
         error ("too many materials used for summary stats");
         return 1;
      }
   }
 
   for (i = 1 ; i <= numelts ; i++) {

      for (j = 0 ; j < num_materials ; j++) {
         if (element [i] -> material -> name == names [j]) {
            flag = j;
            break;
         }
      }      

      number [flag]++;

      switch (element [i] -> definition -> shape) {

      case Linear:

         l = (element [i] -> node[1] -> x - element [i] -> node[2] -> x)* 
             (element [i] -> node[1] -> x - element [i] -> node[2] -> x) +
             (element [i] -> node[1] -> y - element [i] -> node[2] -> y)* 
             (element [i] -> node[1] -> y - element [i] -> node[2] -> y) +
             (element [i] -> node[1] -> z - element [i] -> node[2] -> z)* 
             (element [i] -> node[1] -> z - element [i] -> node[2] -> z); 
         l = sqrt (l);
         length [flag] += l;
         weight [flag] += element [i] -> material -> rho * l *
                          element [i] -> material -> A;

         break;

      case Planar:

         a = ElementArea (element [i], element [i] -> definition -> shapenodes);
         area [flag] += a;
         weight [flag] += element [i] -> material -> rho * a *
                          element [i] -> material -> t;

         break;

      case Solid:

         v = 0;
         volume [flag] += v;
         weight [flag] += element [i] -> material -> rho*v;
         break;
      }
   }

   tot_weight = 0;
   for (i = 0 ; i < num_materials ; i++) {

      fprintf (output,"Material: %s\n",names [i]);
      fprintf (output,"Number:   %d\n", number[i]);
      if (length [i] > 0)
         fprintf (output,"Length:   %8.4f\n",length [i]);
      if (area [i] > 0)
         fprintf (output,"Area:     %8.4f\n",area [i]);
      if (volume [i] > 0)
         fprintf (output,"Volume:   %8.4f\n",volume [i]);

      fprintf (output,"Weight:   %8.4f\n\n",weight [i]);

      tot_weight += weight [i];
   }

   fprintf (output,"Total weight: %10.4f\n", tot_weight);

   return 0;
}

/**************************************************************************
*
* Function:	WriteGraphicsFile
*
* Parameters:	filename	name of output file
*		element		array of elements
*		numelts		number of elements
*
* Return value:	0 upon success
*		1 on error
*
***************************************************************************/

int WriteGraphicsFile (filename,element,numelts)
   char		*filename;
   Element	*element;
   unsigned	numelts;
{
   FILE		*output;
   unsigned	i,j;

   if ((output = fopen (filename, "w")) == NULL)
      return 1;

   for (i = 1 ; i <= numelts ; i++) {
      for (j = 1 ; j <= element [i] -> definition -> shapenodes ; j++) {
         if (element [i] -> node[j] == NULL) break;
         fprintf (output,"%g %g %g\n", element [i] -> node [j] -> x,
                  element [i] -> node [j] -> y, element [i] -> node [j] -> z); 
      }

      if (element [i] -> definition -> shapenodes > 2)
         fprintf (output,"%g %g %g\n", element [i] -> node [1] -> x,
                  element [i] -> node [1] -> y, element [i] -> node [1] -> z); 

      fprintf (output,"\n");
   }

   fclose (output);

   return 0;
}

/**************************************************************************
*
* Function:	MakeCompactColumns
*
* Parameters:	K		matrix to convert to compact column storage
*		colK		the column vector of reduced data
*		diag		array of column diagonal addresses
*		
* Return value:	none
*
***************************************************************************/

Vector MakeCompactColumns (K, diag)
   Matrix	K;
   unsigned	*diag;
{
   Vector	colK;
   unsigned	i,j,k,
		curr_row;
   unsigned	rows,cols;
   unsigned	size;
   unsigned	height;

   rows = MatrixRows (K);
   cols = MatrixCols (K);
  
	/*
	 * determine the height of the columns and store in diag
	 */

   size = 0;
   for (j = 1 ; j <= cols ; j++) {
      for (i = 1 ; i <= rows; i++) {

         if (MatrixData (K) [i][j] != 0.0) {
            diag [j] = j - (i-1);
            size += diag [j];
            break;
         }
      }
   }
   
   colK = CreateVector (size);
   if (colK == NullVector) 
      Fatal ("allocation error creating column storage vector");

   diag [1] = 1;
   VectorData (colK) [1] = MatrixData (K) [1][1];
  
   for (i = 2 ; i <= cols ; i++) {
      height = diag [i];
      diag [i] += diag [i-1];
      curr_row = i - height + 1 ;
      for (k = diag [i] - height + 1 ; k <= diag [i] ; k++) 
         VectorData (colK) [k] = MatrixData (K) [curr_row++][i];
   }
 
   return colK;
} 
   
/************************************************************************
 *
 * Function:	 CroutFactorization				
 *									
 * Parameters:	 a    	a compact column coefficient matrix	
 *		 diag  	array of diagonal addresses	
 *		 n    	number of equations in the system	
 *									
 * Return value: 0 on sucess					
 *		 1 on singular input matrix			
 *		 							
 * Description:	 Performs Crout factorization on the compact column matrix
 *		 a for solution of a linear system of equations. The result
 *		 of the factorization overwrites the coefficient vector a. 
 *		 To see how thw indexing works see T.J.R. Hughes, pp.640-643.
 *		 My notation should be consistent with his.
 *		 							
 ************************************************************************/

int CroutFactorization (A, diag, n)
   Vector    A;
   unsigned *diag;
   unsigned  n;
{
   unsigned     j,jj,jjlast,jcolht,
          	istart,ij,ii,i,
          	icolht,iilast,
          	length,jtemp,jlngth;
   double 	temp;

   jj = 0;
   for (j = 1; j <= n; j++) {

      jjlast = jj;
      jj = diag [j];
      jcolht = jj - jjlast;

      if (jcolht > 2) {
         
         istart = j - jcolht + 2;
         ij = jjlast + 2;
         ii = diag [istart-1];

         for (i = istart; i <= j - 1 ; i++) {

            iilast = ii;
            ii = diag [i];
            icolht = ii - iilast;
            jlngth = i - istart + 1;
            if (icolht - 1  < jlngth) 
               length = icolht - 1;
            else
               length = jlngth;
            
            if (length > 0)
               VectorData (A)[ij] -= DotProduct(&(VectorData (A) [ii-length]),
                                                &(VectorData (A) [ij-length]),
                                                length);
            ij++;
         }
      }

      if (jcolht >= 2) {

         jtemp = j - jj;
         for (ij = jjlast+1 ; ij <= jj-1 ; ij++) {

            ii = diag [jtemp + ij];
           
            if (VectorData (A) [ii] != 0.0) {
               temp = VectorData (A) [ij];
               VectorData (A) [ij] = temp / VectorData (A) [ii];
               VectorData (A) [jj] -= temp*VectorData (A) [ij];
            }
         }
      }
   }

   return 0;
}

/************************************************************************
 *
 * Function:	 CompactForwardBack
 *									
 * Parameters:	 a    	a compact column coefficient matrix	
 *		 b 	a forcing function vector
 *		 diag  	array of diagonal addresses	
 *		 n    	number of equations in the system	
 *									
 * Return value: 0 on sucess					
 *		 1 on singular input matrix (if I were to check that is)
 *		 							
 * Description:	 Performs forward reduction and backward substitution on
 *		 a compact column reduced matrix.  The result of the 
 *		 substitution overwrites the given forcing function.
 *		 To see how thw indexing works see T.J.R. Hughes, pp.640-643.
 *		 My notation should be consistent with his.
 *		 							
 ************************************************************************/

int CompactForwardBack (A,b,diag,n)
   Vector    A,b;
   unsigned *diag;
   unsigned  n;
{
   unsigned	    jj,j,jjlast,
		    jcolht,jjnext,
          	    istart,jtemp,i;
   double 	    Ajj;

   jj = 0;
   for (j = 1 ; j <= n ; j++) {

      jjlast = jj;
      jj = diag [j];
      jcolht = jj - jjlast;

      if (jcolht > 1)
         VectorData (b) [j] -= DotProduct (&(VectorData (A) [jjlast+1]),
                                           &(VectorData (b) [j-jcolht+1]),
                                           jcolht-1);
   }

   for (j = 1 ; j <= n ; j++) {
      Ajj = VectorData (A) [diag[j]];

      if (Ajj != 0.0)
         VectorData (b) [j] /= Ajj;
   }

   if (n == 1)
      return 0;

   jjnext = diag [n];

   for (j = n ; j >= 2 ; j--) {

      jj = jjnext;
      jjnext = diag [j-1];
      jcolht = jj - jjnext;
      if (jcolht > 1) {

          istart = j - jcolht + 1;
          jtemp = jjnext - istart + 1;

          for (i = istart ; i <= j-1 ; i++) 
             VectorData (b)[i] -= VectorData (A)[jtemp + i]*VectorData (b)[j];
      }
   }

   return 0;
}

/*****************************************************************************
 *
 * Function:	 DotProduct
 *
 * Parameters:	 a		pointer to 1-d array of doubles	
 * 		 b		pointer to 1-d array of doubles
 *		 n		length of the a and b vectors
 *
 * Return value: the dot product of the two vectors
 *
 ****************************************************************************/

double DotProduct (a,b,n)
   double   *a,*b;
   unsigned  n;
{
   unsigned i;
   double product;

   product = 0.0;
   for (i = 0 ; i < n ; i++)
      product += a [i] * b [i];

   return product;
}

/**************************************************************************
*
* Function:	WriteOutput
*
* Parameters:	title		user supplied title of problem
*		element		array of elements
*		node		array of nodes
*		R		array of reaction forces
*		numelts		number of elements
*		numnodes	number of nodes
*		numreactions	number of reactions
*
* Return value:	none
*
***************************************************************************/

int WriteOutput (output, title, element, node, R, numelts, 
                  numnodes, numreactions, summary)
    FILE       *output;
    char       *title;
    Element    *element;
    Node       *node;
    Reaction   *R;
    unsigned	numelts,
		numnodes,
		numreactions;
    unsigned	summary;
{
    unsigned	i,j,k;
    unsigned	count;
    static char	*dof_names [ ] = {"","Tx","Ty","Tz","Rx","Ry","Rz"};
 
    fprintf (output,"** %s **\n\n",title);
    fprintf (output,"Nodal Displacements\n");
    fprintf (output,"-----------------------------------------------------------------------------\n");
    fprintf (output,"Node #      DOF 1       DOF 2       DOF 3       DOF 4       DOF 5       DOF 6\n");
    fprintf (output,"-----------------------------------------------------------------------------\n");
    for (i = 1; i <= numnodes; i ++) {
	fprintf (output,"%3d   %11.5g %11.5g %11.5g %11.5g %11.5g %11.5g\n", 
                node [i] -> number, node [i] -> dx[1], node [i] -> dx[2], 
                node [i] -> dx[3], node [i] -> dx[4], 
                node [i] -> dx[5], node [i] -> dx[6]);
    }

    fprintf (output,"\nElement Stresses\n");
    fprintf (output,"-------------------------------------------------------------------------------\n");
    for (i = 1; i <= numelts ; i++) {
        fprintf (output,"%3d: ", element[i] -> number);
        if (element [i] -> ninteg == 0 || element[i] -> stress == NULL)
           fprintf (output,"  No stresses available for this element\n");
        else {
           count = 0;
           for (j = 1 ; j <= element[i] -> ninteg ; j++) {
              for (k = 1 ; k <= element[i] -> definition -> numstresses ; k++) {
                 fprintf (output," % 11.5g", element[i]->stress[j]->values[k]);
                 count++;
                 if (count == 6) {
                    fprintf (output,"\n");
                    count = 0;
                    if (j < element[i] -> ninteg || 
                        k < element[i] -> definition -> numstresses) {
                       fprintf (output,"     ");
                    } 
                 }
              }
           } 
           if (count)
              fprintf (output,"\n");
        }
    }    

    fprintf (output,"\n\nReaction Forces\n");
    fprintf (output,"-----------------------------------\n");
    fprintf (output,"Node #     DOF     Reaction Force\n");
    fprintf (output,"-----------------------------------\n");
    if (numreactions == 0)
       fprintf (output,"no nodes were constrained ... be wary of numerical results\n");
    else {
       for (i = 1 ; i <= numreactions ; i++)
          fprintf (output,"%3d        %s        % 11.5g\n",R[i] -> node, 
                   dof_names [R[i] -> dof], R[i] -> force);
    }
    if (summary) {
       fprintf (output,"\nMaterial Usage Summary\n");
       fprintf (output,"--------------------------\n");
       ComputeMaterialStatistics (element, numelts, output);
    }

    return 0;
}

double ElementArea (e, n)
   Element	e;
   unsigned	n;
{
   unsigned	i;
   double	sum;

   sum = e -> node[1] -> x*(e -> node[2] -> y - e -> node[n] -> y) +
         e -> node[n] -> x*(e -> node[1] -> y - e -> node[n-1] -> y);

   for (i = 2 ; i <= n-1 ; i++)
      sum += e -> node[i] -> x*(e -> node[i+1] -> y - e -> node[i-1] -> y);

   return sum/2;
}
