|
|
|
Agar: r7562 - in trunk: . agar-math-config math math/SPARSE: msg#00002lib.agar.scm
Author: vedge Date: 2008-09-01 13:13:21 -0300 (Mon, 01 Sep 2008) New Revision: 7562 Added: trunk/agar-math-config/ trunk/agar-math-config/Makefile trunk/agar-math-config/agar-math-config.c trunk/math/ trunk/math/.manlinks.mk trunk/math/M_Matrix.3 trunk/math/Makefile trunk/math/SPARSE/ trunk/math/SPARSE/CHANGES trunk/math/SPARSE/LICENSE trunk/math/SPARSE/Makefile trunk/math/SPARSE/spallocate.c trunk/math/SPARSE/spbuild.c trunk/math/SPARSE/spconfig.h trunk/math/SPARSE/spdefs.h trunk/math/SPARSE/spedacious.c trunk/math/SPARSE/spfactor.c trunk/math/SPARSE/spmatrix.h trunk/math/SPARSE/spoutput.c trunk/math/SPARSE/spsolve.c trunk/math/SPARSE/sputils.c trunk/math/m.h trunk/math/m_begin.h trunk/math/m_bitstring.h trunk/math/m_circle.c trunk/math/m_circle.h trunk/math/m_close.h trunk/math/m_color.c trunk/math/m_color.h trunk/math/m_complex.c trunk/math/m_complex.h trunk/math/m_convexhull.c trunk/math/m_coordinates.c trunk/math/m_coordinates.h trunk/math/m_gaussj.c trunk/math/m_gaussj.h trunk/math/m_geometry.h trunk/math/m_gui.c trunk/math/m_gui.h trunk/math/m_heapsort.c trunk/math/m_int_vector.c trunk/math/m_int_vector.h trunk/math/m_line.c trunk/math/m_line.h trunk/math/m_lu.c trunk/math/m_lu.h trunk/math/m_math.c trunk/math/m_math.h trunk/math/m_matrix.c trunk/math/m_matrix.h trunk/math/m_matrix44_fpu.c trunk/math/m_matrix44_fpu.h trunk/math/m_matrix44_sse.c trunk/math/m_matrix44_sse.h trunk/math/m_matrix_fpu.c trunk/math/m_matrix_fpu.h trunk/math/m_matrix_sparse.c trunk/math/m_matrix_sparse.h trunk/math/m_matview.c trunk/math/m_matview.h trunk/math/m_mergesort.c trunk/math/m_plane.c trunk/math/m_plane.h trunk/math/m_plotter.c trunk/math/m_plotter.h trunk/math/m_point_set.c trunk/math/m_point_set.h trunk/math/m_polygon.c trunk/math/m_polygon.h trunk/math/m_qsort.c trunk/math/m_quaternion.c trunk/math/m_quaternion.h trunk/math/m_radixsort.c trunk/math/m_rectangle.c trunk/math/m_rectangle.h trunk/math/m_triangle.c trunk/math/m_triangle.h trunk/math/m_vector.c trunk/math/m_vector.h trunk/math/m_vector2_fpu.c trunk/math/m_vector2_fpu.h trunk/math/m_vector3_fpu.c trunk/math/m_vector3_fpu.h trunk/math/m_vector3_sse.c trunk/math/m_vector3_sse.h trunk/math/m_vector3_sse3.c trunk/math/m_vector3_sse3.h trunk/math/m_vector4_fpu.c trunk/math/m_vector4_fpu.h trunk/math/m_vector_fpu.c trunk/math/m_vector_fpu.h trunk/math/math_pub.h Modified: trunk/Makefile Log: merge M library from FreeSG. Modified: trunk/Makefile =================================================================== --- trunk/Makefile 2008-09-01 14:37:42 UTC (rev 7561) +++ trunk/Makefile 2008-09-01 16:13:21 UTC (rev 7562) @@ -13,6 +13,7 @@ vg agar-vg-config \ rg agar-rg-config \ map agar-map-config \ + math agar-math-config \ dev agar-dev-config \ net agar-net-config \ po @@ -22,6 +23,7 @@ rg \ vg \ map \ + math \ dev \ net @@ -97,6 +99,8 @@ ${INCLDIR}/agar/net.h; \ ${SUDO} ${INSTALL_INCL} ${SRC}/map/map_pub.h \ ${INCLDIR}/agar/map.h; \ + ${SUDO} ${INSTALL_INCL} ${SRC}/math/math_pub.h \ + ${INCLDIR}/agar/math.h; \ ${SUDO} ${INSTALL_INCL} ${SRC}/dev/dev_pub.h \ ${INCLDIR}/agar/dev.h; \ else \ @@ -114,6 +118,7 @@ ${SUDO} ${INSTALL_INCL} rg/rg_pub.h ${INCLDIR}/agar/rg.h; \ ${SUDO} ${INSTALL_INCL} net/net_pub.h ${INCLDIR}/agar/net.h; \ ${SUDO} ${INSTALL_INCL} map/map_pub.h ${INCLDIR}/agar/map.h; \ + ${SUDO} ${INSTALL_INCL} math/math_pub.h ${INCLDIR}/agar/math.h;\ ${SUDO} ${INSTALL_INCL} dev/dev_pub.h ${INCLDIR}/agar/dev.h; \ fi Added: trunk/agar-math-config/Makefile =================================================================== --- trunk/agar-math-config/Makefile (rev 0) +++ trunk/agar-math-config/Makefile 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,11 @@ +TOP= .. +include ${TOP}/Makefile.config + +PROG= agar-math-config +PROG_TYPE= "CLI" +PROG_GUID= "fb9d278f-50c6-49bb-98fb-631b55c2790f" + +SRCS= agar-math-config.c +CFLAGS+=-I.. + +include ${TOP}/mk/build.prog.mk Added: trunk/agar-math-config/agar-math-config.c =================================================================== --- trunk/agar-math-config/agar-math-config.c (rev 0) +++ trunk/agar-math-config/agar-math-config.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,116 @@ +/* + * Copyright (c) 2008 Hypertriton, Inc. <http://hypertriton.com/> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include <config/version.h> +#include <config/release.h> +#include <config/prefix.h> +#include <config/sysconfdir.h> +#include <config/incldir.h> +#include <config/libdir.h> +#include <config/sharedir.h> + +#include <config/have_math.h> +#include <config/have_altivec.h> +#include <config/have_sse.h> +#include <config/have_sse2.h> +#include <config/have_sse3.h> + +#ifdef HAVE_MATH +#include <config/math_cflags.h> +#include <config/math_libs.h> +#endif +#ifdef HAVE_ALTIVEC +#include <config/altivec_cflags.h> +#endif +#ifdef HAVE_SSE +#include <config/sse_cflags.h> +#endif +#ifdef HAVE_SSE2 +#include <config/sse2_cflags.h> +#endif +#ifdef HAVE_SSE3 +#include <config/sse3_cflags.h> +#endif + +#include <stdio.h> +#include <string.h> + +int +main(int argc, char *argv[]) +{ + int i; + + for (i = 0; i < argc; i++) { + if (strcmp(argv[i], "--version") == 0) { + printf("%s\n", VERSION); + } else if (strcmp(argv[i], "--release") == 0) { + printf("%s\n", RELEASE); + } else if (strcmp(argv[i], "--prefix") == 0) { + printf("%s\n", PREFIX); + } else if (strcmp(argv[i], "--sysconfdir") == 0) { + printf("%s\n", SYSCONFDIR); + } else if (strcmp(argv[i], "--incldir") == 0) { + printf("%s\n", INCLDIR); + } else if (strcmp(argv[i], "--libdir") == 0) { + printf("%s\n", LIBDIR); + } else if (strcmp(argv[i], "--sharedir") == 0) { + printf("%s\n", SHAREDIR); + } else if (strcmp(argv[i], "--cflags") == 0) { + printf("-I%s ", INCLDIR); +#ifdef HAVE_MATH + printf("%s ", MATH_CFLAGS); +#endif +#ifdef HAVE_ALTIVEC + printf("%s ", ALTIVEC_CFLAGS); +#endif +#ifdef HAVE_SSE + printf("%s ", SSE_CFLAGS); +#endif +#ifdef HAVE_SSE2 + printf("%s ", SSE2_CFLAGS); +#endif +#ifdef HAVE_SSE3 + printf("%s ", SSE3_CFLAGS); +#endif + printf("\n"); + } else if (strcmp(argv[i], "--libs") == 0) { + printf("-L%s ", LIBDIR); + printf("-lag_math "); +#ifdef HAVE_MATH + printf("%s ", MATH_LIBS); +#endif + printf("\n"); + } + } + if (i <= 1) { + fprintf(stderr, + "Usage: %s [--version] [--prefix] [--sysconfdir] " + "[--incldir] [--libdir] [--sharedir] " + "[--cflags] [--libs]\n", argv[0]); + return (1); + } + return (0); +} + Added: trunk/math/.manlinks.mk =================================================================== --- trunk/math/.manlinks.mk (rev 0) +++ trunk/math/.manlinks.mk 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,8 @@ +MANLINKS+=M_Matrix.3:M_MatIdentity44.3 +CATLINKS+=M_Matrix.cat3:M_MatIdentity44.cat3 +MANLINKS+=M_Matrix.3:M_MatIdentity44v.3 +CATLINKS+=M_Matrix.cat3:M_MatIdentity44v.cat3 +MANLINKS+=M_Matrix.3:M_MatZero44.3 +CATLINKS+=M_Matrix.cat3:M_MatZero44.cat3 +MANLINKS+=M_Matrix.3:M_MatZero44v.3 +CATLINKS+=M_Matrix.cat3:M_MatZero44v.cat3 Added: trunk/math/M_Matrix.3 =================================================================== --- trunk/math/M_Matrix.3 (rev 0) +++ trunk/math/M_Matrix.3 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,114 @@ +.\" +.\" Copyright (c) 2006-2008 Hypertriton, Inc. <http://hypertriton.com/> +.\" +.\" Redistribution and use in source and binary forms, with or without +.\" modification, are permitted provided that the following conditions +.\" are met: +.\" 1. Redistributions of source code must retain the above copyright +.\" notice, this list of conditions and the following disclaimer. +.\" 2. Redistributions in binary form must reproduce the above copyright +.\" notice, this list of conditions and the following disclaimer in the +.\" documentation and/or other materials provided with the distribution. +.\" +.\" THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +.\" IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +.\" WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +.\" ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, +.\" INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +.\" (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +.\" SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +.\" HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +.\" STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +.\" IN ANY WAY OUT OF THE USE OF THIS SOFTWARE EVEN IF ADVISED OF THE +.\" POSSIBILITY OF SUCH DAMAGE. +.\" +.Dd July 22, 2006 +.Dt M_MATRIX 3 +.Os +.ds vT Agar-Math API Reference +.ds oS Agar 1.3.3 +.Sh NAME +.Nm M_Matrix +.Nd Agar-Math matrix-related functions +.Sh SYNOPSIS +.Bd -literal +#include <agar/math.h> +.Ed +.Sh DESCRIPTION +The +.Nm +interface provides basic linear algebra routines specific to matrices. +Similarly to +.Xr M_Vector 3 , +a consistent interface to different +.Em backends +is provided, allowing different numerical solvers and memory representations. +Selection between multiple backends is possible at run-time, or the Agar-Math +library can be compiled to provide inline expansions of these operations under +a specific backend. +.Sh M-BY-N MATRICES +The following routines operate on dynamically-allocated m-by-n matrices. +Individual entries are not directly accessible since the +.Em sparse +backend does not actually store them in an array. +.Pp +.Bl -tag -width "sparse " -compact +.It fpu +Native scalar floating point methods. +.It sparse +Methods optimized for large, sparse matrices. +Based on the excellent Sparse 1.4 package by Kenneth Kundert at UC Berkeley +(http://sparse.sourceforge.net/). +.El +.Pp +.nr nS 1 +.nr nS 0 +.Sh 4-BY-4 MATRICES +.Pp +The following routines are optimized for 4x4 matrices, as frequently +encountered in computer graphics. +Contrary to m-by-n matrices, the entries are not dynamically allocated and +are directly accessible via the +.Va m +member of the +.Ft M_Matrix44 +structure (row-major format). +Available backends include: +.Pp +.Bl -tag -width "fpu " -compact +.It fpu +Native scalar floating point methods. +.It sse +Accelerate operations using Streaming SIMD Extensions (SSE). +.El +.Pp +.nr nS 1 +.Ft "M_Matrix44" +.Fn M_MatIdentity44 "void" +.Pp +.Ft "void" +.Fn M_MatIdentity44v "M_Matrix44 *A" +.Pp +.Ft "M_Matrix44" +.Fn M_MatZero44 "void" +.Pp +.Ft "void" +.Fn M_MatZero44v "M_Matrix44 *A" +.Pp +.nr nS 0 +The functions +.Fn M_MatIdentity44 +and +.Fn M_MatIdentity44v +return the identity matrix. +.Fn M_MatZero44 +and +.Fn M_MatZero44v +return the zero matrix. +.Sh SEE ALSO +.Xr AG_Intro 3 , +.Xr M_Vector 3 +.Sh HISTORY +The +.Nm +interface first appeared in Agar 1.3.3. Added: trunk/math/Makefile =================================================================== --- trunk/math/Makefile (rev 0) +++ trunk/math/Makefile 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,39 @@ +TOP= .. +include ${TOP}/Makefile.config + +SUBDIR= SPARSE +LIBS= SPARSE/*.lo + +LIB= ag_math +LIB_INSTALL= Yes +LIB_SHARED= Yes +LIB_GUID= "ba35a553-bd88-4e5e-8c4b-d17f60ae7439" +LIB_LINKS= ag_core_static ag_gui_static \ + pthreads SDL opengl freetype + +SRCS= m_math.c m_complex.c m_quaternion.c \ + m_int_vector.c m_vector.c m_vector_fpu.c \ + m_vector2_fpu.c m_vector3_fpu.c m_vector4_fpu.c \ + m_vector3_sse.c m_vector3_sse3.c \ + m_matrix.c m_matrix_fpu.c m_matrix44_fpu.c m_matrix44_sse.c \ + m_gaussj.c m_lu.c \ + m_gui.c m_plotter.c m_matview.c \ + m_line.c m_circle.c m_triangle.c m_rectangle.c m_polygon.c m_plane.c \ + m_coordinates.c m_heapsort.c m_mergesort.c m_qsort.c m_radixsort.c \ + m_point_set.c m_color.c \ + m_matrix_sparse.c + +LIB_XOBJS=SPARSE + +MAN3= M_Matrix.3 + +CFLAGS+=${SDL_CFLAGS} ${PTHREADS_XOPEN_CFLAGS} ${ALTIVEC_CFLAGS} ${SSE_CFLAGS} \ + ${SSE2_CFLAGS} ${SSE3_CFLAGS} ${GLU_CFLAGS} ${MATH_CFLAGS} \ + -D_M_INTERNAL + +# For gcc warnings in m_matrix44_sse.c. +CFLAGS+=${WNO_UNINITIALIZED} + +include .manlinks.mk +include ${TOP}/mk/build.lib.mk +include ${TOP}/mk/build.man.mk Added: trunk/math/SPARSE/CHANGES =================================================================== --- trunk/math/SPARSE/CHANGES (rev 0) +++ trunk/math/SPARSE/CHANGES 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,7 @@ +This documents the changes we made to SPARSE library : http://sparse.sourceforge.net/ +We currently use SPARSE 1.4b. +Changes to vanilla SPARSE : +* changed the includes (basically, include "../m.h" in every .c, and include nothing in .h) +* #define spREAL M_Real to use M's real type +* uncapitalized file names +* removed some unused prototypes, and silenced some warnings Added: trunk/math/SPARSE/LICENSE =================================================================== --- trunk/math/SPARSE/LICENSE (rev 0) +++ trunk/math/SPARSE/LICENSE 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,25 @@ +Sparse1.4 is distributed as open-source software under the Berkeley +license model. Redistribution and use in source and binary forms, with +or without modification, are permitted provided that the following +conditions are met: + +Redistributions of source code must retain the original copyright notice, +this list of conditions and the following disclaimer. Redistributions +in binary form must reproduce the above copyright notice, this list +of conditions and the following disclaimer in the documentation and/or +other materials provided with the distribution. Neither the name of +the copyright holder nor the names of the authors may be used to endorse +or promote products derived from this software without specific prior +written permission. + +This software is provided by the copyright holders and contributors +``as is'' and any express or implied warranties, including, but not +limited to, the implied warranties of merchantability and fitness for +a particular purpose are disclaimed. In no event shall the copyright +owner or contributors be liable for any direct, indirect, incidental, +special, exemplary, or consequential damages (including, but not +limited to, procurement of substitute goods or services; loss of use, +data, or profits; or business interruption) however caused and on any +theory of liability, whether in contract, strict liability, or tort +(including negligence or otherwise) arising in any way out of the use +of this software, even if advised of the possibility of such damage. Added: trunk/math/SPARSE/Makefile =================================================================== --- trunk/math/SPARSE/Makefile (rev 0) +++ trunk/math/SPARSE/Makefile 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,23 @@ +TOP= ../.. +include ${TOP}/Makefile.config + +LIB= SPARSE +LIB_INSTALL= No +LIB_SHARED= Yes +LIB_GUID= "6051cbce-2498-406d-ae46-cf6ac89d05cf" +LIB_LINKS= ag_core_static ag_gui_static \ + pthreads SDL opengl freetype + +SRCS= spallocate.c \ + spbuild.c \ + spfactor.c \ + spoutput.c \ + spsolve.c \ + sputils.c \ + spedacious.c + +CFLAGS+=${SDL_CFLAGS} ${PTHREADS_XOPEN_CFLAGS} ${ALTIVEC_CFLAGS} ${SSE_CFLAGS} \ + ${SSE2_CFLAGS} ${SSE3_CFLAGS} ${GLU_CFLAGS} ${MATH_CFLAGS} \ + -D_M_INTERNAL + +include ${TOP}/mk/build.lib.mk Added: trunk/math/SPARSE/spallocate.c =================================================================== --- trunk/math/SPARSE/spallocate.c (rev 0) +++ trunk/math/SPARSE/spallocate.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,841 @@ +/* + * MATRIX ALLOCATION MODULE + * + * Author: Advising professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*!\file + * This file contains functions for allocating and freeing matrices, configuring them, and for + * accessing global information about the matrix (size, error status, etc.). + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spCreate + * spDestroy + * spErrorState + * spWhereSingular + * spGetSize + * spSetReal + * spSetComplex + * spFillinCount + * spElementCount + * + * >>> Other functions contained in this file: + * spcGetElement + * InitializeElementBlocks + * spcGetFillin + * RecordAllocation + * AllocateBlockOfAllocationList + * EnlargeMatrix + * ExpandTranslationArrays + */ + + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines.. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + + +/* + * Global strings + */ + +char spcMatrixIsNotValid[] = "Matrix passed to Sparse is not valid"; +char spcErrorsMustBeCleared[] = "Error not cleared"; +char spcMatrixMustBeFactored[] = "Matrix must be factored"; +char spcMatrixMustNotBeFactored[] = "Matrix must not be factored"; + + + + +/* + * Function declarations + */ + +static void InitializeElementBlocks( MatrixPtr, int, int ); +static void RecordAllocation( MatrixPtr, void* ); +static void AllocateBlockOfAllocationList( MatrixPtr ); + + + +/*! + * Allocates and initializes the data structures associated with a matrix. + * + * \return + * A pointer to the matrix is returned cast into \a spMatrix (typically a + * pointer to a void). This pointer is then passed and used by the other + * matrix routines to refer to a particular matrix. If an error occurs, + * the \a NULL pointer is returned. + * + * \param Size + * Size of matrix or estimate of size of matrix if matrix is \a EXPANDABLE. + * \param Complex + * Type of matrix. If \a Complex is 0 then the matrix is real, otherwise + * the matrix will be complex. Note that if the routines are not set up + * to handle the type of matrix requested, then an \a spPANIC error will occur. + * Further note that if a matrix will be both real and complex, it must + * be specified here as being complex. + * \param pError + * Returns error flag, needed because function \a spErrorState() will + * not work correctly if \a spCreate() returns \a NULL. Possible errors + * include \a spNO_MEMORY and \a spPANIC. + */ +/* >>> Local variables: + * AllocatedSize (int) + * The size of the matrix being allocated. + * Matrix (MatrixPtr) + * A pointer to the matrix frame being created. + */ + +spMatrix +spCreate( + int Size, + int Complex, + spError *pError +) +{ +register unsigned SizePlusOne; +register MatrixPtr Matrix; +register int I; +int AllocatedSize; + +/* Begin `spCreate'. */ +/* Clear error flag. */ + *pError = spOKAY; + +/* Test for valid size. */ + vASSERT( (Size >= 0) AND (Size != 0 OR EXPANDABLE), "Invalid size" ); + +/* Test for valid type. */ +#if NOT spCOMPLEX + ASSERT( NOT Complex ); +#endif +#if NOT REAL + ASSERT( Complex ); +#endif + +/* Create Matrix. */ + AllocatedSize = MAX( Size, MINIMUM_ALLOCATED_SIZE ); + SizePlusOne = (unsigned)(AllocatedSize + 1); + + if ((Matrix = ALLOC(struct MatrixFrame, 1)) == NULL) + { *pError = spNO_MEMORY; + return NULL; + } + +/* Initialize matrix */ + Matrix->ID = SPARSE_ID; + Matrix->Complex = Complex; + Matrix->PreviousMatrixWasComplex = Complex; + Matrix->Factored = NO; + Matrix->Elements = 0; + Matrix->Error = *pError; + Matrix->Fillins = 0; + Matrix->Reordered = NO; + Matrix->NeedsOrdering = YES; + Matrix->NumberOfInterchangesIsOdd = NO; + Matrix->Partitioned = NO; + Matrix->RowsLinked = NO; + Matrix->InternalVectorsAllocated = NO; + Matrix->SingularCol = 0; + Matrix->SingularRow = 0; + Matrix->Size = Size; + Matrix->AllocatedSize = AllocatedSize; + Matrix->ExtSize = Size; + Matrix->AllocatedExtSize = AllocatedSize; + Matrix->CurrentSize = 0; + Matrix->ExtToIntColMap = NULL; + Matrix->ExtToIntRowMap = NULL; + Matrix->IntToExtColMap = NULL; + Matrix->IntToExtRowMap = NULL; + Matrix->MarkowitzRow = NULL; + Matrix->MarkowitzCol = NULL; + Matrix->MarkowitzProd = NULL; + Matrix->DoCmplxDirect = NULL; + Matrix->DoRealDirect = NULL; + Matrix->Intermediate = NULL; + Matrix->RelThreshold = DEFAULT_THRESHOLD; + Matrix->AbsThreshold = 0.0; + + Matrix->TopOfAllocationList = NULL; + Matrix->RecordsRemaining = 0; + Matrix->ElementsRemaining = 0; + Matrix->FillinsRemaining = 0; + + RecordAllocation( Matrix, (void *)Matrix ); + if (Matrix->Error == spNO_MEMORY) goto MemoryError; + +/* Take out the trash. */ + Matrix->TrashCan.Real = 0.0; +#if spCOMPLEX + Matrix->TrashCan.Imag = 0.0; +#endif + Matrix->TrashCan.Row = 0; + Matrix->TrashCan.Col = 0; + Matrix->TrashCan.NextInRow = NULL; + Matrix->TrashCan.NextInCol = NULL; +#if INITIALIZE + Matrix->TrashCan.pInitInfo = NULL; +#endif + +/* Allocate space in memory for Diag pointer vector. */ + CALLOC( Matrix->Diag, ElementPtr, SizePlusOne); + if (Matrix->Diag == NULL) + goto MemoryError; + +/* Allocate space in memory for FirstInCol pointer vector. */ + CALLOC( Matrix->FirstInCol, ElementPtr, SizePlusOne); + if (Matrix->FirstInCol == NULL) + goto MemoryError; + +/* Allocate space in memory for FirstInRow pointer vector. */ + CALLOC( Matrix->FirstInRow, ElementPtr, SizePlusOne); + if (Matrix->FirstInRow == NULL) + goto MemoryError; + +/* Allocate space in memory for IntToExtColMap vector. */ + if (( Matrix->IntToExtColMap = ALLOC(int, SizePlusOne)) == NULL) + goto MemoryError; + +/* Allocate space in memory for IntToExtRowMap vector. */ + if (( Matrix->IntToExtRowMap = ALLOC(int, SizePlusOne)) == NULL) + goto MemoryError; + +/* Initialize MapIntToExt vectors. */ + for (I = 1; I <= AllocatedSize; I++) + { Matrix->IntToExtRowMap[I] = I; + Matrix->IntToExtColMap[I] = I; + } + +#if TRANSLATE +/* Allocate space in memory for ExtToIntColMap vector. */ + if (( Matrix->ExtToIntColMap = ALLOC(int, SizePlusOne)) == NULL) + goto MemoryError; + +/* Allocate space in memory for ExtToIntRowMap vector. */ + if (( Matrix->ExtToIntRowMap = ALLOC(int, SizePlusOne)) == NULL) + goto MemoryError; + +/* Initialize MapExtToInt vectors. */ + for (I = 1; I <= AllocatedSize; I++) + { Matrix->ExtToIntColMap[I] = -1; + Matrix->ExtToIntRowMap[I] = -1; + } + Matrix->ExtToIntColMap[0] = 0; + Matrix->ExtToIntRowMap[0] = 0; +#endif + +/* Allocate space for fill-ins and initial set of elements. */ + InitializeElementBlocks( Matrix, SPACE_FOR_ELEMENTS*AllocatedSize, + SPACE_FOR_FILL_INS*AllocatedSize ); + if (Matrix->Error == spNO_MEMORY) + goto MemoryError; + + return (char *)Matrix; + +MemoryError: + +/* Deallocate matrix and return no pointer to matrix if there is not enough + memory. */ + *pError = spNO_MEMORY; + spDestroy( (char *)Matrix); + return NULL; +} + + + + + + + + + +/* + * ELEMENT ALLOCATION + * + * This routine allocates space for matrix elements. It requests large blocks + * of storage from the system and doles out individual elements as required. + * This technique, as opposed to allocating elements individually, tends to + * speed the allocation process. + * + * >>> Returned: + * A pointer to an element. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * + * >>> Local variables: + * pElement (ElementPtr) + * A pointer to the first element in the group of elements being allocated. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +ElementPtr +spcGetElement( MatrixPtr Matrix ) +{ +ElementPtr pElement; + +/* Begin `spcGetElement'. */ + +/* Allocate block of MatrixElements if necessary. */ + if (Matrix->ElementsRemaining == 0) + { pElement = ALLOC(struct MatrixElement, ELEMENTS_PER_ALLOCATION); + RecordAllocation( Matrix, (void *)pElement ); + if (Matrix->Error == spNO_MEMORY) return NULL; + Matrix->ElementsRemaining = ELEMENTS_PER_ALLOCATION; + Matrix->NextAvailElement = pElement; + } + +/* Update Element counter and return pointer to Element. */ + Matrix->ElementsRemaining--; + return Matrix->NextAvailElement++; +} + + + + + + + + +/* + * ELEMENT ALLOCATION INITIALIZATION + * + * This routine allocates space for matrix fill-ins and an initial set of + * elements. Besides being faster than allocating space for elements one + * at a time, it tends to keep the fill-ins physically close to the other + * matrix elements in the computer memory. This keeps virtual memory paging + * to a minimum. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * InitialNumberOfElements <input> (int) + * This number is used as the size of the block of memory, in + * MatrixElements, reserved for elements. If more than this number of + * elements are generated, then more space is allocated later. + * NumberOfFillinsExpected <input> (int) + * This number is used as the size of the block of memory, in + * MatrixElements, reserved for fill-ins. If more than this number of + * fill-ins are generated, then more space is allocated, but they may + * not be physically close in computer's memory. + * + * >>> Local variables: + * pElement (ElementPtr) + * A pointer to the first element in the group of elements being allocated. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +static void +InitializeElementBlocks( + MatrixPtr Matrix, + int InitialNumberOfElements, + int NumberOfFillinsExpected +) +{ +ElementPtr pElement; + +/* Begin `InitializeElementBlocks'. */ + +/* Allocate block of MatrixElements for elements. */ + pElement = ALLOC(struct MatrixElement, InitialNumberOfElements); + RecordAllocation( Matrix, (void *)pElement ); + if (Matrix->Error == spNO_MEMORY) return; + Matrix->ElementsRemaining = InitialNumberOfElements; + Matrix->NextAvailElement = pElement; + +/* Allocate block of MatrixElements for fill-ins. */ + pElement = ALLOC(struct MatrixElement, NumberOfFillinsExpected); + RecordAllocation( Matrix, (void *)pElement ); + if (Matrix->Error == spNO_MEMORY) return; + Matrix->FillinsRemaining = NumberOfFillinsExpected; + Matrix->NextAvailFillin = pElement; + +/* Allocate a fill-in list structure. */ + Matrix->FirstFillinListNode = ALLOC(struct FillinListNodeStruct,1); + RecordAllocation( Matrix, (void *)Matrix->FirstFillinListNode ); + if (Matrix->Error == spNO_MEMORY) return; + Matrix->LastFillinListNode = Matrix->FirstFillinListNode; + + Matrix->FirstFillinListNode->pFillinList = pElement; + Matrix->FirstFillinListNode->NumberOfFillinsInList =NumberOfFillinsExpected; + Matrix->FirstFillinListNode->Next = NULL; + + return; +} + + + + + + + + + + +/* + * FILL-IN ALLOCATION + * + * This routine allocates space for matrix fill-ins. It requests large blocks + * of storage from the system and doles out individual elements as required. + * This technique, as opposed to allocating elements individually, tends to + * speed the allocation process. + * + * >>> Returned: + * A pointer to the fill-in. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +ElementPtr +spcGetFillin( MatrixPtr Matrix ) +{ +struct FillinListNodeStruct *pListNode; +ElementPtr pFillins; + +/* Begin `spcGetFillin'. */ + +#if NOT STRIP OR LINT + if (Matrix->FillinsRemaining == 0) + return spcGetElement( Matrix ); +#endif +#if STRIP OR LINT + + if (Matrix->FillinsRemaining == 0) + { pListNode = Matrix->LastFillinListNode; + +/* First see if there are any stripped fill-ins left. */ + if (pListNode->Next != NULL) + { Matrix->LastFillinListNode = pListNode = pListNode->Next; + Matrix->FillinsRemaining = pListNode->NumberOfFillinsInList; + Matrix->NextAvailFillin = pListNode->pFillinList; + } + else + { +/* Allocate block of fill-ins. */ + pFillins = ALLOC(struct MatrixElement, ELEMENTS_PER_ALLOCATION); + RecordAllocation( Matrix, (void *)pFillins ); + if (Matrix->Error == spNO_MEMORY) return NULL; + Matrix->FillinsRemaining = ELEMENTS_PER_ALLOCATION; + Matrix->NextAvailFillin = pFillins; + +/* Allocate a fill-in list structure. */ + pListNode->Next = ALLOC(struct FillinListNodeStruct,1); + RecordAllocation( Matrix, (void *)pListNode->Next ); + if (Matrix->Error == spNO_MEMORY) return NULL; + Matrix->LastFillinListNode = pListNode = pListNode->Next; + + pListNode->pFillinList = pFillins; + pListNode->NumberOfFillinsInList = ELEMENTS_PER_ALLOCATION; + pListNode->Next = NULL; + } + } +#endif + +/* Update Fill-in counter and return pointer to Fill-in. */ + Matrix->FillinsRemaining--; + return Matrix->NextAvailFillin++; +} + + + + + + + + + +/* + * RECORD A MEMORY ALLOCATION + * + * This routine is used to record all memory allocations so that the memory + * can be freed later. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * AllocatedPtr <input> (void *) + * The pointer returned by malloc or calloc. These pointers are saved in + * a list so that they can be easily freed. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +static void +RecordAllocation( + MatrixPtr Matrix, + void *AllocatedPtr +) +{ +/* Begin `RecordAllocation'. */ +/* + * If Allocated pointer is NULL, assume that malloc returned a NULL pointer, + * which indicates a spNO_MEMORY error. + */ + if (AllocatedPtr == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + +/* Allocate block of MatrixElements if necessary. */ + if (Matrix->RecordsRemaining == 0) + { AllocateBlockOfAllocationList( Matrix ); + if (Matrix->Error == spNO_MEMORY) + { FREE(AllocatedPtr); + return; + } + } + +/* Add Allocated pointer to Allocation List. */ + (++Matrix->TopOfAllocationList)->AllocatedPtr = AllocatedPtr; + Matrix->RecordsRemaining--; + return; + +} + + + + + + + + +/* + * ADD A BLOCK OF SLOTS TO ALLOCATION LIST + * + * This routine increases the size of the allocation list. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * + * >>> Local variables: + * ListPtr (AllocationListPtr) + * Pointer to the list that contains the pointers to segments of memory + * that were allocated by the operating system for the current matrix. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +static void +AllocateBlockOfAllocationList( MatrixPtr Matrix ) +{ +register int I; +register AllocationListPtr ListPtr; + +/* Begin `AllocateBlockOfAllocationList'. */ +/* Allocate block of records for allocation list. */ + ListPtr = ALLOC(struct AllocationRecord, (ELEMENTS_PER_ALLOCATION+1)); + if (ListPtr == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + +/* String entries of allocation list into singly linked list. List is linked + such that any record points to the one before it. */ + + ListPtr->NextRecord = Matrix->TopOfAllocationList; + Matrix->TopOfAllocationList = ListPtr; + ListPtr += ELEMENTS_PER_ALLOCATION; + for (I = ELEMENTS_PER_ALLOCATION; I > 0; I--) + { ListPtr->NextRecord = ListPtr - 1; + ListPtr--; + } + +/* Record allocation of space for allocation list on allocation list. */ + Matrix->TopOfAllocationList->AllocatedPtr = (void *)ListPtr; + Matrix->RecordsRemaining = ELEMENTS_PER_ALLOCATION; + + return; +} + + + + + + + + +/*! + * Destroys a matrix and frees all memory associated with it. + * + * \param eMatrix + * Pointer to the matrix frame which is to be destroyed. + */ +/* >>> Local variables: + * ListPtr (AllocationListPtr) + * Pointer into the linked list of pointers to allocated data structures. + * Points to pointer to structure to be freed. + * NextListPtr (AllocationListPtr) + * Pointer into the linked list of pointers to allocated data structures. + * Points to the next pointer to structure to be freed. This is needed + * because the data structure to be freed could include the current node + * in the allocation list. + */ + +void +spDestroy( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register AllocationListPtr ListPtr, NextListPtr; + +/* Begin `spDestroy'. */ + ASSERT_IS_SPARSE( Matrix ); + +/* Deallocate the vectors that are located in the matrix frame. */ + FREE( Matrix->IntToExtColMap ); + FREE( Matrix->IntToExtRowMap ); + FREE( Matrix->ExtToIntColMap ); + FREE( Matrix->ExtToIntRowMap ); + FREE( Matrix->Diag ); + FREE( Matrix->FirstInRow ); + FREE( Matrix->FirstInCol ); + FREE( Matrix->MarkowitzRow ); + FREE( Matrix->MarkowitzCol ); + FREE( Matrix->MarkowitzProd ); + FREE( Matrix->DoCmplxDirect ); + FREE( Matrix->DoRealDirect ); + FREE( Matrix->Intermediate ); + +/* Sequentially step through the list of allocated pointers freeing pointers + * along the way. */ + ListPtr = Matrix->TopOfAllocationList; + while (ListPtr != NULL) + { NextListPtr = ListPtr->NextRecord; + free( ListPtr->AllocatedPtr ); + ListPtr = NextListPtr; + } + return; +} + + + + + + + +/*! + * This function returns the error status of the given matrix. + * + * \return + * The error status of the given matrix. + * + * \param eMatrix + * The pointer to the matrix for which the error status is desired. + */ + +spError +spErrorState( spMatrix eMatrix ) +{ +/* Begin `spErrorState'. */ + + if (eMatrix != NULL) + { ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + return ((MatrixPtr)eMatrix)->Error; + } + else return spNO_MEMORY; /* This error may actually be spPANIC, + * no way to tell. */ +} + + + + + + + + + +/*! + * This function returns the row and column number where the matrix was + * detected as singular (if pivoting was allowed on the last factorization) + * or where a zero was detected on the diagonal (if pivoting was not + * allowed on the last factorization). Pivoting is performed only in + * spOrderAndFactor(). + * + * \param eMatrix + * The matrix for which the error status is desired. + * \param pRow + * The row number. + * \param pCol + * The column number. + */ + +void +spWhereSingular( + spMatrix eMatrix, + int *pRow, + int *pCol +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; + +/* Begin `spWhereSingular'. */ + ASSERT_IS_SPARSE( Matrix ); + + if (Matrix->Error == spSINGULAR OR Matrix->Error == spZERO_DIAG) + { *pRow = Matrix->SingularRow; + *pCol = Matrix->SingularCol; + } + else *pRow = *pCol = 0; + return; +} + + + + + + +/*! + * Returns the size of the matrix. Either the internal or external size of + * the matrix is returned. + * + * \param eMatrix + * Pointer to matrix. + * \param External + * If \a External is set true, the external size , i.e., the value of the + * largest external row or column number encountered is returned. + * Otherwise the true size of the matrix is returned. These two sizes + * may differ if the \a TRANSLATE option is set true. + */ + +int +spGetSize( + spMatrix eMatrix, + int External +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; + +/* Begin `spGetSize'. */ + ASSERT_IS_SPARSE( Matrix ); + +#if TRANSLATE + if (External) + return Matrix->ExtSize; + else + return Matrix->Size; +#else + return Matrix->Size; +#endif +} + + + + + + + + +/*! + * Forces matrix to be real. + * + * \param eMatrix + * Pointer to matrix. + */ + +void +spSetReal( spMatrix eMatrix ) +{ +/* Begin `spSetReal'. */ + + ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + vASSERT( REAL, "Sparse not compiled to handle real matrices" ); + ((MatrixPtr)eMatrix)->Complex = NO; + return; +} + + +/*! + * Forces matrix to be complex. + * + * \param eMatrix + * Pointer to matrix. + */ + +void +spSetComplex( spMatrix eMatrix ) +{ +/* Begin `spSetComplex'. */ + + ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + vASSERT( spCOMPLEX, "Sparse not compiled to handle complex matrices" ); + ((MatrixPtr)eMatrix)->Complex = YES; + return; +} + + + + + + + + + +/*! + * This function returns the number of fill-ins that currently exists in a matrix. + * + * \param eMatrix + * Pointer to matrix. + */ + +int +spFillinCount( spMatrix eMatrix ) +{ +/* Begin `spFillinCount'. */ + + ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + return ((MatrixPtr)eMatrix)->Fillins; +} + + +/*! + * This function returns the total number of elements (including fill-ins) that currently exists in a matrix. + * + * \param eMatrix + * Pointer to matrix. + */ + +int +spElementCount( spMatrix eMatrix ) +{ +/* Begin `spElementCount'. */ + + ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + return ((MatrixPtr)eMatrix)->Elements; +} Added: trunk/math/SPARSE/spbuild.c =================================================================== --- trunk/math/SPARSE/spbuild.c (rev 0) +++ trunk/math/SPARSE/spbuild.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,1226 @@ +/* + * MATRIX BUILD MODULE + * + * Author: Advising professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*!\file + * This file contains the routines associated with clearing, loading and + * preprocessing the matrix. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spClear + * spFindElement + * spGetElement + * spGetAdmittance + * spGetQuad + * spGetOnes + * spInstallInitInfo + * spGetInitInfo + * spInitialize + * + * >>> Other functions contained in this file: + * Translate + * spcFindDiag + * spcCreateElement + * spcLinkRows + * EnlargeMatrix + * ExpandTranslationArrays + */ + + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + + +/* + * Function declarations + */ + +static void Translate( MatrixPtr, int*, int* ); +static void EnlargeMatrix( MatrixPtr, int ); +static void ExpandTranslationArrays( MatrixPtr, int ); + + + + + + +/*! + * Sets every element of the matrix to zero and clears the error flag. + * + * \param eMatrix + * Pointer to matrix that is to be cleared. + */ +/* >>> Local variables: + * pElement (ElementPtr) + * A pointer to the element being cleared. + */ + +void +spClear( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register int I; + +/* Begin `spClear'. */ + ASSERT_IS_SPARSE( Matrix ); + +/* Clear matrix. */ +#if spCOMPLEX + if (Matrix->PreviousMatrixWasComplex OR Matrix->Complex) + { for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { pElement->Real = 0.0; + pElement->Imag = 0.0; + pElement = pElement->NextInCol; + } + } + } + else +#endif + { for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { pElement->Real = 0.0; + pElement = pElement->NextInCol; + } + } + } + +/* Empty the trash. */ + Matrix->TrashCan.Real = 0.0; +#if spCOMPLEX + Matrix->TrashCan.Imag = 0.0; +#endif + + Matrix->Error = spOKAY; + Matrix->Factored = NO; + Matrix->SingularCol = 0; + Matrix->SingularRow = 0; + Matrix->PreviousMatrixWasComplex = Matrix->Complex; + return; +} + + + + + + + + + + +/*! + * This routine is used to find an element given its indices. It will not + * create it if it does not exist. + * + * \return + * A pointer to the desired element, or \a NULL if it does not exist. + * + * \param eMatrix + * Pointer to matrix. + * \param Row + * Row index for element. + * \param Col + * Column index for element. + * + * \see spGetElement() + */ +/* >>> Local variables: + * pElement (ElementPtr) + * Pointer to an element in the matrix. + */ + +spElement * +spFindElement( + spMatrix eMatrix, + int Row, + int Col +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +int StartAt = 0, Min = AG_INT_MAX; +#define BorderRight 0 /* Start at left border, move right. */ +#define BorderDown 1 /* Start at top border, move down. */ +#define DiagRight 2 /* Start at diagonal, move right. */ +#define DiagDown 3 /* Start at diagonal, move down. */ + +ASSERT_IS_SPARSE( Matrix ); +vASSERT( Row >= 0 AND Col >= 0, "Negative row or column number" ); + +#if TRANSLATE +Translate( Matrix, &Row, &Col ); +if (Matrix->Error == spNO_MEMORY) return NULL; +#endif + +#if NOT TRANSLATE +#if NOT EXPANDABLE +vASSERT( (Row <= Matrix->Size) AND (Col <= Matrix->Size), + "Row or column number too large" ); +#endif +#endif + +/* Begin `spFindElement'. */ + if (Row == Col) return &Matrix->Diag[Row]->Real; + +/* Determine where to start the search. */ + if (Matrix->RowsLinked) + { if ((Col >= Row) AND Matrix->Diag[Row]) + { Min = Col - Row; + StartAt = DiagRight; + } + else + { Min = Col; + StartAt = BorderRight; + } + } + if ((Row >= Col) AND Matrix->Diag[Col]) + { if (Row - Col < Min) + StartAt = DiagDown; + } + else if (Row < Min) + StartAt = BorderDown; + +/* Search column for element. */ + if ((StartAt == BorderDown) OR (StartAt == DiagDown)) + { if (StartAt == BorderDown) + pElement = Matrix->FirstInCol[Col]; + else + pElement = Matrix->Diag[Col]; + + while ((pElement != NULL) AND (pElement->Row < Row)) + pElement = pElement->NextInCol; + if (pElement AND (pElement->Row == Row)) + return &pElement->Real; + else + return NULL; + } + +/* Search row for element. */ + if (StartAt == BorderRight) + pElement = Matrix->FirstInRow[Row]; + else + pElement = Matrix->Diag[Row]; + + while ((pElement != NULL) AND (pElement->Col < Col)) + pElement = pElement->NextInRow; + if (pElement AND (pElement->Col == Col)) + return &pElement->Real; + else + return NULL; +} + + + + + + + + + +/*! + * Finds element [Row,Col] and returns a pointer to it. If element is + * not found then it is created and spliced into matrix. This routine + * is only to be used after spCreate() and before spMNA_Preorder(), + * spFactor() or spOrderAndFactor(). Returns a pointer to the + * real portion of an \a spElement. This pointer is later used by + * \a spADD_xxx_ELEMENT to directly access element. + * + * \return + * Returns a pointer to the element. This pointer is then used to directly + * access the element during successive builds. + * + * \param eMatrix + * Pointer to the matrix that the element is to be added to. + * \param Row + * Row index for element. Must be in the range of [0..Size] unless + * the options \a EXPANDABLE or \a TRANSLATE are used. Elements placed in + * row zero are discarded. In no case may \a Row be less than zero. + * \param Col + * Column index for element. Must be in the range of [0..Size] unless + * the options \a EXPANDABLE or \a TRANSLATE are used. Elements placed in + * column zero are discarded. In no case may \a Col be less than zero. + + * \see spFindElement() + */ +/* >>> Local variables: + * pElement (RealNumber *) + * Pointer to the element. + * + * >>> Possible errors: + * spNO_MEMORY + * Error is not cleared in this routine. + */ + +spElement * +spGetElement( + spMatrix eMatrix, + int Row, + int Col +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +ElementPtr pElement; + +/* Begin `spGetElement'. */ + ASSERT_IS_SPARSE( Matrix ); + vASSERT( Row >= 0 AND Col >= 0, "Negative row or column number" ); + + if ((Row == 0) OR (Col == 0)) + return &Matrix->TrashCan.Real; + +#if NOT TRANSLATE + vASSERT( NOT Matrix->Reordered, + "Set TRANSLATE to add elements to a reordered matrix" ); +#endif + +#if TRANSLATE + Translate( Matrix, &Row, &Col ); + if (Matrix->Error == spNO_MEMORY) return NULL; +#endif + +#if NOT TRANSLATE +#if NOT EXPANDABLE + vASSERT( (Row <= Matrix->Size) AND (Col <= Matrix->Size), + "Row or column number too large" ); +#endif + +#if EXPANDABLE +/* Re-size Matrix if necessary. */ + if ((Row > Matrix->Size) OR (Col > Matrix->Size)) + EnlargeMatrix( Matrix, MAX(Row, Col) ); + if (Matrix->Error == spNO_MEMORY) return NULL; +#endif +#endif + + if ((Row != Col) OR ((pElement = Matrix->Diag[Row]) == NULL)) + { /* + * Element does not exist or does not reside along diagonal. Search + * for element and if it does not exist, create it. + */ + pElement = spcCreateElement( Matrix, Row, Col, + &(Matrix->FirstInRow[Row]), + &(Matrix->FirstInCol[Col]), NO ); + } +/* + * Cast pointer into a pointer to a RealNumber. This requires that Real + * be the first record in the MatrixElement structure. + */ + return &pElement->Real; +} + + + + + + + +#if TRANSLATE + +/* + * TRANSLATE EXTERNAL INDICES TO INTERNAL + * + * Convert internal row and column numbers to internal row and column numbers. + * Also updates Ext/Int maps. + * + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * Row <input/output> (int *) + * Upon entry Row is either a external row number of an external node + * number. Upon entry, the internal equivalent is supplied. + * Col <input/output> (int *) + * Upon entry Column is either a external column number of an external node + * number. Upon entry, the internal equivalent is supplied. + * + * >>> Local variables: + * ExtCol (int) + * Temporary variable used to hold the external column or node number + * during the external to internal column number translation. + * ExtRow (int) + * Temporary variable used to hold the external row or node number during + * the external to internal row number translation. + * IntCol (int) + * Temporary variable used to hold the internal column or node number + * during the external to internal column number translation. + * IntRow (int) + * Temporary variable used to hold the internal row or node number during + * the external to internal row number translation. + */ + +static void +Translate( + MatrixPtr Matrix, + int *Row, + int *Col +) +{ +register int IntRow, IntCol, ExtRow, ExtCol; + +/* Begin `Translate'. */ + ExtRow = *Row; + ExtCol = *Col; + +/* Expand translation arrays if necessary. */ + if ((ExtRow > Matrix->AllocatedExtSize) OR + (ExtCol > Matrix->AllocatedExtSize)) + { + ExpandTranslationArrays( Matrix, MAX(ExtRow, ExtCol) ); + if (Matrix->Error == spNO_MEMORY) return; + } + +/* Set ExtSize if necessary. */ + if ((ExtRow > Matrix->ExtSize) OR (ExtCol > Matrix->ExtSize)) + Matrix->ExtSize = MAX(ExtRow, ExtCol); + +/* Translate external row or node number to internal row or node number. */ + if ((IntRow = Matrix->ExtToIntRowMap[ExtRow]) == -1) + { Matrix->ExtToIntRowMap[ExtRow] = ++Matrix->CurrentSize; + Matrix->ExtToIntColMap[ExtRow] = Matrix->CurrentSize; + IntRow = Matrix->CurrentSize; + +#if NOT EXPANDABLE + vASSERT( IntRow <= Matrix->Size, "Matrix size fixed" ); +#endif + +#if EXPANDABLE +/* Re-size Matrix if necessary. */ + if (IntRow > Matrix->Size) + EnlargeMatrix( Matrix, IntRow ); + if (Matrix->Error == spNO_MEMORY) return; +#endif + + Matrix->IntToExtRowMap[IntRow] = ExtRow; + Matrix->IntToExtColMap[IntRow] = ExtRow; + } + +/* Translate external column or node number to internal column or node number.*/ + if ((IntCol = Matrix->ExtToIntColMap[ExtCol]) == -1) + { Matrix->ExtToIntRowMap[ExtCol] = ++Matrix->CurrentSize; + Matrix->ExtToIntColMap[ExtCol] = Matrix->CurrentSize; + IntCol = Matrix->CurrentSize; + +#if NOT EXPANDABLE + vASSERT( IntCol <= Matrix->Size, "Matrix size fixed" ); +#endif + +#if EXPANDABLE +/* Re-size Matrix if necessary. */ + if (IntCol > Matrix->Size) + EnlargeMatrix( Matrix, IntCol ); + if (Matrix->Error == spNO_MEMORY) return; +#endif + + Matrix->IntToExtRowMap[IntCol] = ExtCol; + Matrix->IntToExtColMap[IntCol] = ExtCol; + } + + *Row = IntRow; + *Col = IntCol; + return; +} +#endif + + + + + + +#if QUAD_ELEMENT +/*! + * Performs same function as spGetElement() except rather than one + * element, all four matrix elements for a floating two terminal + * admittance component are added. This routine also works if component + * is grounded. Positive elements are placed at [Node1,Node2] and + * [Node2,Node1]. This routine is only to be used after spCreate() + * and before spMNA_Preorder(), spFactor() or spOrderAndFactor(). + * + * \return + * Error code. Possible errors include \a spNO_MEMORY. + * Error is not cleared in this routine. + * + * \param Matrix + * Pointer to the matrix that component is to be entered in. + * \param Node1 + * Row and column indices for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Node zero is the + * ground node. In no case may \a Node1 be less than zero. + * \param Node2 + * Row and column indices for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Node zero is the + * ground node. In no case may \a Node2 be less than zero. + * \param Template + * Collection of pointers to four elements that are later used to directly + * address elements. User must supply the template, this routine will + * fill it. + */ + +spError +spGetAdmittance( + spMatrix Matrix, + int Node1, + int Node2, + struct spTemplate *Template +) +{ + +/* Begin `spGetAdmittance'. */ + Template->Element1 = spGetElement(Matrix, Node1, Node1 ); + Template->Element2 = spGetElement(Matrix, Node2, Node2 ); + Template->Element3Negated = spGetElement( Matrix, Node2, Node1 ); + Template->Element4Negated = spGetElement( Matrix, Node1, Node2 ); + if + ( (Template->Element1 == NULL) + OR (Template->Element2 == NULL) + OR (Template->Element3Negated == NULL) + OR (Template->Element4Negated == NULL) + ) return spNO_MEMORY; + + if (Node1 == 0) + SWAP( RealNumber*, Template->Element1, Template->Element2 ); + + return spOKAY; +} +#endif /* QUAD_ELEMENT */ + + + + + + + + + +#if QUAD_ELEMENT +/*! + * Similar to spGetAdmittance(), except that spGetAdmittance() only + * handles 2-terminal components, whereas spGetQuad() handles simple + * 4-terminals as well. These 4-terminals are simply generalized + * 2-terminals with the option of having the sense terminals different + * from the source and sink terminals. spGetQuad() adds four + * elements to the matrix. Positive elements occur at [Row1,Col1] + * [Row2,Col2] while negative elements occur at [Row1,Col2] and [Row2,Col1]. + * The routine works fine if any of the rows and columns are zero. + * This routine is only to be used after spCreate() and before + * spMNA_Preorder(), spFactor() or spOrderAndFactor() + * unless \a TRANSLATE is set true. + * + * \return + * Error code. Possible errors include \a spNO_MEMORY. + * Error is not cleared in this routine. + * + * \param Matrix + * Pointer to the matrix that component is to be entered in. + * \param Row1 + * First row index for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground row. In no case may Row1 be less than zero. + * \param Row2 + * Second row index for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground row. In no case may Row2 be less than zero. + * \param Col1 + * First column index for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground column. In no case may Col1 be less than zero. + * \param Col2 + * Second column index for elements. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground column. In no case may Col2 be less than zero. + * \param Template + * Collection of pointers to four elements that are later used to directly + * address elements. User must supply the template, this routine will + * fill it. + */ + +spError +spGetQuad( + spMatrix Matrix, + int Row1, + int Row2, + int Col1, + int Col2, + struct spTemplate *Template +) +{ +/* Begin `spGetQuad'. */ + Template->Element1 = spGetElement( Matrix, Row1, Col1); + Template->Element2 = spGetElement( Matrix, Row2, Col2 ); + Template->Element3Negated = spGetElement( Matrix, Row2, Col1 ); + Template->Element4Negated = spGetElement( Matrix, Row1, Col2 ); + if + ( (Template->Element1 == NULL) + OR (Template->Element2 == NULL) + OR (Template->Element3Negated == NULL) + OR (Template->Element4Negated == NULL) + ) return spNO_MEMORY; + + if (Template->Element1 == &((MatrixPtr)Matrix)->TrashCan.Real) + SWAP( RealNumber *, Template->Element1, Template->Element2 ); + + return spOKAY; +} +#endif /* QUAD_ELEMENT */ + + + + + + + + + +#if QUAD_ELEMENT +/*! + * Addition of four structural ones to matrix by index. + * Performs similar function to spGetQuad() except this routine is + * meant for components that do not have an admittance representation. + * + * The following stamp is used: \code + * Pos Neg Eqn + * Pos [ . . 1 ] + * Neg [ . . -1 ] + * Eqn [ 1 -1 . ] + * \endcode + * + * \return + * Error code. Possible errors include \a spNO_MEMORY. + * Error is not cleared in this routine. + * + * \param Matrix + * Pointer to the matrix that component is to be entered in. + * \param Pos + * See stamp above. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground row. In no case may \a Pos be less than zero. + * \param Neg + * See stamp above. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground row. In no case may \a Neg be less than zero. + * \param Eqn + * See stamp above. Must be in the range of [0..Size] + * unless the options \a EXPANDABLE or \a TRANSLATE are used. Zero is the + * ground row. In no case may \a Eqn be less than zero. + * \param Template + * Collection of pointers to four elements that are later used to directly + * address elements. User must supply the template, this routine will + * fill it. + */ + +spError +spGetOnes( + spMatrix Matrix, + int Pos, + int Neg, + int Eqn, + struct spTemplate *Template +) +{ +/* Begin `spGetOnes'. */ + Template->Element4Negated = spGetElement( Matrix, Neg, Eqn ); + Template->Element3Negated = spGetElement( Matrix, Eqn, Neg ); + Template->Element2 = spGetElement( Matrix, Pos, Eqn ); + Template->Element1 = spGetElement( Matrix, Eqn, Pos ); + if + ( (Template->Element1 == NULL) + OR (Template->Element2 == NULL) + OR (Template->Element3Negated == NULL) + OR (Template->Element4Negated == NULL) + ) return spNO_MEMORY; + + spADD_REAL_QUAD( *Template, 1.0 ); + return spOKAY; +} +#endif /* QUAD_ELEMENT */ + + + + + + + +/* + * FIND DIAGONAL + * + * This routine is used to find a diagonal element. It will not + * create it if it does not exist. + * + * >>> Returned: + * A pointer to the desired element, or NULL if it does not exist. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Index <input> (int) + * Row, Col index for diagonal element. + * + * >>> Local variables: + * pElement (ElementPtr) + * Pointer to an element in the matrix. + */ + +ElementPtr +spcFindDiag( + MatrixPtr Matrix, + register int Index +) +{ +register ElementPtr pElement; + +/* Begin `spcFindDiag'. */ + pElement = Matrix->FirstInCol[Index]; + +/* Search column for element. */ + while ((pElement != NULL) AND (pElement->Row < Index)) + pElement = pElement->NextInCol; + if (pElement AND (pElement->Row == Index)) + return pElement; + else + return NULL; +} + + + + + + + + +/* + * CREATE AND SPLICE ELEMENT INTO MATRIX + * + * This routine is used to create new matrix elements and splice them into the + * matrix. + * + * >>> Returned: + * A pointer to the element that was created is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Row <input> (int) + * Row index for element. + * Col <input> (int) + * Column index for element. + * ppToLeft <input-output> (ElementPtr *) + * This contains the address of the pointer to an element to the left + * of the one being created. It is used to speed the search and if it + * is immediately to the left, it is updated with address of the + * created element. + * ppAbove <input-output> (ElementPtr *) + * This contains the address of the pointer to an element above the + * one being created. It is used to speed the search and it if it + * is immediatley above, it is updated with address of the created + * element. + * Fillin <input> (BOOLEAN) + * Flag that indicates if created element is to be a fill-in. + * + * >>> Local variables: + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * pCreatedElement (ElementPtr) + * Pointer to the desired element, the one that was just created. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +ElementPtr +spcCreateElement( + MatrixPtr Matrix, + int Row, + register int Col, + register ElementPtr *ppToLeft, + register ElementPtr *ppAbove, + BOOLEAN Fillin +) +{ +register ElementPtr pElement, pCreatedElement; + +/* Begin `spcCreateElement'. */ + +/* Find element immediately above the desired element. */ + pElement = *ppAbove; + while ((pElement != NULL) AND (pElement->Row < Row)) + { ppAbove = &pElement->NextInCol; + pElement = *ppAbove; + } + if ((pElement != NULL) AND (pElement->Row == Row)) + return pElement; + +/* The desired element does not exist, create it. */ + if (Fillin) + { pCreatedElement = spcGetFillin( Matrix ); + Matrix->Fillins++; + +/* Update Markowitz counts and products. */ + ++Matrix->MarkowitzRow[Row]; + spcMarkoProd( Matrix->MarkowitzProd[Row], + Matrix->MarkowitzRow[Row], + Matrix->MarkowitzCol[Row] ); + if ((Matrix->MarkowitzRow[Row] == 1) AND + (Matrix->MarkowitzCol[Row] != 0)) + { + Matrix->Singletons--; + } + ++Matrix->MarkowitzCol[Col]; + spcMarkoProd( Matrix->MarkowitzProd[Col], + Matrix->MarkowitzCol[Col], + Matrix->MarkowitzRow[Col] ); + if ((Matrix->MarkowitzRow[Col] != 0) AND + (Matrix->MarkowitzCol[Col] == 1)) + { + Matrix->Singletons--; + } + } + else + { pCreatedElement = spcGetElement( Matrix ); + Matrix->NeedsOrdering = YES; + } + if (pCreatedElement == NULL) return NULL; + Matrix->Elements++; + +/* Initialize Element. */ + pCreatedElement->Row = Row; + pCreatedElement->Col = Col; + pCreatedElement->Real = 0.0; +#if spCOMPLEX + pCreatedElement->Imag = 0.0; +#endif +#if INITIALIZE + pCreatedElement->pInitInfo = NULL; +#endif + +/* If element is on diagonal, store pointer in Diag. */ + if (Row == Col) Matrix->Diag[Row] = pCreatedElement; + +/* Splice element into column. */ + pCreatedElement->NextInCol = *ppAbove; + *ppAbove = pCreatedElement; + +/* Find Element immediately to the left of the fill-in. */ + if (Matrix->RowsLinked) + { pElement = *ppToLeft; + while (pElement != NULL) + { if (pElement->Col < Col) + { ppToLeft = &pElement->NextInRow; + pElement = *ppToLeft; + } + else break; /* while loop */ + } + +/* Splice element into row. */ + pCreatedElement->NextInRow = *ppToLeft; + *ppToLeft = pCreatedElement; + } + return pCreatedElement; +} + + + + + + + + +/* + * + * LINK ROWS + * + * This routine is used to generate the row links. The spGetElement() + * routines do not create row links, which are needed by the spFactor() + * routines. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * + * >>> Local variables: + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * FirstInRowEntry (ElementPtr *) + * A pointer into the FirstInRow array. Points to the FirstInRow entry + * currently being operated upon. + * FirstInRowArray (ArrayOfElementPtrs) + * A pointer to the FirstInRow array. Same as Matrix->FirstInRow but + * resides in a register and requires less indirection so is faster to + * use. + * Col (int) + * Column currently being operated upon. + */ + +void +spcLinkRows( MatrixPtr Matrix ) +{ +register ElementPtr pElement, *FirstInRowEntry; +register ArrayOfElementPtrs FirstInRowArray; +register int Col; + +/* Begin `spcLinkRows'. */ + FirstInRowArray = Matrix->FirstInRow; + for (Col = Matrix->Size; Col >= 1; Col--) + FirstInRowArray[Col] = NULL; + + for (Col = Matrix->Size; Col >= 1; Col--) + { +/* Generate row links for the elements in the Col'th column. */ + pElement = Matrix->FirstInCol[Col]; + + while (pElement != NULL) + { pElement->Col = Col; + FirstInRowEntry = &FirstInRowArray[pElement->Row]; + pElement->NextInRow = *FirstInRowEntry; + *FirstInRowEntry = pElement; + pElement = pElement->NextInCol; + } + } + Matrix->RowsLinked = YES; + return; +} + + + + + + + + +/* + * ENLARGE MATRIX + * + * Increases the size of the matrix. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * NewSize <input> (int) + * The new size of the matrix. + * + * >>> Local variables: + * OldAllocatedSize (int) + * The allocated size of the matrix before it is expanded. + */ + +static void +EnlargeMatrix( + MatrixPtr Matrix, + register int NewSize +) +{ +register int I, OldAllocatedSize = Matrix->AllocatedSize; + +/* Begin `EnlargeMatrix'. */ + Matrix->Size = NewSize; + + if (NewSize <= OldAllocatedSize) + return; + +/* Expand the matrix frame. */ + NewSize = MAX( NewSize, (int)(EXPANSION_FACTOR * OldAllocatedSize) ); + Matrix->AllocatedSize = NewSize; + + if (( REALLOC(Matrix->IntToExtColMap, int, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + if (( REALLOC(Matrix->IntToExtRowMap, int, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + if (( REALLOC(Matrix->Diag, ElementPtr, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + if (( REALLOC(Matrix->FirstInCol, ElementPtr, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + if (( REALLOC(Matrix->FirstInRow, ElementPtr, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + +/* + * Destroy the Markowitz and Intermediate vectors, they will be recreated + * in spOrderAndFactor(). + */ + FREE( Matrix->MarkowitzRow ); + FREE( Matrix->MarkowitzCol ); + FREE( Matrix->MarkowitzProd ); + FREE( Matrix->DoRealDirect ); + FREE( Matrix->DoCmplxDirect ); + FREE( Matrix->Intermediate ); + Matrix->InternalVectorsAllocated = NO; + +/* Initialize the new portion of the vectors. */ + for (I = OldAllocatedSize+1; I <= NewSize; I++) + { Matrix->IntToExtColMap[I] = I; + Matrix->IntToExtRowMap[I] = I; + Matrix->Diag[I] = NULL; + Matrix->FirstInRow[I] = NULL; + Matrix->FirstInCol[I] = NULL; + } + + return; +} + + + + + + + + +#if TRANSLATE + +/* + * EXPAND TRANSLATION ARRAYS + * + * Increases the size arrays that are used to translate external to internal + * row and column numbers. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * NewSize <input> (int) + * The new size of the translation arrays. + * + * >>> Local variables: + * OldAllocatedSize (int) + * The allocated size of the translation arrays before being expanded. + */ + +static void +ExpandTranslationArrays( + MatrixPtr Matrix, + register int NewSize +) +{ +register int I, OldAllocatedSize = Matrix->AllocatedExtSize; + +/* Begin `ExpandTranslationArrays'. */ + Matrix->ExtSize = NewSize; + + if (NewSize <= OldAllocatedSize) + return; + +/* Expand the translation arrays ExtToIntRowMap and ExtToIntColMap. */ + NewSize = MAX( NewSize, (int)(EXPANSION_FACTOR * OldAllocatedSize) ); + Matrix->AllocatedExtSize = NewSize; + + if (( REALLOC(Matrix->ExtToIntRowMap, int, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + if (( REALLOC(Matrix->ExtToIntColMap, int, NewSize+1)) == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + +/* Initialize the new portion of the vectors. */ + for (I = OldAllocatedSize+1; I <= NewSize; I++) + { Matrix->ExtToIntRowMap[I] = -1; + Matrix->ExtToIntColMap[I] = -1; + } + + return; +} +#endif + + + + + + + + + +#if INITIALIZE +/*! + * Initialize the matrix. + * + * With the \a INITIALIZE compiler option (see spConfig.h) set true, + * Sparse allows the user to keep initialization information with each + * structurally nonzero matrix element. Each element has a pointer + * that is set and used by the user. The user can set this pointer + * using spInstallInitInfo() and may be read using spGetInitInfo(). Both + * may be used only after the element exists. The function + * spInitialize() is a user customizable way to initialize the matrix. + * Passed to this routine is a function pointer. spInitialize() sweeps + * through every element in the matrix and checks the \a pInitInfo + * pointer (the user supplied pointer). If the \a pInitInfo is \a NULL, + * which is true unless the user changes it (almost always true for + * fill-ins), then the element is zeroed. Otherwise, the function + * pointer is called and passed the \a pInitInfo pointer as well as the + * element pointer and the external row and column numbers. If the + * user sets the value of each element, then spInitialize() replaces + * spClear(). + * + * The user function is expected to return a nonzero integer if there + * is a fatal error and zero otherwise. Upon encountering a nonzero + * return code, spInitialize() terminates, sets the error state of + * the matrix to be \a spMANGLED, and returns the error code. + * + * \return + * Returns the return value of the \a pInit() function. + * \param eMatrix + * Pointer to matrix. + * \param pInit + * Pointer to a function that initializes an element. + + * \see spClear() + */ + +int +spInitialize( + spMatrix eMatrix, + int (*pInit)( + spElement *pElement, + spGenericPtr pInitInfo, + int Row, + int Col + ) +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +int J, Error, Col; + +/* Begin `spInitialize'. */ + ASSERT_IS_SPARSE( Matrix ); + +#if spCOMPLEX +/* Clear imaginary part of matrix if matrix is real but was complex. */ + if (Matrix->PreviousMatrixWasComplex AND NOT Matrix->Complex) + { for (J = Matrix->Size; J > 0; J--) + { pElement = Matrix->FirstInCol[J]; + while (pElement != NULL) + { pElement->Imag = 0.0; + pElement = pElement->NextInCol; + } + } + } +#endif /* spCOMPLEX */ + +/* Initialize the matrix. */ + for (J = Matrix->Size; J > 0; J--) + { pElement = Matrix->FirstInCol[J]; + Col = Matrix->IntToExtColMap[J]; + while (pElement != NULL) + { if (pElement->pInitInfo == NULL) + { pElement->Real = 0.0; +# if spCOMPLEX + pElement->Imag = 0.0; +# endif + } + else + { Error = (*pInit)((RealNumber *)pElement, pElement->pInitInfo, + Matrix->IntToExtRowMap[pElement->Row], Col); + if (Error) + { Matrix->Error = spMANGLED; + return Error; + } + + } + pElement = pElement->NextInCol; + } + } + +/* Empty the trash. */ + Matrix->TrashCan.Real = 0.0; +#if spCOMPLEX + Matrix->TrashCan.Imag = 0.0; +#endif + + Matrix->Error = spOKAY; + Matrix->Factored = NO; + Matrix->SingularCol = 0; + Matrix->SingularRow = 0; + Matrix->PreviousMatrixWasComplex = Matrix->Complex; + return 0; +} + + + + +/*! + * This function installs a pointer to a data structure that is used + * to contain initialization information to a matrix element. It is + * is then used by spInitialize() to initialize the matrix. + * + * \param pElement + * Pointer to matrix element. + * \param pInitInfo + * Pointer to the data structure that will contain initialiation + * information. + * \see spInitialize() + */ + +void +spInstallInitInfo( + spElement *pElement, + spGenericPtr pInitInfo +) +{ +/* Begin `spInstallInitInfo'. */ + vASSERT( pElement != NULL, "Invalid element pointer" ); + + ((ElementPtr)pElement)->pInitInfo = pInitInfo; +} + + +/*! + * This function returns a pointer to a data structure that is used + * to contain initialization information to a matrix element. + * + * \return + * The pointer to the initialiation information data structure + * that is associated with a particular matrix element. + * + * \param pElement + * Pointer to the matrix element. + * + * \see spInitialize() + */ +spGenericPtr +spGetInitInfo( + spElement *pElement +) +{ +/* Begin `spGetInitInfo'. */ + vASSERT( pElement != NULL, "Invalid element pointer" ); + + return (spGenericPtr)((ElementPtr)pElement)->pInitInfo; +} +#endif /* INITIALIZE */ Added: trunk/math/SPARSE/spconfig.h =================================================================== --- trunk/math/SPARSE/spconfig.h (rev 0) +++ trunk/math/SPARSE/spconfig.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,568 @@ +/* CONFIGURATION MACRO DEFINITIONS for sparse matrix routines */ +/*! + * \file + * + * This file contains macros for the sparse matrix routines that are used + * to define the personality of the routines. The user is expected to + * modify this file to maximize the performance of the routines with + * his/her matrices. + * + * Macros are distinguished by using solely capital letters in their + * identifiers. This contrasts with C defined identifiers which are + * strictly lower case, and program variable and procedure names which use + * both upper and lower case. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ + + +/* + * Revision and copyright information. + * + * Copyright (c) 1985-2003 by Kenneth S. Kundert + * + * $Date: 2003/06/30 19:41:29 $ + * $Revision: 1.5 $ + */ + + +#ifndef spCONFIG_DEFS +#define spCONFIG_DEFS + + + + +#ifdef spINSIDE_SPARSE +/* + * OPTIONS + * + * These are compiler options. Set each option to one to compile that + * section of the code. If a feature is not desired, set the macro + * to NO. + */ + +/* Begin options. */ + +/* Arithmetic Precision + * + * The precision of the arithmetic used by Sparse can be set by + * changing changing the spREAL macro. This macro is + * contained in the file spMatrix.h. It is strongly suggested to + * used double precision with circuit simulators. Note that + * because C always performs arithmetic operations in double + * precision, the only benefit to using single precision is that + * less storage is required. There is often a noticeable speed + * penalty when using single precision. Sparse internally refers + * to a spREAL as a RealNumber. + */ + +/*! + * This specifies that the routines are expected to handle real + * systems of equations. The routines can be compiled to handle + * both real and complex systems at the same time, but there is a + * slight speed and memory advantage if the routines are complied + * to handle only real systems of equations. + */ +#define REAL YES + +/*! + * Setting this compiler flag true (1) makes the matrix + * expandable before it has been factored. If the matrix is + * expandable, then if an element is added that would be + * considered out of bounds in the current matrix, the size of + * the matrix is increased to hold that element. As a result, + * the size of the matrix need not be known before the matrix is + * built. The matrix can be allocated with size zero and expanded. + */ +#define EXPANDABLE YES + +/*! + * This option allows the set of external row and column numbers + * to be non-packed. In other words, the row and column numbers + * do not have to be contiguous. The priced paid for this + * flexibility is that when \a TRANSLATE is set true, the time + * required to initially build the matrix will be greater because + * the external row and column number must be translated into + * internal equivalents. This translation brings about other + * benefits though. First, the spGetElement() and + * spGetAdmittance() routines may be used after the matrix has + * been factored. Further, elements, and even rows and columns, + * may be added to the matrix, and row and columns may be deleted + * from the matrix, after it has been factored. Note that when + * the set of row and column number is not a packed set, neither + * are the \a RHS and \a Solution vectors. Thus the size of these + * vectors must be at least as large as the external size, which + * is the value of the largest given row or column numbers. + */ +#define TRANSLATE YES + +/*! + * Causes the spInitialize(), spGetInitInfo(), and + * spInstallInitInfo() routines to be compiled. These routines + * allow the user to store and read one pointer in each nonzero + * element in the matrix. spInitialize() then calls a user + * specified function for each structural nonzero in the matrix, + * and includes this pointer as well as the external row and + * column numbers as arguments. This allows the user to write + * custom matrix initialization routines. + */ +#define INITIALIZE YES + +/*! + * Many matrices, and in particular node- and modified-node + * admittance matrices, tend to be nearly symmetric and nearly + * diagonally dominant. For these matrices, it is a good idea to + * select pivots from the diagonal. With this option enabled, + * this is exactly what happens, though if no satisfactory pivot + * can be found on the diagonal, an off-diagonal pivot will be + * used. If this option is disabled, Sparse does not + * preferentially search the diagonal. Because of this, Sparse + * has a wider variety of pivot candidates available, and so + * presumably fewer fill-ins will be created. However, the + * initial pivot selection process will take considerably longer. + * If working with node admittance matrices, or other matrices + * with a strong diagonal, it is probably best to use + * \a DIAGONAL_PIVOTING for two reasons. First, accuracy will be + * better because pivots will be chosen from the large diagonal + * elements, thus reducing the chance of growth. Second, a near + * optimal ordering will be chosen quickly. If the class of + * matrices you are working with does not have a strong diagonal, + * do not use \a DIAGONAL_PIVOTING, but consider using a larger + * threshold. When \a DIAGONAL_PIVOTING is turned off, the following + * options and constants are not used: \a MODIFIED_MARKOWITZ, + * \a MAX_MARKOWITZ_TIES, and \a TIES_MULTIPLIER. + */ +#define DIAGONAL_PIVOTING YES + +/*! + * This determines whether arrays start at an index of zero or one. + * This option is necessitated by the fact that standard C + * convention dictates that arrays begin with an index of zero but + * the standard mathematic convention states that arrays begin with + * an index of one. So if you prefer to start your arrays with + * zero, or your calling Sparse from FORTRAN, set ARRAY_OFFSET to + * NO or 0. Otherwise, set ARRAY_OFFSET to YES or 1. Note that if + * you use an offset of one, the arrays that you pass to Sparse + * must have an allocated length of one plus the size of the + * matrix. ARRAY_OFFSET must be either 0 or 1, no other offsets + * are valid. + */ +#define ARRAY_OFFSET NOT FORTRAN + +/*! + * This specifies that the modified Markowitz method of pivot + * selection is to be used. The modified Markowitz method differs + * from standard Markowitz in two ways. First, under modified + * Markowitz, the search for a pivot can be terminated early if a + * adequate (in terms of sparsity) pivot candidate is found. + * Thus, when using modified Markowitz, the initial factorization + * can be faster, but at the expense of a suboptimal pivoting + * order that may slow subsequent factorizations. The second + * difference is in the way modified Markowitz breaks Markowitz + * ties. When two or more elements are pivot candidates and they + * all have the same Markowitz product, then the tie is broken by + * choosing the element that is best numerically. The numerically + * best element is the one with the largest ratio of its magnitude + * to the magnitude of the largest element in the same column, + * excluding itself. The modified Markowitz method results in + * marginally better accuracy. This option is most appropriate + * for use when working with very large matrices where the initial + * factor time represents an unacceptable burden. \a NO is recommended. + */ +#define MODIFIED_MARKOWITZ NO + +/*! + * This specifies that the spDeleteRowAndCol() routine + * should be compiled. Note that for this routine to be + * compiled, both \a DELETE and \a TRANSLATE should be set true. + */ +#define DELETE YES + +/*! + * This specifies that the spStripFills() routine should be compiled. + */ +#define STRIP YES + +/*! + * This specifies that the routine that preorders modified node + * admittance matrices should be compiled. This routine results + * in greater speed and accuracy if used with this type of + * matrix. + */ +#define MODIFIED_NODAL YES + +/*! + * This specifies that the routines that allow four related + * elements to be entered into the matrix at once should be + * compiled. These elements are usually related to an + * admittance. The routines affected by \a QUAD_ELEMENT are the + * spGetAdmittance(), spGetQuad() and spGetOnes() routines. + */ +#define QUAD_ELEMENT YES + +/*! + * This specifies that the routines that solve the matrix as if + * it was transposed should be compiled. These routines are + * useful when performing sensitivity analysis using the adjoint + * method. + */ +#define TRANSPOSE YES + +/*! + * This specifies that the routine that performs scaling on the + * matrix should be complied. Scaling is not strongly + * supported. The routine to scale the matrix is provided, but + * no routines are provided to scale and descale the RHS and + * Solution vectors. It is suggested that if scaling is desired, + * it only be preformed when the pivot order is being chosen [in + * spOrderAndFactor()]. This is the only time scaling has + * an effect. The scaling may then either be removed from the + * solution by the user or the scaled factors may simply be + * thrown away. \a NO is recommended. + */ +#define SCALING YES + +/*! + * This specifies that routines that are used to document the + * matrix, such as spPrint() and spFileMatrix(), should be + * compiled. + */ +#define DOCUMENTATION YES + +/*! + * This specifies that routines that are used to multily the + * matrix by a vector, such as spMultiply() and spMultTransposed(), should be + * compiled. + */ +#define MULTIPLICATION YES + +/*! + * This specifies that the routine spDeterminant() should be complied. + */ +#define DETERMINANT YES + +/*! + * This specifies that spLargestElement() and spRoundoff() should + * be compiled. These routines are used to check the stability (and + * hence the quality of the pivoting) of the factorization by + * computing a bound on the size of the element is the matrix + * \f$ E = A - LU \f$. If this bound is very high after applying + * spOrderAndFactor(), then the pivot threshold should be raised. + * If the bound increases greatly after using spFactor(), then the + * matrix should probably be reordered. Recomend \a NO. + */ +#define STABILITY YES + +/*! + * This specifies that spCondition() and spNorm(), the code that + * computes a good estimate of the condition number of the matrix, + * should be compiled. Recomend \a NO. + */ +#define CONDITION YES + +/*! + * This specifies that spPseudoCondition(), the code that computes + * a crude and easily fooled indicator of ill-conditioning in the + * matrix, should be compiled. Recomend \a NO. + */ +#define PSEUDOCONDITION YES + +/*! + * This specifies that the \a FORTRAN interface routines should be + * compiled. When interfacing to \a FORTRAN programs, the \a ARRAY_OFFSET + * options should be set to NO. + */ +#define FORTRAN NO + +/*! + * This specifies that additional error checking will be compiled. + * The type of error checked are those that are common when the + * matrix routines are first integrated into a user's program. Once + * the routines have been integrated in and are running smoothly, this + * option should be turned off. \a YES is recommended. + */ +#define spDEBUG YES + +#endif /* spINSIDE_SPARSE */ + +/* + * The following options affect Sparse exports and so are exported as a + * side effect. For this reason they use the `sp' prefix. The boolean + * constants YES an NO are not defined in spMatrix.h to avoid conflicts + * with user code, so use 0 for NO and 1 for YES. + */ + +/*! + * This specifies that the routines will be complied to handle + * complex systems of equations. + */ +#define spCOMPLEX 1 + +/*! + * This specifies the format for complex vectors. If this is set + * false then a complex vector is made up of one double sized + * array of RealNumber's in which the real and imaginary numbers + * are placed alternately in the array. In other + * words, the first entry would be Complex[1].Real, then comes + * Complex[1].Imag, then Complex[2].Real, etc. If + * \a spSEPARATED_COMPLEX_VECTORS is set true, then each complex + * vector is represented by two arrays of \a spREALs, one with + * the real terms, the other with the imaginary. \a NO is recommended. + */ +#define spSEPARATED_COMPLEX_VECTORS 0 + +#ifdef spINSIDE_SPARSE + + + + + + + +/* + * MATRIX CONSTANTS + * + * These constants are used throughout the sparse matrix routines. They + * should be set to suit the type of matrix being solved. + */ + +/* Begin constants. */ + +/*! + * The relative threshold used if the user enters an invalid + * threshold. Also the threshold used by spFactor() when + * calling spOrderAndFactor(). The default threshold should + * not be less than or equal to zero nor larger than one. + * 0.001 is recommended. + */ +#define DEFAULT_THRESHOLD 1.0e-3 + +/*! + * This indicates whether spOrderAndFactor() should use diagonal + * pivoting as default. This issue only arises when + * spOrderAndFactor() is called from spFactor(). \a YES is recommended. + */ +#define DIAG_PIVOTING_AS_DEFAULT YES + +/*! + * This number multiplied by the size of the matrix equals the number + * of elements for which memory is initially allocated in spCreate(). + * 6 is recommended. + */ +#define SPACE_FOR_ELEMENTS 6 + +/*! + * This number multiplied by the size of the matrix equals the number + * of elements for which memory is initially allocated and specifically + * reserved for fill-ins in spCreate(). 4 is recommended. + */ +#define SPACE_FOR_FILL_INS 4 + +/*! + * The number of matrix elements requested from the malloc utility on + * each call to it. Setting this value greater than 1 reduces the + * amount of overhead spent in this system call. On a virtual memory + * machine, its good to allocate slightly less than a page worth of + * elements at a time (or some multiple thereof). + * 31 is recommended. + */ +#define ELEMENTS_PER_ALLOCATION 31 + +/*! + * The minimum allocated size of a matrix. Note that this does not + * limit the minimum size of a matrix. This just prevents having to + * resize a matrix many times if the matrix is expandable, large and + * allocated with an estimated size of zero. This number should not + * be less than one. + */ +#define MINIMUM_ALLOCATED_SIZE 6 + +/*! + * The amount the allocated size of the matrix is increased when it + * is expanded. + */ +#define EXPANSION_FACTOR 1.5 + +/*! + * Some terminology should be defined. The Markowitz row count is the number + * of non-zero elements in a row excluding the one being considered as pivot. + * There is one Markowitz row count for every row. The Markowitz column + * is defined similarly for columns. The Markowitz product for an element + * is the product of its row and column counts. It is a measure of how much + * work would be required on the next step of the factorization if that + * element were chosen to be pivot. A small Markowitz product is desirable. + * + * This number is used for two slightly different things, both of which + * relate to the search for the best pivot. First, it is the maximum + * number of elements that are Markowitz tied that will be sifted + * through when trying to find the one that is numerically the best. + * Second, it creates an upper bound on how large a Markowitz product + * can be before it eliminates the possibility of early termination + * of the pivot search. In other words, if the product of the smallest + * Markowitz product yet found and \a TIES_MULTIPLIER is greater than + * \a MAX_MARKOWITZ_TIES, then no early termination takes place. + * Set \a MAX_MARKOWITZ_TIES to some small value if no early termination of + * the pivot search is desired. An array of RealNumbers is allocated + * of size \a MAX_MARKOWITZ_TIES so it must be positive and shouldn't + * be too large. Active when MODIFIED_MARKOWITZ is 1 (YES). + * 100 is recommended. + * \see TIES_MULTIPLIER + */ +#define MAX_MARKOWITZ_TIES 100 + +/*! + * Specifies the number of Markowitz ties that are allowed to occur + * before the search for the pivot is terminated early. Set to some + * large value if no early termination of the pivot search is desired. + * This number is multiplied times the Markowitz product to determine + * how many ties are required for early termination. This means that + * more elements will be searched before early termination if a large + * number of fill-ins could be created by accepting what is currently + * considered the best choice for the pivot. Active when + * \a MODIFIED_MARKOWITZ is 1 (YES). Setting this number to zero + * effectively eliminates all pivoting, which should be avoided. + * This number must be positive. \a TIES_MULTIPLIER is also used when + * diagonal pivoting breaks down. 5 is recommended. + * \see MAX_MARKOWITZ_TIES + */ +#define TIES_MULTIPLIER 5 + +/*! + * Which partition mode is used by spPartition() as default. + * Possibilities include \a spDIRECT_PARTITION (each row used direct + * addressing, best for a few relatively dense matrices), + * \a spINDIRECT_PARTITION (each row used indirect addressing, best + * for a few very sparse matrices), and \a spAUTO_PARTITION (direct or + * indirect addressing is chosen on a row-by-row basis, carries a large + * overhead, but speeds up both dense and sparse matrices, best if there + * is a large number of matrices that can use the same ordering. + */ +#define DEFAULT_PARTITION spAUTO_PARTITION + +/*! + * The number of characters per page width. Set to 80 for terminal, + * 132 for line printer. Controls how many columns printed by + * spPrint() per page width. + */ +#define PRINTER_WIDTH 80 + + + + + + + + + + +#endif /* spINSIDE_SPARSE */ +/* + * PORTABILITY MACROS + */ + +#ifdef __STDC__ +# define spcCONCAT(prefix,suffix) prefix ## suffix +# define spcQUOTE(x) # x +# define spcFUNC_NEEDS_FILE(func,file) \ + func ## _requires_ ## file ## _to_be_included_ +#else +# define spcCONCAT(prefix,suffix) prefix/**/suffix +# define spcQUOTE(x) "x" +# define spcFUNC_NEEDS_FILE(func,file) \ + func/**/_requires_/**/file/**/_to_be_included_ +#endif + +#if defined(__cplusplus) || defined(c_plusplus) + /* + * Definitions for C++ + */ +# define spcEXTERN extern "C" +# define spcNO_ARGS +# define spcCONST const + typedef void *spGenericPtr; +#else +#ifdef __STDC__ + /* + * Definitions for ANSI C + */ +# define spcEXTERN extern +# define spcNO_ARGS void +# define spcCONST const + typedef void *spGenericPtr; +# else + /* + * Definitions for K&R C -- ignore function prototypes + */ +# define spcEXTERN extern +# define spcNO_ARGS +# define spcCONST + typedef char *spGenericPtr; +#endif +#endif + +#ifdef spINSIDE_SPARSE + + + + + + + +/* + * MACHINE CONSTANTS + * + * These numbers must be updated when the program is ported to a new machine. + */ + +/*! The resolution of spREAL. */ +#define MACHINE_RESOLUTION AG_DBL_EPSILON + +/*! The largest possible value of spREAL. */ +#define LARGEST_REAL AG_DBL_MAX + +/*! The smalles possible positive value of spREAL. */ +#define SMALLEST_REAL AG_DBL_MIN + +/*! The largest possible value of shorts. */ +#define LARGEST_SHORT_INTEGER (0xffff-1) + +/*! The largest possible value of longs. */ +#define LARGEST_LONG_INTEGER AG_LONG_MAX + + + + + + +/* ANNOTATION */ +/*! + * This macro changes the amount of annotation produced by the matrix + * routines. The annotation is used as a debugging aid. Change the number + * associated with \a ANNOTATE to change the amount of annotation produced by + * the program. Possible values include \a NONE, \a ON_STRANGE_BEHAVIOR, and + * \a FULL. \a NONE is recommended. + */ +#define ANNOTATE NONE + +/*! + * A possible value for \a ANNOTATE. Disables all annotation. + */ +#define NONE 0 + +/*! + * A possible value for \a ANNOTATE. Causes annotation to be produce + * upon unusual occurances only. + */ +#define ON_STRANGE_BEHAVIOR 1 + +/*! + * A possible value for \a ANNOTATE. Enables full annotation. + */ +#define FULL 2 + +#endif /* spINSIDE_SPARSE */ +#endif /* spCONFIG_DEFS */ Added: trunk/math/SPARSE/spdefs.h =================================================================== --- trunk/math/SPARSE/spdefs.h (rev 0) +++ trunk/math/SPARSE/spdefs.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,945 @@ +/* + * DATA STRUCTURE AND MACRO DEFINITIONS for Sparse. + * + * Author: Advising professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + * + * This file contains common type definitions and macros for the sparse + * matrix routines. These definitions are of no interest to the user. + */ + + +/* + * Revision and copyright information. + * + * Copyright (c) 1985-2003 by Kenneth S. Kundert + * + * $Date: 2003/06/29 04:19:52 $ + * $Revision: 1.2 $ + */ + + + + +/* + * If running lint, change some of the compiler options to get a more + * complete inspection. + */ + +#ifdef lint +#undef REAL +#undef spCOMPLEX +#undef EXPANDABLE +#undef TRANSLATE +#undef INITIALIZE +#undef DELETE +#undef STRIP +#undef MODIFIED_NODAL +#undef QUAD_ELEMENT +#undef TRANSPOSE +#undef SCALING +#undef DOCUMENTATION +#undef MULTIPLICATION +#undef DETERMINANT +#undef CONDITION +#undef PSEUDOCONDITION +#undef FORTRAN +#undef spDEBUG + +#define REAL YES +#define spCOMPLEX YES +#define EXPANDABLE YES +#define TRANSLATE YES +#define INITIALIZE YES +#define DELETE YES +#define STRIP YES +#define MODIFIED_NODAL YES +#define QUAD_ELEMENT YES +#define TRANSPOSE YES +#define SCALING YES +#define DOCUMENTATION YES +#define MULTIPLICATION YES +#define DETERMINANT YES +#define CONDITION YES +#define PSEUDOCONDITION YES +#define FORTRAN YES +#define spDEBUG YES + +#define LINT YES +#else /* not lint */ +#define LINT NO +#endif /* not lint */ + + + + + + + +/* + * MACRO DEFINITIONS + * + * Macros are distinguished by using solely capital letters in their + * identifiers. This contrasts with C defined identifiers which are strictly + * lower case, and program variable and procedure names which use both upper + * and lower case. + */ + +/* Begin macros. */ + +/* Boolean data type */ +#define BOOLEAN int +#define NO 0 +#define YES 1 +#define NOT ! +#define AND && +#define OR || + +/* NULL pointer */ +#ifndef NULL +#define NULL 0 +#endif + +/* Define macros for validating matrix. */ +#define SPARSE_ID 0xDeadBeef /* Arbitrary. */ +#define IS_SPARSE(matrix) (((matrix) != NULL) AND \ + ((matrix)->ID == SPARSE_ID)) +#define NO_ERRORS(matrix) (((matrix)->Error >= spOKAY) AND \ + ((matrix)->Error < spFATAL)) +#define IS_FACTORED(matrix) ((matrix)->Factored AND \ + NOT (matrix)->NeedsOrdering) + +#define ASSERT_IS_SPARSE(matrix) vASSERT( IS_SPARSE(matrix), \ + spcMatrixIsNotValid ) +#define ASSERT_NO_ERRORS(matrix) vASSERT( NO_ERRORS(matrix), \ + spcErrorsMustBeCleared ) +#define ASSERT_IS_FACTORED(matrix) vASSERT( IS_FACTORED(matrix), \ + spcMatrixMustBeFactored ) +#define ASSERT_IS_NOT_FACTORED(matrix) vASSERT( NOT (matrix)->Factored, \ + spcMatrixMustNotBeFactored ) + +/* Macro commands */ +/* Macro functions that return the maximum or minimum independent of type. */ +#if 0 +#define MAX(a,b) ((a) > (b) ? (a) : (b)) +#define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif +/* Macro function that returns the absolute value of a floating point number. */ +#define ABS(a) ((a) < 0 ? -(a) : (a)) + +/* Macro function that returns the square of a number. */ +#define SQR(a) ((a)*(a)) + +/* Macro procedure that swaps two entities. */ +#define SWAP(type, a, b) {type swapx; swapx = a; a = b; b = swapx;} + + +/* + * COMPLEX OPERATION MACROS + */ + +/* Macro function that returns the approx absolute value of a complex number. */ +#if spCOMPLEX +#define ELEMENT_MAG(ptr) (ABS((ptr)->Real) + ABS((ptr)->Imag)) +#else +#define ELEMENT_MAG(ptr) ((ptr)->Real < 0.0 ? -(ptr)->Real : (ptr)->Real) +#endif + +/* Complex assignment statements. */ +#define CMPLX_ASSIGN(to,from) \ +{ (to).Real = (from).Real; \ + (to).Imag = (from).Imag; \ +} +#define CMPLX_CONJ_ASSIGN(to,from) \ +{ (to).Real = (from).Real; \ + (to).Imag = -(from).Imag; \ +} +#define CMPLX_NEGATE_ASSIGN(to,from) \ +{ (to).Real = -(from).Real; \ + (to).Imag = -(from).Imag; \ +} +#define CMPLX_CONJ_NEGATE_ASSIGN(to,from) \ +{ (to).Real = -(from).Real; \ + (to).Imag = (from).Imag; \ +} +#define CMPLX_CONJ(a) (a).Imag = -(a).Imag +#define CMPLX_NEGATE(a) \ +{ (a).Real = -(a).Real; \ + (a).Imag = -(a).Imag; \ +} + +/* Macro that returns the approx magnitude (L-1 norm) of a complex number. */ +#define CMPLX_1_NORM(a) (ABS((a).Real) + ABS((a).Imag)) + +/* Macro that returns the approx magnitude (L-infinity norm) of a complex. */ +#define CMPLX_INF_NORM(a) (MAX (ABS((a).Real),ABS((a).Imag))) + +/* Macro function that returns the magnitude (L-2 norm) of a complex number. */ +#define CMPLX_2_NORM(a) (sqrt((a).Real*(a).Real + (a).Imag*(a).Imag)) + +/* Macro function that performs complex addition. */ +#define CMPLX_ADD(to,from_a,from_b) \ +{ (to).Real = (from_a).Real + (from_b).Real; \ + (to).Imag = (from_a).Imag + (from_b).Imag; \ +} + +/* Macro function that performs complex subtraction. */ +#define CMPLX_SUBT(to,from_a,from_b) \ +{ (to).Real = (from_a).Real - (from_b).Real; \ + (to).Imag = (from_a).Imag - (from_b).Imag; \ +} + +/* Macro function that is equivalent to += operator for complex numbers. */ +#define CMPLX_ADD_ASSIGN(to,from) \ +{ (to).Real += (from).Real; \ + (to).Imag += (from).Imag; \ +} + +/* Macro function that is equivalent to -= operator for complex numbers. */ +#define CMPLX_SUBT_ASSIGN(to,from) \ +{ (to).Real -= (from).Real; \ + (to).Imag -= (from).Imag; \ +} + +/* Macro function that multiplies a complex number by a scalar. */ +#define SCLR_MULT(to,sclr,cmplx) \ +{ (to).Real = (sclr) * (cmplx).Real; \ + (to).Imag = (sclr) * (cmplx).Imag; \ +} + +/* Macro function that multiply-assigns a complex number by a scalar. */ +#define SCLR_MULT_ASSIGN(to,sclr) \ +{ (to).Real *= (sclr); \ + (to).Imag *= (sclr); \ +} + +/* Macro function that multiplies two complex numbers. */ +#define CMPLX_MULT(to,from_a,from_b) \ +{ (to).Real = (from_a).Real * (from_b).Real - \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag = (from_a).Real * (from_b).Imag + \ + (from_a).Imag * (from_b).Real; \ +} + +/* Macro function that implements to *= from for complex numbers. */ +#define CMPLX_MULT_ASSIGN(to,from) \ +{ RealNumber to_real_ = (to).Real; \ + (to).Real = to_real_ * (from).Real - \ + (to).Imag * (from).Imag; \ + (to).Imag = to_real_ * (from).Imag + \ + (to).Imag * (from).Real; \ +} + +/* Macro function that multiplies two complex numbers, the first of which is + * conjugated. */ +#define CMPLX_CONJ_MULT(to,from_a,from_b) \ +{ (to).Real = (from_a).Real * (from_b).Real + \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag = (from_a).Real * (from_b).Imag - \ + (from_a).Imag * (from_b).Real; \ +} + +/* Macro function that multiplies two complex numbers and then adds them + * to another. to = add + mult_a * mult_b */ +#define CMPLX_MULT_ADD(to,mult_a,mult_b,add) \ +{ (to).Real = (mult_a).Real * (mult_b).Real - \ + (mult_a).Imag * (mult_b).Imag + (add).Real; \ + (to).Imag = (mult_a).Real * (mult_b).Imag + \ + (mult_a).Imag * (mult_b).Real + (add).Imag; \ +} + +/* Macro function that subtracts the product of two complex numbers from + * another. to = subt - mult_a * mult_b */ +#define CMPLX_MULT_SUBT(to,mult_a,mult_b,subt) \ +{ (to).Real = (subt).Real - (mult_a).Real * (mult_b).Real + \ + (mult_a).Imag * (mult_b).Imag; \ + (to).Imag = (subt).Imag - (mult_a).Real * (mult_b).Imag - \ + (mult_a).Imag * (mult_b).Real; \ +} + +/* Macro function that multiplies two complex numbers and then adds them + * to another. to = add + mult_a* * mult_b where mult_a* represents mult_a + * conjugate. */ +#define CMPLX_CONJ_MULT_ADD(to,mult_a,mult_b,add) \ +{ (to).Real = (mult_a).Real * (mult_b).Real + \ + (mult_a).Imag * (mult_b).Imag + (add).Real; \ + (to).Imag = (mult_a).Real * (mult_b).Imag - \ + (mult_a).Imag * (mult_b).Real + (add).Imag; \ +} + +/* Macro function that multiplies two complex numbers and then adds them + * to another. to += mult_a * mult_b */ +#define CMPLX_MULT_ADD_ASSIGN(to,from_a,from_b) \ +{ (to).Real += (from_a).Real * (from_b).Real - \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag += (from_a).Real * (from_b).Imag + \ + (from_a).Imag * (from_b).Real; \ +} + +/* Macro function that multiplies two complex numbers and then subtracts them + * from another. */ +#define CMPLX_MULT_SUBT_ASSIGN(to,from_a,from_b) \ +{ (to).Real -= (from_a).Real * (from_b).Real - \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag -= (from_a).Real * (from_b).Imag + \ + (from_a).Imag * (from_b).Real; \ +} + +/* Macro function that multiplies two complex numbers and then adds them + * to the destination. to += from_a* * from_b where from_a* represents from_a + * conjugate. */ +#define CMPLX_CONJ_MULT_ADD_ASSIGN(to,from_a,from_b) \ +{ (to).Real += (from_a).Real * (from_b).Real + \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag += (from_a).Real * (from_b).Imag - \ + (from_a).Imag * (from_b).Real; \ +} + +/* Macro function that multiplies two complex numbers and then subtracts them + * from the destination. to -= from_a* * from_b where from_a* represents from_a + * conjugate. */ +#define CMPLX_CONJ_MULT_SUBT_ASSIGN(to,from_a,from_b) \ +{ (to).Real -= (from_a).Real * (from_b).Real + \ + (from_a).Imag * (from_b).Imag; \ + (to).Imag -= (from_a).Real * (from_b).Imag - \ + (from_a).Imag * (from_b).Real; \ +} + +/* + * Macro functions that provide complex division. + */ + +/* Complex division: to = num / den */ +#define CMPLX_DIV(to,num,den) \ +{ RealNumber r_, s_; \ + if (((den).Real >= (den).Imag AND (den).Real > -(den).Imag) OR \ + ((den).Real < (den).Imag AND (den).Real <= -(den).Imag)) \ + { r_ = (den).Imag / (den).Real; \ + s_ = (den).Real + r_*(den).Imag; \ + (to).Real = ((num).Real + r_*(num).Imag)/s_; \ + (to).Imag = ((num).Imag - r_*(num).Real)/s_; \ + } \ + else \ + { r_ = (den).Real / (den).Imag; \ + s_ = (den).Imag + r_*(den).Real; \ + (to).Real = (r_*(num).Real + (num).Imag)/s_; \ + (to).Imag = (r_*(num).Imag - (num).Real)/s_; \ + } \ +} + +/* Complex division and assignment: num /= den */ +#define CMPLX_DIV_ASSIGN(num,den) \ +{ RealNumber r_, s_, t_; \ + if (((den).Real >= (den).Imag AND (den).Real > -(den).Imag) OR \ + ((den).Real < (den).Imag AND (den).Real <= -(den).Imag)) \ + { r_ = (den).Imag / (den).Real; \ + s_ = (den).Real + r_*(den).Imag; \ + t_ = ((num).Real + r_*(num).Imag)/s_; \ + (num).Imag = ((num).Imag - r_*(num).Real)/s_; \ + (num).Real = t_; \ + } \ + else \ + { r_ = (den).Real / (den).Imag; \ + s_ = (den).Imag + r_*(den).Real; \ + t_ = (r_*(num).Real + (num).Imag)/s_; \ + (num).Imag = (r_*(num).Imag - (num).Real)/s_; \ + (num).Real = t_; \ + } \ +} + +/* Complex reciprocation: to = 1.0 / den */ +#define CMPLX_RECIPROCAL(to,den) \ +{ RealNumber r_; \ + if (((den).Real >= (den).Imag AND (den).Real > -(den).Imag) OR \ + ((den).Real < (den).Imag AND (den).Real <= -(den).Imag)) \ + { r_ = (den).Imag / (den).Real; \ + (to).Imag = -r_*((to).Real = 1.0/((den).Real + r_*(den).Imag)); \ + } \ + else \ + { r_ = (den).Real / (den).Imag; \ + (to).Real = -r_*((to).Imag = -1.0/((den).Imag + r_*(den).Real));\ + } \ +} + + + + + + +/* + * ASSERT and ABORT + * + * Macro used to assert that if the code is working correctly, then + * a condition must be true. If not, then execution is terminated + * and an error message is issued stating that there is an internal + * error and giving the file and line number. These assertions are + * not evaluated unless the spDEBUG flag is true. + */ + +#if spDEBUG +#define ASSERT(condition) \ +{ if (NOT(condition)) \ + { (void)fflush(stdout); \ + (void)fprintf(stderr, "sparse: internal error detected in file `%s' at line %d.\n assertion `%s' failed.\n",\ + __FILE__, __LINE__, spcQUOTE(condition) ); \ + (void)fflush(stderr); \ + abort(); \ + } \ +} +#else +#define ASSERT(condition) +#endif + +#if spDEBUG +#define vASSERT(condition,message) \ +{ if (NOT(condition)) \ + vABORT(message); \ +} +#else +#define vASSERT(condition,message) +#endif + +#if spDEBUG +#define vABORT(message) \ +{ (void)fflush(stdout); \ + (void)fprintf(stderr, "sparse: internal error detected in file `%s' at line %d.\n %s.\n", __FILE__, __LINE__, message );\ + (void)fflush(stderr); \ + abort(); \ +} + +#define ABORT() \ +{ (void)fflush(stdout); \ + (void)fprintf(stderr, "sparse: internal error detected in file `%s' at line %d.\n", __FILE__, __LINE__ ); \ + (void)fflush(stderr); \ + abort(); \ +} +#else +#define vABORT(message) abort() +#define ABORT() abort() +#endif + + + + + + +/* + * IMAGINARY VECTORS + * + * The imaginary vectors iRHS and iSolution are only needed when the + * options spCOMPLEX and spSEPARATED_COMPLEX_VECTORS are set. The following + * macro makes it easy to include or exclude these vectors as needed. + */ + +#if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS +#define IMAG_VECTORS , iRHS, iSolution +#define IMAG_RHS , iRHS +#define IMAG_RHS_DECL , RealVector iRHS +#define IMAG_VECT_DECL , RealVector iRHS, RealVector iSolution +#else +#define IMAG_VECTORS +#define IMAG_RHS +#define IMAG_RHS_DECL +#define IMAG_VECT_DECL +#endif + + + + + + +/* + * MEMORY ALLOCATION + */ + +spcEXTERN void *malloc(size_t size); +spcEXTERN void *calloc(size_t nmemb, size_t size); +spcEXTERN void *realloc(void *ptr, size_t size); +spcEXTERN void free(void *ptr); +spcEXTERN void abort(void); + +#define ALLOC(type,number) ((type *)malloc((unsigned)(sizeof(type)*(number)))) +#define REALLOC(ptr,type,number) \ + ptr = (type *)realloc((char *)ptr,(unsigned)(sizeof(type)*(number))) +#define FREE(ptr) { if ((ptr) != NULL) free((char *)(ptr)); (ptr) = NULL; } + + +/* Calloc that properly handles allocating a cleared vector. */ +#define CALLOC(ptr,type,number) \ +{ int i; ptr = ALLOC(type, number); \ + if (ptr != (type *)NULL) \ + for(i=(number)-1;i>=0; i--) ptr[i] = (type) 0; \ +} + + + + + + + +/* + * Utility Functions + */ +/* + * Compute the product of two intergers while avoiding overflow. + * Used when computing Markowitz products. + */ + +#define spcMarkoProd(product, op1, op2) \ + if (( (op1) > LARGEST_SHORT_INTEGER AND (op2) != 0) OR \ + ( (op2) > LARGEST_SHORT_INTEGER AND (op1) != 0)) \ + { double fProduct = (double)(op1) * (double)(op2); \ + if (fProduct >= LARGEST_LONG_INTEGER) \ + (product) = LARGEST_LONG_INTEGER; \ + else \ + (product) = (long)fProduct; \ + } \ + else (product) = (op1)*(op2); + + + + + + +/* + * REAL NUMBER + */ + +/* Begin `RealNumber'. */ + +typedef spREAL RealNumber, *RealVector; + + + + + + + + +/* + * COMPLEX NUMBER DATA STRUCTURE + * + * >>> Structure fields: + * Real (RealNumber) + * The real portion of the number. Real must be the first + * field in this structure. + * Imag (RealNumber) + * The imaginary portion of the number. This field must follow + * immediately after Real. + */ + +/* Begin `ComplexNumber'. */ + +typedef struct +{ RealNumber Real; + RealNumber Imag; +} ComplexNumber, *ComplexVector; + + + + + + + + +/* + * MATRIX ELEMENT DATA STRUCTURE + * + * Every nonzero element in the matrix is stored in a dynamically allocated + * MatrixElement structure. These structures are linked together in an + * orthogonal linked list. Two different MatrixElement structures exist. + * One is used when only real matrices are expected, it is missing an entry + * for imaginary data. The other is used if complex matrices are expected. + * It contains an entry for imaginary data. + * + * >>> Structure fields: + * Real (RealNumber) + * The real portion of the value of the element. Real must be the first + * field in this structure. + * Imag (RealNumber) + * The imaginary portion of the value of the element. If the matrix + * routines are not compiled to handle complex matrices, then this + * field does not exist. If it exists, it must follow immediately after + * Real. + * Row (int) + * The row number of the element. + * Col (int) + * The column number of the element. + * NextInRow (struct MatrixElement *) + * NextInRow contains a pointer to the next element in the row to the + * right of this element. If this element is the last nonzero in the + * row then NextInRow contains NULL. + * NextInCol (struct MatrixElement *) + * NextInCol contains a pointer to the next element in the column below + * this element. If this element is the last nonzero in the column then + * NextInCol contains NULL. + * pInitInfo (spGenericPtr) + * Pointer to user data used for initialization of the matrix element. + * Initialized to NULL. + * + * >>> Type definitions: + * ElementPtr + * A pointer to a MatrixElement. + * ArrayOfElementPtrs + * An array of ElementPtrs. Used for FirstInRow, FirstInCol and + * Diag pointer arrays. + */ + +/* Begin `MatrixElement'. */ + +struct MatrixElement +{ RealNumber Real; +#if spCOMPLEX + RealNumber Imag; +#endif + int Row; + int Col; + struct MatrixElement *NextInRow; + struct MatrixElement *NextInCol; +#if INITIALIZE + spGenericPtr pInitInfo; +#endif +}; + +typedef struct MatrixElement *ElementPtr; +typedef ElementPtr *ArrayOfElementPtrs; + + + + + + + + +/* + * ALLOCATION DATA STRUCTURE + * + * The sparse matrix routines keep track of all memory that is allocated by + * the operating system so the memory can later be freed. This is done by + * saving the pointers to all the chunks of memory that are allocated to a + * particular matrix in an allocation list. That list is organized as a + * linked list so that it can grow without a priori bounds. + * + * >>> Structure fields: + * AllocatedPtr (void *) + * Pointer to chunk of memory that has been allocated for the matrix. + * NextRecord (struct AllocationRecord *) + * Pointer to the next allocation record. + */ + +/* Begin `AllocationRecord'. */ +struct AllocationRecord +{ void *AllocatedPtr; + struct AllocationRecord *NextRecord; +}; + +typedef struct AllocationRecord *AllocationListPtr; + + + + + + + + + +/* + * FILL-IN LIST DATA STRUCTURE + * + * The sparse matrix routines keep track of all fill-ins separately from + * user specified elements so they may be removed by spStripFills(). Fill-ins + * are allocated in bunched in what is called a fill-in lists. The data + * structure defined below is used to organize these fill-in lists into a + * linked-list. + * + * >>> Structure fields: + * pFillinList (ElementPtr) + * Pointer to a fill-in list, or a bunch of fill-ins arranged contiguously + * in memory. + * NumberOfFillinsInList (int) + * Seems pretty self explanatory to me. + * Next (struct FillinListNodeStruct *) + * Pointer to the next fill-in list structures. + */ + +/* Begin `FillinListNodeStruct'. */ +struct FillinListNodeStruct +{ ElementPtr pFillinList; + int NumberOfFillinsInList; + struct FillinListNodeStruct *Next; +}; + + + + + + + + + + +/* + * MATRIX FRAME DATA STRUCTURE + * + * This structure contains all the pointers that support the orthogonal + * linked list that contains the matrix elements. Also included in this + * structure are other numbers and pointers that are used globally by the + * sparse matrix routines and are associated with one particular matrix.. + * + * >>> Type definitions: + * MatrixPtr + * A pointer to MatrixFrame. Essentially, a pointer to the matrix. + * + * >>> Structure fields: + * AbsThreshold (RealNumber) + * The absolute magnitude an element must have to be considered as a + * pivot candidate, except as a last resort. + * AllocatedExtSize (int) + * The allocated size of the arrays used to translate external row and + * column numbers to their internal values. + * AllocatedSize (int) + * The currently allocated size of the matrix; the size the matrix can + * grow to when EXPANDABLE is set true and AllocatedSize is the largest + * the matrix can get without requiring that the matrix frame be + * reallocated. + * Complex (BOOLEAN) + * The flag which indicates whether the matrix is complex (true) or + * real. + * CurrentSize (int) + * This number is used during the building of the matrix when the + * TRANSLATE option is set true. It indicates the number of internal + * rows and columns that have elements in them. + * Diag (ArrayOfElementPtrs) + * Array of pointers that points to the diagonal elements. + * DoCmplxDirect (BOOLEAN *) + * Array of flags, one for each column in matrix. If a flag is true + * then corresponding column in a complex matrix should be eliminated + * in spFactor() using direct addressing (rather than indirect + * addressing). + * DoRealDirect (BOOLEAN *) + * Array of flags, one for each column in matrix. If a flag is true + * then corresponding column in a real matrix should be eliminated + * in spFactor() using direct addressing (rather than indirect + * addressing). + * Elements (int) + * The number of original elements (total elements minus fill ins) + * present in matrix. + * Error (int) + * The error status of the sparse matrix package. + * ExtSize (int) + * The value of the largest external row or column number encountered. + * ExtToIntColMap (int []) + * An array that is used to convert external columns number to internal + * external column numbers. Present only if TRANSLATE option is set true. + * ExtToIntRowMap (int []) + * An array that is used to convert external row numbers to internal + * external row numbers. Present only if TRANSLATE option is set true. + * Factored (BOOLEAN) + * Indicates if matrix has been factored. This flag is set true in + * spFactor() and spOrderAndFactor() and set false in spCreate() + * and spClear(). + * Fillins (int) + * The number of fill-ins created during the factorization the matrix. + * FirstInCol (ArrayOfElementPtrs) + * Array of pointers that point to the first nonzero element of the + * column corresponding to the index. + * FirstInRow (ArrayOfElementPtrs) + * Array of pointers that point to the first nonzero element of the row + * corresponding to the index. + * ID (unsigned long int) + * A constant that provides the sparse data structure with a signature. + * When spDEBUG is true, all externally available sparse routines check + * this signature to assure they are operating on a valid matrix. + * Intermediate (RealVector) + * Temporary storage used in the spSolve routines. Intermediate is an + * array used during forward and backward substitution. It is + * commonly called y when the forward and backward substitution process is + * denoted Ax = b => Ly = b and Ux = y. + * InternalVectorsAllocated (BOOLEAN) + * A flag that indicates whether theMmarkowitz vectors and the + * Intermediate vector have been created. + * These vectors are created in spcCreateInternalVectors(). + * IntToExtColMap (int []) + * An array that is used to convert internal column numbers to external + * external column numbers. + * IntToExtRowMap (int []) + * An array that is used to convert internal row numbers to external + * external row numbers. + * MarkowitzCol (int []) + * An array that contains the count of the non-zero elements excluding + * the pivots for each column. Used to generate and update MarkowitzProd. + * MarkowitzProd (long []) + * The array of the products of the Markowitz row and column counts.. The + * element with the smallest product is the best pivot to use to maintain + * sparsity. + * MarkowitzRow (int []) + * An array that contains the count of the non-zero elements excluding + * the pivots for each row. Used to generate and update MarkowitzProd. + * MaxRowCountInLowerTri (int) + * The maximum number of off-diagonal element in the rows of L, the + * lower triangular matrix. This quantity is used when computing an + * estimate of the roundoff error in the matrix. + * NeedsOrdering (BOOLEAN) + * This is a flag that signifies that the matrix needs to be ordered + * or reordered. NeedsOrdering is set true in spCreate() and + * spGetElement() or spGetAdmittance() if new elements are added to the + * matrix after it has been previously factored. It is set false in + * spOrderAndFactor(). + * NumberOfInterchangesIsOdd (BOOLEAN) + * Flag that indicates the sum of row and column interchange counts + * is an odd number. Used when determining the sign of the determinant. + * Partitioned (BOOLEAN) + * This flag indicates that the columns of the matrix have been + * partitioned into two groups. Those that will be addressed directly + * and those that will be addressed indirectly in spFactor(). + * PivotsOriginalCol (int) + * Column pivot was chosen from. + * PivotsOriginalRow (int) + * Row pivot was chosen from. + * PivotSelectionMethod (char) + * Character that indicates which pivot search method was successful. + * PreviousMatrixWasComplex (BOOLEAN) + * This flag in needed to determine how to clear the matrix. When + * dealing with real matrices, it is important that the imaginary terms + * in the matrix elements be zero. Thus, if the previous matrix was + * complex, then the current matrix will be cleared as if it were complex + * even if it is real. + * RelThreshold (RealNumber) + * The magnitude an element must have relative to others in its row + * to be considered as a pivot candidate, except as a last resort. + * Reordered (BOOLEAN) + * This flag signifies that the matrix has been reordered. It + * is cleared in spCreate(), set in spMNA_Preorder() and + * spOrderAndFactor() and is used in spPrint(). + * RowsLinked (BOOLEAN) + * A flag that indicates whether the row pointers exist. The AddByIndex + * routines do not generate the row pointers, which are needed by some + * of the other routines, such as spOrderAndFactor() and spScale(). + * The row pointers are generated in the function spcLinkRows(). + * SingularCol (int) + * Normally zero, but if matrix is found to be singular, SingularCol is + * assigned the external column number of pivot that was zero. + * SingularRow (int) + * Normally zero, but if matrix is found to be singular, SingularRow is + * assigned the external row number of pivot that was zero. + * Singletons (int) + * The number of singletons available for pivoting. Note that if row I + * and column I both contain singletons, only one of them is counted. + * Size (int) + * Number of rows and columns in the matrix. Does not change as matrix + * is factored. + * TrashCan (MatrixElement) + * This is a dummy MatrixElement that is used to by the user to stuff + * data related to the zero row or column. In other words, when the user + * adds an element in row zero or column zero, then the matrix returns + * a pointer to TrashCan. In this way the user can have a uniform way + * data into the matrix independent of whether a component is connected + * to ground. + * + * >>> The remaining fields are related to memory allocation. + * TopOfAllocationList (AllocationListPtr) + * Pointer which points to the top entry in a list. The list contains + * all the pointers to the segments of memory that have been allocated + * to this matrix. This is used when the memory is to be freed on + * deallocation of the matrix. + * RecordsRemaining (int) + * Number of slots left in the list of allocations. + * NextAvailElement (ElementPtr) + * Pointer to the next available element which has been allocated but as + * yet is unused. Matrix elements are allocated in groups of + * ELEMENTS_PER_ALLOCATION in order to speed element allocation and + * freeing. + * ElementsRemaining (int) + * Number of unused elements left in last block of elements allocated. + * NextAvailFillin (ElementPtr) + * Pointer to the next available fill-in which has been allocated but + * as yet is unused. Fill-ins are allocated in a group in order to keep + * them physically close in memory to the rest of the matrix. + * FillinsRemaining (int) + * Number of unused fill-ins left in the last block of fill-ins + * allocated. + * FirstFillinListNode (FillinListNodeStruct *) + * A pointer to the head of the linked-list that keeps track of the + * lists of fill-ins. + * LastFillinListNode (FillinListNodeStruct *) + * A pointer to the tail of the linked-list that keeps track of the + * lists of fill-ins. + */ + +/* Begin `MatrixFrame'. */ +struct MatrixFrame +{ RealNumber AbsThreshold; + int AllocatedSize; + int AllocatedExtSize; + BOOLEAN Complex; + int CurrentSize; + ArrayOfElementPtrs Diag; + BOOLEAN *DoCmplxDirect; + BOOLEAN *DoRealDirect; + int Elements; + int Error; + int ExtSize; + int *ExtToIntColMap; + int *ExtToIntRowMap; + BOOLEAN Factored; + int Fillins; + ArrayOfElementPtrs FirstInCol; + ArrayOfElementPtrs FirstInRow; + unsigned long ID; + RealVector Intermediate; + BOOLEAN InternalVectorsAllocated; + int *IntToExtColMap; + int *IntToExtRowMap; + int *MarkowitzRow; + int *MarkowitzCol; + long *MarkowitzProd; + int MaxRowCountInLowerTri; + BOOLEAN NeedsOrdering; + BOOLEAN NumberOfInterchangesIsOdd; + BOOLEAN Partitioned; + int PivotsOriginalCol; + int PivotsOriginalRow; + char PivotSelectionMethod; + BOOLEAN PreviousMatrixWasComplex; + RealNumber RelThreshold; + BOOLEAN Reordered; + BOOLEAN RowsLinked; + int SingularCol; + int SingularRow; + int Singletons; + int Size; + struct MatrixElement TrashCan; + + AllocationListPtr TopOfAllocationList; + int RecordsRemaining; + ElementPtr NextAvailElement; + int ElementsRemaining; + ElementPtr NextAvailFillin; + int FillinsRemaining; + struct FillinListNodeStruct *FirstFillinListNode; + struct FillinListNodeStruct *LastFillinListNode; +}; +typedef struct MatrixFrame *MatrixPtr; + + + + +/* + * Declarations + */ + +spcEXTERN ElementPtr spcGetElement( MatrixPtr ); +spcEXTERN ElementPtr spcGetFillin( MatrixPtr ); +spcEXTERN ElementPtr spcFindDiag( MatrixPtr, int ); +spcEXTERN ElementPtr spcCreateElement( MatrixPtr, int, int, + ElementPtr*, ElementPtr*, int ); +spcEXTERN void spcCreateInternalVectors( MatrixPtr ); +spcEXTERN void spcLinkRows( MatrixPtr ); +spcEXTERN void spcColExchange( MatrixPtr, int, int ); +spcEXTERN void spcRowExchange( MatrixPtr, int, int ); + +spcEXTERN char spcMatrixIsNotValid[]; +spcEXTERN char spcErrorsMustBeCleared[]; +spcEXTERN char spcMatrixMustBeFactored[]; +spcEXTERN char spcMatrixMustNotBeFactored[]; Added: trunk/math/SPARSE/spedacious.c =================================================================== --- trunk/math/SPARSE/spedacious.c (rev 0) +++ trunk/math/SPARSE/spedacious.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,45 @@ + /* + * Copyright (c) 2008 + * + * Antoine Levitt (smeuuh-Re5JQEeQqe8AvxtiuMwx3w@xxxxxxxxxxxxxxxx) + * Steven Herbst (herbst-3s7WtUTddSA@xxxxxxxxxxxxxxxx) + * + * Hypertriton, Inc. <http://hypertriton.com/> + * + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + + +/* This file contains extra functions used in edacious */ + +#include <core/core.h> +#include "../m.h" +#include "spdefs.h" + +void spAddToReorderedDiag(spMatrix M, spREAL g) +{ + MatrixPtr Matrix = (MatrixPtr)M; + int i; + for(i = 0; i < Matrix->Size ; i++) + Matrix->Diag[i]->Real += g; +} Added: trunk/math/SPARSE/spfactor.c =================================================================== --- trunk/math/SPARSE/spfactor.c (rev 0) +++ trunk/math/SPARSE/spfactor.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,3048 @@ +/* + * MATRIX FACTORIZATION MODULE + * + * Author: Advising Professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*! \file + * This file contains the routines to factor the matrix into LU form. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spOrderAndFactor + * spFactor + * spPartition + * + * >>> Other functions contained in this file: + * FactorComplexMatrix spcCreateInternalVectors + * CountMarkowitz MarkowitzProducts + * SearchForPivot SearchForSingleton + * QuicklySearchDiagonal SearchDiagonal + * SearchEntireMatrix FindLargestInCol + * FindBiggestInColExclude ExchangeRowsAndCols + * spcRowExchange spcColExchange + * ExchangeColElements ExchangeRowElements + * RealRowColElimination ComplexRowColElimination + * UpdateMarkowitzNumbers MatrixIsSingular + * ZeroPivot WriteStatus + */ + + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + + +/* + * Function declarations + */ + +static int FactorComplexMatrix( MatrixPtr ); +static void CountMarkowitz( MatrixPtr, RealVector, int ); +static void MarkowitzProducts( MatrixPtr, int ); +static ElementPtr SearchForPivot( MatrixPtr, int, int ); +static ElementPtr SearchForSingleton( MatrixPtr, int ); +static ElementPtr QuicklySearchDiagonal( MatrixPtr, int ); +static ElementPtr SearchDiagonal( MatrixPtr, int ); +static ElementPtr SearchEntireMatrix( MatrixPtr, int ); +static RealNumber FindLargestInCol( ElementPtr ); +static RealNumber FindBiggestInColExclude( MatrixPtr, ElementPtr, int ); +static void ExchangeRowsAndCols( MatrixPtr, ElementPtr, int ); +static void ExchangeColElements( MatrixPtr, int, ElementPtr, int, + ElementPtr, int ); +static void ExchangeRowElements( MatrixPtr, int, ElementPtr, int, + ElementPtr, int ); +static void RealRowColElimination( MatrixPtr, ElementPtr ); +static void ComplexRowColElimination( MatrixPtr, ElementPtr ); +static void UpdateMarkowitzNumbers( MatrixPtr, ElementPtr ); +static int MatrixIsSingular( MatrixPtr, int ); +static int ZeroPivot( MatrixPtr, int ); + + + + + +/*! + * This routine chooses a pivot order for the matrix and factors it + * into \a LU form. It handles both the initial factorization and subsequent + * factorizations when a reordering is desired. This is handled in a manner + * that is transparent to the user. The routine uses a variation of + * Gauss's method where the pivots are associated with \a L and the + * diagonal terms of \a U are one. + * + * \return + * The error code is returned. Possible errors are \a spNO_MEMORY, + * \a spSINGULAR and \a spSMALL_PIVOT. + * Error is cleared upon entering this function. + * + * \param eMatrix + * Pointer to the matrix. + * \param RHS + * Representative right-hand side vector that is used to determine + * pivoting order when the right hand side vector is sparse. If + * RHS is a NULL pointer then the RHS vector is assumed to + * be full and it is not used when determining the pivoting + * order. + * \param RelThreshold + * This number determines what the pivot relative threshold will + * be. It should be between zero and one. If it is one then the + * pivoting method becomes complete pivoting, which is very slow + * and tends to fill up the matrix. If it is set close to zero + * the pivoting method becomes strict Markowitz with no + * threshold. The pivot threshold is used to eliminate pivot + * candidates that would cause excessive element growth if they + * were used. Element growth is the cause of roundoff error. + * Element growth occurs even in well-conditioned matrices. + * Setting the \a RelThreshold large will reduce element growth and + * roundoff error, but setting it too large will cause execution + * time to be excessive and will result in a large number of + * fill-ins. If this occurs, accuracy can actually be degraded + * because of the large number of operations required on the + * matrix due to the large number of fill-ins. A good value seems + * to be 0.001. The default is chosen by giving a value larger + * than one or less than or equal to zero. This value should be + * increased and the matrix resolved if growth is found to be + * excessive. Changing the pivot threshold does not improve + * performance on matrices where growth is low, as is often the + * case with ill-conditioned matrices. Once a valid threshold is + * given, it becomes the new default. The default value of + * \a RelThreshold was choosen for use with nearly diagonally + * dominant matrices such as node- and modified-node admittance + * matrices. For these matrices it is usually best to use + * diagonal pivoting. For matrices without a strong diagonal, it + * is usually best to use a larger threshold, such as 0.01 or + * 0.1. + * \param AbsThreshold + * The absolute magnitude an element must have to be considered + * as a pivot candidate, except as a last resort. This number + * should be set significantly smaller than the smallest diagonal + * element that is is expected to be placed in the matrix. If + * there is no reasonable prediction for the lower bound on these + * elements, then \a AbsThreshold should be set to zero. + * \a AbsThreshold is used to reduce the possibility of choosing as a + * pivot an element that has suffered heavy cancellation and as a + * result mainly consists of roundoff error. Once a valid + * threshold is given, it becomes the new default. + * \param DiagPivoting + * A flag indicating that pivot selection should be confined to the + * diagonal if possible. If \a DiagPivoting is nonzero and if + * \a DIAGONAL_PIVOTING is enabled pivots will be chosen only from + * the diagonal unless there are no diagonal elements that satisfy + * the threshold criteria. Otherwise, the entire reduced + * submatrix is searched when looking for a pivot. The diagonal + * pivoting in Sparse is efficient and well refined, while the + * off-diagonal pivoting is not. For symmetric and near symmetric + * matrices, it is best to use diagonal pivoting because it + * results in the best performance when reordering the matrix and + * when factoring the matrix without ordering. If there is a + * considerable amount of nonsymmetry in the matrix, then + * off-diagonal pivoting may result in a better equation ordering + * simply because there are more pivot candidates to choose from. + * A better ordering results in faster subsequent factorizations. + * However, the initial pivot selection process takes considerably + * longer for off-diagonal pivoting. + * + * \see spFactor() + */ +/* >>> Local variables: + * pPivot (ElementPtr) + * Pointer to the element being used as a pivot. + * + */ + +spError +spOrderAndFactor( + spMatrix eMatrix, + spREAL RHS[], + spREAL RelThreshold, + spREAL AbsThreshold, + int DiagPivoting +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +ElementPtr pPivot; +int Step, Size; +RealNumber LargestInCol; + +/* Begin `spOrderAndFactor'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + + Matrix->Error = spOKAY; + Size = Matrix->Size; + if (RelThreshold <= 0.0) RelThreshold = Matrix->RelThreshold; + if (RelThreshold > 1.0) RelThreshold = Matrix->RelThreshold; + Matrix->RelThreshold = RelThreshold; + if (AbsThreshold < 0.0) AbsThreshold = Matrix->AbsThreshold; + Matrix->AbsThreshold = AbsThreshold; + + if (NOT Matrix->NeedsOrdering) + { +/* Matrix has been factored before and reordering is not required. */ + for (Step = 1; Step <= Size; Step++) + { pPivot = Matrix->Diag[Step]; + LargestInCol = FindLargestInCol(pPivot->NextInCol); + if ((LargestInCol * RelThreshold < ELEMENT_MAG(pPivot))) + { if (Matrix->Complex) + ComplexRowColElimination( Matrix, pPivot ); + else + RealRowColElimination( Matrix, pPivot ); + } + else + { Matrix->NeedsOrdering = YES; + break; /* for loop */ + } + } + if (NOT Matrix->NeedsOrdering) + goto Done; + else + { +/* + * A pivot was not large enough to maintain accuracy, + * so a partial reordering is required. + */ + +#if (ANNOTATE >= ON_STRANGE_BEHAVIOR) + printf("Reordering, Step = %1d\n", Step); +#endif + } + } /* End of if(NOT Matrix->NeedsOrdering) */ + else + { +/* + * This is the first time the matrix has been factored. These few statements + * indicate to the rest of the code that a full reodering is required rather + * than a partial reordering, which occurs during a failure of a fast + * factorization. + */ + Step = 1; + if (NOT Matrix->RowsLinked) + spcLinkRows( Matrix ); + if (NOT Matrix->InternalVectorsAllocated) + spcCreateInternalVectors( Matrix ); + if (Matrix->Error >= spFATAL) + return Matrix->Error; + } + +/* Form initial Markowitz products. */ + CountMarkowitz( Matrix, RHS, Step ); + MarkowitzProducts( Matrix, Step ); + Matrix->MaxRowCountInLowerTri = -1; + +/* Perform reordering and factorization. */ + for (; Step <= Size; Step++) + { pPivot = SearchForPivot( Matrix, Step, DiagPivoting ); + if (pPivot == NULL) return MatrixIsSingular( Matrix, Step ); + ExchangeRowsAndCols( Matrix, pPivot, Step ); + + if (Matrix->Complex) + ComplexRowColElimination( Matrix, pPivot ); + else + RealRowColElimination( Matrix, pPivot ); + + if (Matrix->Error >= spFATAL) return Matrix->Error; + UpdateMarkowitzNumbers( Matrix, pPivot ); + +#if (ANNOTATE == FULL) + WriteStatus( Matrix, Step ); +#endif + } + +Done: + Matrix->NeedsOrdering = NO; + Matrix->Reordered = YES; + Matrix->Factored = YES; + + return Matrix->Error; +} + + + + + + + +/*! + * This routine is the companion routine to spOrderAndFactor(). + * Unlike spOrderAndFactor(), spFactor() cannot change the ordering. + * It is also faster than spOrderAndFactor(). The standard way of + * using these two routines is to first use spOrderAndFactor() for the + * initial factorization. For subsequent factorizations, spFactor() + * is used if there is some assurance that little growth will occur + * (say for example, that the matrix is diagonally dominant). If + * spFactor() is called for the initial factorization of the matrix, + * then spOrderAndFactor() is automatically called with the default + * threshold. This routine uses "row at a time" \a LU factorization. + * Pivots are associated with the lower triangular matrix and the + * diagonals of the upper triangular matrix are ones. + * + * \return + * The error code is returned. Possible errors are + * \a spNO_MEMORY, \a spSINGULAR, \a spZERO_DIAG and \a spSMALL_PIVOT. + * Error is cleared upon entering this function. + * + * \param eMatrix + * Pointer to matrix. + * \see spOrderAndFactor() + */ + +spError +spFactor( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register ElementPtr pColumn; +register int Step, Size; +RealNumber Mult; + +/* Begin `spFactor'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + + if (Matrix->NeedsOrdering) + { return spOrderAndFactor( eMatrix, (RealVector)NULL, + 0.0, 0.0, DIAG_PIVOTING_AS_DEFAULT ); + } + if (NOT Matrix->Partitioned) spPartition( eMatrix, spDEFAULT_PARTITION ); +#if spCOMPLEX + if (Matrix->Complex) return FactorComplexMatrix( Matrix ); +#endif + +#if REAL + Size = Matrix->Size; + + if (Matrix->Diag[1]->Real == 0.0) return ZeroPivot( Matrix, 1 ); + Matrix->Diag[1]->Real = 1.0 / Matrix->Diag[1]->Real; + +/* Start factorization. */ + for (Step = 2; Step <= Size; Step++) + { if (Matrix->DoRealDirect[Step]) + { /* Update column using direct addressing scatter-gather. */ + register RealNumber *Dest = (RealNumber *)Matrix->Intermediate; + +/* Scatter. */ + pElement = Matrix->FirstInCol[Step]; + while (pElement != NULL) + { Dest[pElement->Row] = pElement->Real; + pElement = pElement->NextInCol; + } + +/* Update column. */ + pColumn = Matrix->FirstInCol[Step]; + while (pColumn->Row < Step) + { pElement = Matrix->Diag[pColumn->Row]; + pColumn->Real = Dest[pColumn->Row] * pElement->Real; + while ((pElement = pElement->NextInCol) != NULL) + Dest[pElement->Row] -= pColumn->Real * pElement->Real; + pColumn = pColumn->NextInCol; + } + +/* Gather. */ + pElement = Matrix->Diag[Step]->NextInCol; + while (pElement != NULL) + { pElement->Real = Dest[pElement->Row]; + pElement = pElement->NextInCol; + } + +/* Check for singular matrix. */ + if (Dest[Step] == 0.0) return ZeroPivot( Matrix, Step ); + Matrix->Diag[Step]->Real = 1.0 / Dest[Step]; + } + else + { /* Update column using indirect addressing scatter-gather. */ + register RealNumber **pDest = (RealNumber **)Matrix->Intermediate; + +/* Scatter. */ + pElement = Matrix->FirstInCol[Step]; + while (pElement != NULL) + { pDest[pElement->Row] = &pElement->Real; + pElement = pElement->NextInCol; + } + +/* Update column. */ + pColumn = Matrix->FirstInCol[Step]; + while (pColumn->Row < Step) + { pElement = Matrix->Diag[pColumn->Row]; + Mult = (*pDest[pColumn->Row] *= pElement->Real); + while ((pElement = pElement->NextInCol) != NULL) + *pDest[pElement->Row] -= Mult * pElement->Real; + pColumn = pColumn->NextInCol; + } + +/* Check for singular matrix. */ + if (Matrix->Diag[Step]->Real == 0.0) + return ZeroPivot( Matrix, Step ); + Matrix->Diag[Step]->Real = 1.0 / Matrix->Diag[Step]->Real; + } + } + + Matrix->Factored = YES; + return (Matrix->Error = spOKAY); +#endif /* REAL */ +} + + + + + + +#if spCOMPLEX +/* + * FACTOR COMPLEX MATRIX + * + * This routine is the companion routine to spFactor(), it + * handles complex matrices. It is otherwise identical. + * + * >>> Returned: + * The error code is returned. Possible errors are listed below. + * + * >>> Arguments: + * Matrix <input> (char *) + * Pointer to matrix. + * + * >>> Possible errors: + * spSINGULAR + * Error is cleared in this function. + */ + +static int +FactorComplexMatrix( MatrixPtr Matrix ) +{ +register ElementPtr pElement; +register ElementPtr pColumn; +register int Step, Size; +ComplexNumber Mult, Pivot; + +/* Begin `FactorComplexMatrix'. */ + ASSERT(Matrix->Complex); + + Size = Matrix->Size; + pElement = Matrix->Diag[1]; + if (ELEMENT_MAG(pElement) == 0.0) return ZeroPivot( Matrix, 1 ); +/* Cmplx expr: *pPivot = 1.0 / *pPivot. */ + CMPLX_RECIPROCAL( *pElement, *pElement ); + +/* Start factorization. */ + for (Step = 2; Step <= Size; Step++) + { if (Matrix->DoCmplxDirect[Step]) + { /* Update column using direct addressing scatter-gather. */ + register ComplexNumber *Dest; + Dest = (ComplexNumber *)Matrix->Intermediate; + +/* Scatter. */ + pElement = Matrix->FirstInCol[Step]; + while (pElement != NULL) + { Dest[pElement->Row] = *(ComplexNumber *)pElement; + pElement = pElement->NextInCol; + } + +/* Update column. */ + pColumn = Matrix->FirstInCol[Step]; + while (pColumn->Row < Step) + { pElement = Matrix->Diag[pColumn->Row]; + /* Cmplx expr: Mult = Dest[pColumn->Row] * (1.0 / *pPivot). */ + CMPLX_MULT(Mult, Dest[pColumn->Row], *pElement); + CMPLX_ASSIGN(*pColumn, Mult); + while ((pElement = pElement->NextInCol) != NULL) + { /* Cmplx expr: Dest[pElement->Row] -= Mult * pElement */ + CMPLX_MULT_SUBT_ASSIGN(Dest[pElement->Row],Mult,*pElement); + } + pColumn = pColumn->NextInCol; + } + +/* Gather. */ + pElement = Matrix->Diag[Step]->NextInCol; + while (pElement != NULL) + { *(ComplexNumber *)pElement = Dest[pElement->Row]; + pElement = pElement->NextInCol; + } + +/* Check for singular matrix. */ + Pivot = Dest[Step]; + if (CMPLX_1_NORM(Pivot) == 0.0) return ZeroPivot( Matrix, Step ); + CMPLX_RECIPROCAL( *Matrix->Diag[Step], Pivot ); + } + else + { /* Update column using direct addressing scatter-gather. */ + register ComplexNumber **pDest; + pDest = (ComplexNumber **)Matrix->Intermediate; + +/* Scatter. */ + pElement = Matrix->FirstInCol[Step]; + while (pElement != NULL) + { pDest[pElement->Row] = (ComplexNumber *)pElement; + pElement = pElement->NextInCol; + } + +/* Update column. */ + pColumn = Matrix->FirstInCol[Step]; + while (pColumn->Row < Step) + { pElement = Matrix->Diag[pColumn->Row]; + /* Cmplx expr: Mult = *pDest[pColumn->Row] * (1.0 / *pPivot). */ + CMPLX_MULT(Mult, *pDest[pColumn->Row], *pElement); + CMPLX_ASSIGN(*pDest[pColumn->Row], Mult); + while ((pElement = pElement->NextInCol) != NULL) + { /* Cmplx expr: *pDest[pElement->Row] -= Mult * pElement */ + CMPLX_MULT_SUBT_ASSIGN(*pDest[pElement->Row],Mult,*pElement); + } + pColumn = pColumn->NextInCol; + } + +/* Check for singular matrix. */ + pElement = Matrix->Diag[Step]; + if (ELEMENT_MAG(pElement) == 0.0) return ZeroPivot( Matrix, Step ); + CMPLX_RECIPROCAL( *pElement, *pElement ); + } + } + + Matrix->Factored = YES; + return (Matrix->Error = spOKAY); +} +#endif /* spCOMPLEX */ + + + + + + +/*! + * This routine determines the cost to factor each row using both + * direct and indirect addressing and decides, on a row-by-row basis, + * which addressing mode is fastest. This information is used in + * spFactor() to speed the factorization. + * + * When factoring a previously ordered matrix using spFactor(), Sparse + * operates on a row-at-a-time basis. For speed, on each step, the + * row being updated is copied into a full vector and the operations + * are performed on that vector. This can be done one of two ways, + * either using direct addressing or indirect addressing. Direct + * addressing is fastest when the matrix is relatively dense and + * indirect addressing is best when the matrix is quite sparse. The + * user selects the type of partition used with \a Mode. If \a Mode is set + * to \a spDIRECT_PARTITION, then the all rows are placed in the direct + * addressing partition. Similarly, if \a Mode is set to + * \a spINDIRECT_PARTITION, then the all rows are placed in the indirect + * addressing partition. By setting \a Mode to \a spAUTO_PARTITION, the + * user allows Sparse to select the partition for each row + * individually. spFactor() generally runs faster if Sparse is + * allowed to choose its own partitioning, however choosing a + * partition is expensive. The time required to choose a partition is + * of the same order of the cost to factor the matrix. If you plan to + * factor a large number of matrices with the same structure, it is + * best to let Sparse choose the partition. Otherwise, you should + * choose the partition based on the predicted density of the matrix. + * + * \param eMatrix + * Pointer to matrix. + * \param Mode + * Mode must be one of three special codes: \a spDIRECT_PARTITION, + * \a spINDIRECT_PARTITION, or \a spAUTO_PARTITION. + */ + +void +spPartition( + spMatrix eMatrix, + int Mode +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement, pColumn; +register int Step, Size; +register int *Nc, *No; +register long *Nm; +BOOLEAN *DoRealDirect, *DoCmplxDirect; + +/* Begin `spPartition'. */ + ASSERT_IS_SPARSE( Matrix ); + + if (Matrix->Partitioned) return; + Size = Matrix->Size; + DoRealDirect = Matrix->DoRealDirect; + DoCmplxDirect = Matrix->DoCmplxDirect; + Matrix->Partitioned = YES; + +/* If partition is specified by the user, this is easy. */ + if (Mode == spDEFAULT_PARTITION) Mode = DEFAULT_PARTITION; + if (Mode == spDIRECT_PARTITION) + { for (Step = 1; Step <= Size; Step++) +#if REAL + DoRealDirect[Step] = YES; +#endif +#if spCOMPLEX + DoCmplxDirect[Step] = YES; +#endif + return; + } + else if (Mode == spINDIRECT_PARTITION) + { for (Step = 1; Step <= Size; Step++) +#if REAL + DoRealDirect[Step] = NO; +#endif +#if spCOMPLEX + DoCmplxDirect[Step] = NO; +#endif + return; + } + else vASSERT( Mode == spAUTO_PARTITION, "Invalid partition code" );; + +/* Otherwise, count all operations needed in when factoring matrix. */ + Nc = (int *)Matrix->MarkowitzRow; + No = (int *)Matrix->MarkowitzCol; + Nm = (long *)Matrix->MarkowitzProd; + +/* Start mock-factorization. */ + for (Step = 1; Step <= Size; Step++) + { Nc[Step] = No[Step] = Nm[Step] = 0; + + pElement = Matrix->FirstInCol[Step]; + while (pElement != NULL) + { Nc[Step]++; + pElement = pElement->NextInCol; + } + + pColumn = Matrix->FirstInCol[Step]; + while (pColumn->Row < Step) + { pElement = Matrix->Diag[pColumn->Row]; + Nm[Step]++; + while ((pElement = pElement->NextInCol) != NULL) + No[Step]++; + pColumn = pColumn->NextInCol; + } + } + + for (Step = 1; Step <= Size; Step++) + { +/* + * The following are just estimates based on a count on the number of + * machine instructions used on each machine to perform the various + * tasks. It was assumed that each machine instruction required the + * same amount of time (I don't believe this is true for the VAX, and + * have no idea if this is true for the 68000 family). For optimum + * performance, these numbers should be tuned to the machine. + * Nc is the number of nonzero elements in the column. + * Nm is the number of multipliers in the column. + * No is the number of operations in the inner loop. + */ + +#define generic +#ifdef hp9000s300 +#if REAL + DoRealDirect[Step] = (Nm[Step] + No[Step] > 3*Nc[Step] - 2*Nm[Step]); +#endif +#if spCOMPLEX + /* On the hp350, it is never profitable to use direct for complex. */ + DoCmplxDirect[Step] = NO; +#endif +#undef generic +#endif + +#ifdef vax +#if REAL + DoRealDirect[Step] = (Nm[Step] + No[Step] > 3*Nc[Step] - 2*Nm[Step]); +#endif +#if spCOMPLEX + DoCmplxDirect[Step] = (Nm[Step] + No[Step] > 7*Nc[Step] - 4*Nm[Step]); +#endif +#undef generic +#endif + +#ifdef generic +#if REAL + DoRealDirect[Step] = (Nm[Step] + No[Step] > 3*Nc[Step] - 2*Nm[Step]); +#endif +#if spCOMPLEX + DoCmplxDirect[Step] = (Nm[Step] + No[Step] > 7*Nc[Step] - 4*Nm[Step]); +#endif +#undef generic +#endif + } + +#if (ANNOTATE == FULL) + { int Ops = 0; + for (Step = 1; Step <= Size; Step++) + Ops += No[Step]; + printf("Operation count for inner loop of factorization = %d.\n", Ops); + } +#endif + return; +} + + + + + + + +/* + * CREATE INTERNAL VECTORS + * + * Creates the Markowitz and Intermediate vectors. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +void +spcCreateInternalVectors( MatrixPtr Matrix ) +{ +int Size; + +/* Begin `spcCreateInternalVectors'. */ +/* Create Markowitz arrays. */ + Size= Matrix->Size; + + if (Matrix->MarkowitzRow == NULL) + { if (( Matrix->MarkowitzRow = ALLOC(int, Size+1)) == NULL) + Matrix->Error = spNO_MEMORY; + } + if (Matrix->MarkowitzCol == NULL) + { if (( Matrix->MarkowitzCol = ALLOC(int, Size+1)) == NULL) + Matrix->Error = spNO_MEMORY; + } + if (Matrix->MarkowitzProd == NULL) + { if (( Matrix->MarkowitzProd = ALLOC(long, Size+2)) == NULL) + Matrix->Error = spNO_MEMORY; + } + +/* Create DoDirect vectors for use in spFactor(). */ +#if REAL + if (Matrix->DoRealDirect == NULL) + { if (( Matrix->DoRealDirect = ALLOC(BOOLEAN, Size+1)) == NULL) + Matrix->Error = spNO_MEMORY; + } +#endif +#if spCOMPLEX + if (Matrix->DoCmplxDirect == NULL) + { if (( Matrix->DoCmplxDirect = ALLOC(BOOLEAN, Size+1)) == NULL) + Matrix->Error = spNO_MEMORY; + } +#endif + +/* Create Intermediate vectors for use in MatrixSolve. */ +#if spCOMPLEX + if (Matrix->Intermediate == NULL) + { if ((Matrix->Intermediate = ALLOC(RealNumber,2*(Size+1))) == NULL) + Matrix->Error = spNO_MEMORY; + } +#else + if (Matrix->Intermediate == NULL) + { if ((Matrix->Intermediate = ALLOC(RealNumber, Size+1)) == NULL) + Matrix->Error = spNO_MEMORY; + } +#endif + + if (Matrix->Error != spNO_MEMORY) + Matrix->InternalVectorsAllocated = YES; + return; +} + + + + + + + +/* + * COUNT MARKOWITZ + * + * Scans Matrix to determine the Markowitz counts for each row and column. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * RHS <input> (RealVector) + * Representative right-hand side vector that is used to determine + * pivoting order when the right hand side vector is sparse. If + * RHS is a NULL pointer then the RHS vector is assumed to be full + * and it is not used when determining the pivoting order. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * Count (int) + * Temporary counting variable. + * ExtRow (int) + * The external row number that corresponds to I. + * pElement (ElementPtr) + * Pointer to matrix elements. + * Size (int) + * The size of the matrix. + */ + +static void +CountMarkowitz( + MatrixPtr Matrix, + register RealVector RHS, + int Step +) +{ +register int Count, I, Size = Matrix->Size; +register ElementPtr pElement; +int ExtRow; + +/* Begin `CountMarkowitz'. */ + +/* Correct array pointer for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spSEPARATED_COMPLEX_VECTORS OR NOT spCOMPLEX + if (RHS != NULL) --RHS; +#else + if (RHS != NULL) + { if (Matrix->Complex) RHS -= 2; + else --RHS; + } +#endif +#endif + +/* Generate MarkowitzRow Count for each row. */ + for (I = Step; I <= Size; I++) + { +/* Set Count to -1 initially to remove count due to pivot element. */ + Count = -1; + pElement = Matrix->FirstInRow[I]; + while (pElement != NULL AND pElement->Col < Step) + pElement = pElement->NextInRow; + while (pElement != NULL) + { Count++; + pElement = pElement->NextInRow; + } + +/* Include nonzero elements in the RHS vector. */ + ExtRow = Matrix->IntToExtRowMap[I]; + +#if spSEPARATED_COMPLEX_VECTORS OR NOT spCOMPLEX + if (RHS != NULL) + if (RHS[ExtRow] != 0.0) Count++; +#else + if (RHS != NULL) + { if (Matrix->Complex) + { if ((RHS[2*ExtRow] != 0.0) OR (RHS[2*ExtRow+1] != 0.0)) + Count++; + } + else if (RHS[I] != 0.0) Count++; + } +#endif + Matrix->MarkowitzRow[I] = Count; + } + +/* Generate the MarkowitzCol count for each column. */ + for (I = Step; I <= Size; I++) + { +/* Set Count to -1 initially to remove count due to pivot element. */ + Count = -1; + pElement = Matrix->FirstInCol[I]; + while (pElement != NULL AND pElement->Row < Step) + pElement = pElement->NextInCol; + while (pElement != NULL) + { Count++; + pElement = pElement->NextInCol; + } + Matrix->MarkowitzCol[I] = Count; + } + return; +} + + + + + + + + + + +/* + * MARKOWITZ PRODUCTS + * + * Calculates MarkowitzProduct for each diagonal element from the Markowitz + * counts. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local Variables: + * pMarkowitzProduct (long *) + * Pointer that points into MarkowitzProduct array. Is used to + * sequentially access entries quickly. + * pMarkowitzRow (int *) + * Pointer that points into MarkowitzRow array. Is used to sequentially + * access entries quickly. + * pMarkowitzCol (int *) + * Pointer that points into MarkowitzCol array. Is used to sequentially + * access entries quickly. + * Product (long) + * Temporary storage for Markowitz product./ + * Size (int) + * The size of the matrix. + */ + +static void +MarkowitzProducts( + MatrixPtr Matrix, + int Step +) +{ +register int I, *pMarkowitzRow, *pMarkowitzCol; +register long Product, *pMarkowitzProduct; +register int Size = Matrix->Size; +double fProduct; + +/* Begin `MarkowitzProducts'. */ + Matrix->Singletons = 0; + + pMarkowitzProduct = &(Matrix->MarkowitzProd[Step]); + pMarkowitzRow = &(Matrix->MarkowitzRow[Step]); + pMarkowitzCol = &(Matrix->MarkowitzCol[Step]); + + for (I = Step; I <= Size; I++) + { +/* If chance of overflow, use real numbers. */ + if ((*pMarkowitzRow > LARGEST_SHORT_INTEGER AND *pMarkowitzCol != 0) OR + (*pMarkowitzCol > LARGEST_SHORT_INTEGER AND *pMarkowitzRow != 0)) + { fProduct = (double)(*pMarkowitzRow++) * (double)(*pMarkowitzCol++); + if (fProduct >= LARGEST_LONG_INTEGER) + *pMarkowitzProduct++ = LARGEST_LONG_INTEGER; + else + *pMarkowitzProduct++ = (long)fProduct; + } + else + { Product = *pMarkowitzRow++ * *pMarkowitzCol++; + if ((*pMarkowitzProduct++ = Product) == 0) + Matrix->Singletons++; + } + } + return; +} + + + + + + + + + + + +/* + * SEARCH FOR BEST PIVOT + * + * Performs a search to determine the element with the lowest Markowitz + * Product that is also acceptable. An acceptable element is one that is + * larger than the AbsThreshold and at least as large as RelThreshold times + * the largest element in the same column. The first step is to look for + * singletons if any exist. If none are found, then all the diagonals are + * searched. The diagonal is searched once quickly using the assumption that + * elements on the diagonal are large compared to other elements in their + * column, and so the pivot can be chosen only on the basis of the Markowitz + * criterion. After a element has been chosen to be pivot on the basis of + * its Markowitz product, it is checked to see if it is large enough. + * Waiting to the end of the Markowitz search to check the size of a pivot + * candidate saves considerable time, but is not guaranteed to find an + * acceptable pivot. Thus if unsuccessful a second pass of the diagonal is + * made. This second pass checks to see if an element is large enough during + * the search, not after it. If still no acceptable pivot candidate has + * been found, the search expands to cover the entire matrix. + * + * >>> Returned: + * A pointer to the element chosen to be pivot. If every element in the + * matrix is zero, then NULL is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * The row and column number of the beginning of the reduced submatrix. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to element that has been chosen to be the pivot. + * + * >>> Possible errors: + * spSINGULAR + * spSMALL_PIVOT + */ + +static ElementPtr +SearchForPivot( + MatrixPtr Matrix, + int Step, + BOOLEAN DiagPivoting +) +{ +register ElementPtr ChosenPivot; + +/* Begin `SearchForPivot'. */ + +/* If singletons exist, look for an acceptable one to use as pivot. */ + if (Matrix->Singletons) + { ChosenPivot = SearchForSingleton( Matrix, Step ); + if (ChosenPivot != NULL) + { Matrix->PivotSelectionMethod = 's'; + return ChosenPivot; + } + } + +#if DIAGONAL_PIVOTING + if (DiagPivoting) + { +/* + * Either no singletons exist or they weren't acceptable. Take quick first + * pass at searching diagonal. First search for element on diagonal of + * remaining submatrix with smallest Markowitz product, then check to see + * if it okay numerically. If not, QuicklySearchDiagonal fails. + */ + ChosenPivot = QuicklySearchDiagonal( Matrix, Step ); + if (ChosenPivot != NULL) + { Matrix->PivotSelectionMethod = 'q'; + return ChosenPivot; + } + +/* + * Quick search of diagonal failed, carefully search diagonal and check each + * pivot candidate numerically before even tentatively accepting it. + */ + ChosenPivot = SearchDiagonal( Matrix, Step ); + if (ChosenPivot != NULL) + { Matrix->PivotSelectionMethod = 'd'; + return ChosenPivot; + } + } +#endif /* DIAGONAL_PIVOTING */ + +/* No acceptable pivot found yet, search entire matrix. */ + ChosenPivot = SearchEntireMatrix( Matrix, Step ); + Matrix->PivotSelectionMethod = 'e'; + + return ChosenPivot; +} + + + + + + + + + +/* + * SEARCH FOR SINGLETON TO USE AS PIVOT + * + * Performs a search to find a singleton to use as the pivot. The + * first acceptable singleton is used. A singleton is acceptable if + * it is larger in magnitude than the AbsThreshold and larger + * than RelThreshold times the largest of any other elements in the same + * column. It may seem that a singleton need not satisfy the + * relative threshold criterion, however it is necessary to prevent + * excessive growth in the RHS from resulting in overflow during the + * forward and backward substitution. A singleton does not need to + * be on the diagonal to be selected. + * + * >>> Returned: + * A pointer to the singleton chosen to be pivot. In no singleton is + * acceptable, return NULL. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to element that has been chosen to be the pivot. + * PivotMag (RealNumber) + * Magnitude of ChosenPivot. + * Singletons (int) + * The count of the number of singletons that can be used as pivots.. + * A local version of Matrix->Singletons. + * pMarkowitzProduct (long *) + * Pointer that points into MarkowitzProduct array. It is used to quickly + * access successive Markowitz products. + */ + +static ElementPtr +SearchForSingleton( + MatrixPtr Matrix, + int Step +) +{ +register ElementPtr ChosenPivot; +register int I; +register long *pMarkowitzProduct; +int Singletons; +RealNumber PivotMag; + +/* Begin `SearchForSingleton'. */ +/* Initialize pointer that is to scan through MarkowitzProduct vector. */ + pMarkowitzProduct = &(Matrix->MarkowitzProd[Matrix->Size+1]); + Matrix->MarkowitzProd[Matrix->Size+1] = Matrix->MarkowitzProd[Step]; + +/* Decrement the count of available singletons, on the assumption that an + * acceptable one will be found. */ + Singletons = Matrix->Singletons--; + +/* + * Assure that following while loop will always terminate, this is just + * preventive medicine, if things are working right this should never + * be needed. + */ + Matrix->MarkowitzProd[Step-1] = 0; + + while (Singletons-- > 0) + { +/* Singletons exist, find them. */ + +/* + * This is tricky. Am using a pointer to sequentially step through the + * MarkowitzProduct array. Search terminates when singleton (Product = 0) + * is found. Note that the conditional in the while statement + * ( *pMarkowitzProduct ) is true as long as the MarkowitzProduct is not + * equal to zero. The row (and column) index on the diagonal is then + * calculated by subtracting the pointer to the Markowitz product of + * the first diagonal from the pointer to the Markowitz product of the + * desired element, the singleton. + * + * Search proceeds from the end (high row and column numbers) to the + * beginning (low row and column numbers) so that rows and columns with + * large Markowitz products will tend to be move to the bottom of the + * matrix. However, choosing Diag[Step] is desirable because it would + * require no row and column interchanges, so inspect it first by + * putting its Markowitz product at the end of the MarkowitzProd + * vector. + */ + + while ( *pMarkowitzProduct-- ) + { /* + * N bottles of beer on the wall; + * N bottles of beer. + * you take one down and pass it around; + * N-1 bottles of beer on the wall. + */ + } + I = pMarkowitzProduct - Matrix->MarkowitzProd + 1; + +/* Assure that I is valid. */ + if (I < Step) break; /* while (Singletons-- > 0) */ + if (I > Matrix->Size) I = Step; + +/* Singleton has been found in either/both row or/and column I. */ + if ((ChosenPivot = Matrix->Diag[I]) != NULL) + { +/* Singleton lies on the diagonal. */ + PivotMag = ELEMENT_MAG(ChosenPivot); + if + ( PivotMag > Matrix->AbsThreshold AND + PivotMag > Matrix->RelThreshold * + FindBiggestInColExclude( Matrix, ChosenPivot, Step ) + ) return ChosenPivot; + } + else + { +/* Singleton does not lie on diagonal, find it. */ + if (Matrix->MarkowitzCol[I] == 0) + { ChosenPivot = Matrix->FirstInCol[I]; + while ((ChosenPivot != NULL) AND (ChosenPivot->Row < Step)) + ChosenPivot = ChosenPivot->NextInCol; + if (ChosenPivot == NULL) + { /* Reduced column has no elements, matrix is singular. */ + break; + } + PivotMag = ELEMENT_MAG( ChosenPivot ); + if + ( PivotMag > Matrix->AbsThreshold AND + PivotMag > Matrix->RelThreshold * + FindBiggestInColExclude( Matrix, ChosenPivot, + Step ) + ) return ChosenPivot; + else + { if (Matrix->MarkowitzRow[I] == 0) + { ChosenPivot = Matrix->FirstInRow[I]; + while((ChosenPivot != NULL) AND (ChosenPivot->Col<Step)) + ChosenPivot = ChosenPivot->NextInRow; + if (ChosenPivot == NULL) + {/* Reduced row has no elements, matrix is singular. */ + break; + } + PivotMag = ELEMENT_MAG(ChosenPivot); + if + ( PivotMag > Matrix->AbsThreshold AND + PivotMag > Matrix->RelThreshold * + FindBiggestInColExclude( Matrix, + ChosenPivot, + Step ) + ) return ChosenPivot; + } + } + } + else + { ChosenPivot = Matrix->FirstInRow[I]; + while ((ChosenPivot != NULL) AND (ChosenPivot->Col < Step)) + ChosenPivot = ChosenPivot->NextInRow; + if (ChosenPivot == NULL) + { /* Reduced row has no elements, matrix is singular. */ + break; + } + PivotMag = ELEMENT_MAG(ChosenPivot); + if + ( PivotMag > Matrix->AbsThreshold AND + PivotMag > Matrix->RelThreshold * + FindBiggestInColExclude( Matrix, ChosenPivot, + Step ) + ) return ChosenPivot; + } + } +/* Singleton not acceptable (too small), try another. */ + } /* end of while(lSingletons>0) */ + +/* + * All singletons were unacceptable. Restore Matrix->Singletons count. + * Initial assumption that an acceptable singleton would be found was wrong. + */ + Matrix->Singletons++; + return NULL; +} + + + + + + + + + + + + +#if DIAGONAL_PIVOTING +#if MODIFIED_MARKOWITZ +/* + * QUICK SEARCH OF DIAGONAL FOR PIVOT WITH MODIFIED MARKOWITZ CRITERION + * + * Searches the diagonal looking for the best pivot. For a pivot to be + * acceptable it must be larger than the pivot RelThreshold times the largest + * element in its reduced column. Among the acceptable diagonals, the + * one with the smallest MarkowitzProduct is sought. Search terminates + * early if a diagonal is found with a MarkowitzProduct of one and its + * magnitude is larger than the other elements in its row and column. + * Since its MarkowitzProduct is one, there is only one other element in + * both its row and column, and, as a condition for early termination, + * these elements must be located symmetricly in the matrix. If a tie + * occurs between elements of equal MarkowitzProduct, then the element with + * the largest ratio between its magnitude and the largest element in its + * column is used. The search will be terminated after a given number of + * ties have occurred and the best (largest ratio) of the tied element will + * be used as the pivot. The number of ties that will trigger an early + * termination is MinMarkowitzProduct * TIES_MULTIPLIER. + * + * >>> Returned: + * A pointer to the diagonal element chosen to be pivot. If no diagonal is + * acceptable, a NULL is returned. + * + * >>> Arguments: + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to the element that has been chosen to be the pivot. + * LargestOffDiagonal (RealNumber) + * Magnitude of the largest of the off-diagonal terms associated with + * a diagonal with MarkowitzProduct equal to one. + * Magnitude (RealNumber) + * Absolute value of diagonal element. + * MaxRatio (RealNumber) + * Among the elements tied with the smallest Markowitz product, MaxRatio + * is the best (smallest) ratio of LargestInCol to the diagonal Magnitude + * found so far. The smaller the ratio, the better numerically the + * element will be as pivot. + * MinMarkowitzProduct (long) + * Smallest Markowitz product found of pivot candidates that lie along + * diagonal. + * NumberOfTies (int) + * A count of the number of Markowitz ties that have occurred at current + * MarkowitzProduct. + * pDiag (ElementPtr) + * Pointer to current diagonal element. + * pMarkowitzProduct (long *) + * Pointer that points into MarkowitzProduct array. It is used to quickly + * access successive Markowitz products. + * Ratio (RealNumber) + * For the current pivot candidate, Ratio is the ratio of the largest + * element in its column (excluding itself) to its magnitude. + * TiedElements (ElementPtr[]) + * Array of pointers to the elements with the minimum Markowitz + * product. + * pOtherInCol (ElementPtr) + * When there is only one other element in a column other than the + * diagonal, pOtherInCol is used to point to it. Used when Markowitz + * product is to determine if off diagonals are placed symmetricly. + * pOtherInRow (ElementPtr) + * When there is only one other element in a row other than the diagonal, + * pOtherInRow is used to point to it. Used when Markowitz product is + * to determine if off diagonals are placed symmetricly. + */ + +static ElementPtr +QuicklySearchDiagonal( + MatrixPtr Matrix, + int Step +) +{ +register long MinMarkowitzProduct, *pMarkowitzProduct; +register ElementPtr pDiag, pOtherInRow, pOtherInCol; +int I, NumberOfTies = 0; +ElementPtr ChosenPivot, TiedElements[MAX_MARKOWITZ_TIES + 1]; +RealNumber Magnitude, LargestInCol, Ratio, MaxRatio; +RealNumber LargestOffDiagonal; +RealNumber FindBiggestInColExclude(); + +/* Begin `QuicklySearchDiagonal'. */ + NumberOfTies = -1; + MinMarkowitzProduct = LARGEST_LONG_INTEGER; + pMarkowitzProduct = &(Matrix->MarkowitzProd[Matrix->Size+2]); + Matrix->MarkowitzProd[Matrix->Size+1] = Matrix->MarkowitzProd[Step]; + +/* Assure that following while loop will always terminate. */ + Matrix->MarkowitzProd[Step-1] = -1; + +/* + * This is tricky. Am using a pointer in the inner while loop to + * sequentially step through the MarkowitzProduct array. Search + * terminates when the Markowitz product of zero placed at location + * Step-1 is found. The row (and column) index on the diagonal is then + * calculated by subtracting the pointer to the Markowitz product of + * the first diagonal from the pointer to the Markowitz product of the + * desired element. The outer for loop is infinite, broken by using + * break. + * + * Search proceeds from the end (high row and column numbers) to the + * beginning (low row and column numbers) so that rows and columns with + * large Markowitz products will tend to be move to the bottom of the + * matrix. However, choosing Diag[Step] is desirable because it would + * require no row and column interchanges, so inspect it first by + * putting its Markowitz product at the end of the MarkowitzProd + * vector. + */ + + for(;;) /* Endless for loop. */ + { while (MinMarkowitzProduct < *(--pMarkowitzProduct)) + { /* + * N bottles of beer on the wall; + * N bottles of beer. + * You take one down and pass it around; + * N-1 bottles of beer on the wall. + */ + } + + I = pMarkowitzProduct - Matrix->MarkowitzProd; + +/* Assure that I is valid; if I < Step, terminate search. */ + if (I < Step) break; /* Endless for loop */ + if (I > Matrix->Size) I = Step; + + if ((pDiag = Matrix->Diag[I]) == NULL) + continue; /* Endless for loop */ + if ((Magnitude = ELEMENT_MAG(pDiag)) <= Matrix->AbsThreshold) + continue; /* Endless for loop */ + + if (*pMarkowitzProduct == 1) + { +/* Case where only one element exists in row and column other than diagonal. */ + +/* Find off diagonal elements. */ + pOtherInRow = pDiag->NextInRow; + pOtherInCol = pDiag->NextInCol; + if (pOtherInRow == NULL AND pOtherInCol == NULL) + { pOtherInRow = Matrix->FirstInRow[I]; + while(pOtherInRow != NULL) + { if (pOtherInRow->Col >= Step AND pOtherInRow->Col != I) + break; + pOtherInRow = pOtherInRow->NextInRow; + } + pOtherInCol = Matrix->FirstInCol[I]; + while(pOtherInCol != NULL) + { if (pOtherInCol->Row >= Step AND pOtherInCol->Row != I) + break; + pOtherInCol = pOtherInCol->NextInCol; + } + } + +/* Accept diagonal as pivot if diagonal is larger than off diagonals and the + * off diagonals are placed symmetricly. */ + if (pOtherInRow != NULL AND pOtherInCol != NULL) + { if (pOtherInRow->Col == pOtherInCol->Row) + { LargestOffDiagonal = MAX(ELEMENT_MAG(pOtherInRow), + ELEMENT_MAG(pOtherInCol)); + if (Magnitude >= LargestOffDiagonal) + { +/* Accept pivot, it is unlikely to contribute excess error. */ + return pDiag; + } + } + } + } + + if (*pMarkowitzProduct < MinMarkowitzProduct) + { +/* Notice strict inequality in test. This is a new smallest MarkowitzProduct. */ + TiedElements[0] = pDiag; + MinMarkowitzProduct = *pMarkowitzProduct; + NumberOfTies = 0; + } + else + { +/* This case handles Markowitz ties. */ + if (NumberOfTies < MAX_MARKOWITZ_TIES) + { TiedElements[++NumberOfTies] = pDiag; + if (NumberOfTies >= MinMarkowitzProduct * TIES_MULTIPLIER) + break; /* Endless for loop */ + } + } + } /* End of endless for loop. */ + +/* Test to see if any element was chosen as a pivot candidate. */ + if (NumberOfTies < 0) + return NULL; + +/* Determine which of tied elements is best numerically. */ + ChosenPivot = NULL; + MaxRatio = 1.0 / Matrix->RelThreshold; + + for (I = 0; I <= NumberOfTies; I++) + { pDiag = TiedElements[I]; + Magnitude = ELEMENT_MAG(pDiag); + LargestInCol = FindBiggestInColExclude( Matrix, pDiag, Step ); + Ratio = LargestInCol / Magnitude; + if (Ratio < MaxRatio) + { ChosenPivot = pDiag; + MaxRatio = Ratio; + } + } + return ChosenPivot; +} + + + + + + + + + + +#else /* Not MODIFIED_MARKOWITZ */ +/* + * QUICK SEARCH OF DIAGONAL FOR PIVOT WITH CONVENTIONAL MARKOWITZ + * CRITERION + * + * Searches the diagonal looking for the best pivot. For a pivot to be + * acceptable it must be larger than the pivot RelThreshold times the largest + * element in its reduced column. Among the acceptable diagonals, the + * one with the smallest MarkowitzProduct is sought. Search terminates + * early if a diagonal is found with a MarkowitzProduct of one and its + * magnitude is larger than the other elements in its row and column. + * Since its MarkowitzProduct is one, there is only one other element in + * both its row and column, and, as a condition for early termination, + * these elements must be located symmetricly in the matrix. + * + * >>> Returned: + * A pointer to the diagonal element chosen to be pivot. If no diagonal is + * acceptable, a NULL is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to the element that has been chosen to be the pivot. + * LargestOffDiagonal (RealNumber) + * Magnitude of the largest of the off-diagonal terms associated with + * a diagonal with MarkowitzProduct equal to one. + * Magnitude (RealNumber) + * Absolute value of diagonal element. + * MinMarkowitzProduct (long) + * Smallest Markowitz product found of pivot candidates which are + * acceptable. + * pDiag (ElementPtr) + * Pointer to current diagonal element. + * pMarkowitzProduct (long *) + * Pointer that points into MarkowitzProduct array. It is used to quickly + * access successive Markowitz products. + * pOtherInCol (ElementPtr) + * When there is only one other element in a column other than the + * diagonal, pOtherInCol is used to point to it. Used when Markowitz + * product is to determine if off diagonals are placed symmetricly. + * pOtherInRow (ElementPtr) + * When there is only one other element in a row other than the diagonal, + * pOtherInRow is used to point to it. Used when Markowitz product is + * to determine if off diagonals are placed symmetricly. + */ + +static ElementPtr +QuicklySearchDiagonal( + MatrixPtr Matrix, + int Step +) +{ +register long MinMarkowitzProduct, *pMarkowitzProduct; +register ElementPtr pDiag; +int I; +ElementPtr ChosenPivot, pOtherInRow, pOtherInCol; +RealNumber Magnitude, LargestInCol, LargestOffDiagonal; +RealNumber FindBiggestInColExclude(); + +/* Begin `QuicklySearchDiagonal'. */ + ChosenPivot = NULL; + MinMarkowitzProduct = LARGEST_LONG_INTEGER; + pMarkowitzProduct = &(Matrix->MarkowitzProd[Matrix->Size+2]); + Matrix->MarkowitzProd[Matrix->Size+1] = Matrix->MarkowitzProd[Step]; + +/* Assure that following while loop will always terminate. */ + Matrix->MarkowitzProd[Step-1] = -1; + +/* + * This is tricky. Am using a pointer in the inner while loop to + * sequentially step through the MarkowitzProduct array. Search + * terminates when the Markowitz product of zero placed at location + * Step-1 is found. The row (and column) index on the diagonal is then + * calculated by subtracting the pointer to the Markowitz product of + * the first diagonal from the pointer to the Markowitz product of the + * desired element. The outer for loop is infinite, broken by using + * break. + * + * Search proceeds from the end (high row and column numbers) to the + * beginning (low row and column numbers) so that rows and columns with + * large Markowitz products will tend to be move to the bottom of the + * matrix. However, choosing Diag[Step] is desirable because it would + * require no row and column interchanges, so inspect it first by + * putting its Markowitz product at the end of the MarkowitzProd + * vector. + */ + + for (;;) /* Endless for loop. */ + { while (*(--pMarkowitzProduct) >= MinMarkowitzProduct) + { /* Just passing through. */ + } + + I = pMarkowitzProduct - Matrix->MarkowitzProd; + +/* Assure that I is valid; if I < Step, terminate search. */ + if (I < Step) break; /* Endless for loop */ + if (I > Matrix->Size) I = Step; + + if ((pDiag = Matrix->Diag[I]) == NULL) + continue; /* Endless for loop */ + if ((Magnitude = ELEMENT_MAG(pDiag)) <= Matrix->AbsThreshold) + continue; /* Endless for loop */ + + if (*pMarkowitzProduct == 1) + { +/* Case where only one element exists in row and column other than diagonal. */ + +/* Find off-diagonal elements. */ + pOtherInRow = pDiag->NextInRow; + pOtherInCol = pDiag->NextInCol; + if (pOtherInRow == NULL AND pOtherInCol == NULL) + { pOtherInRow = Matrix->FirstInRow[I]; + while(pOtherInRow != NULL) + { if (pOtherInRow->Col >= Step AND pOtherInRow->Col != I) + break; + pOtherInRow = pOtherInRow->NextInRow; + } + pOtherInCol = Matrix->FirstInCol[I]; + while(pOtherInCol != NULL) + { if (pOtherInCol->Row >= Step AND pOtherInCol->Row != I) + break; + pOtherInCol = pOtherInCol->NextInCol; + } + } + +/* Accept diagonal as pivot if diagonal is larger than off-diagonals and the + * off-diagonals are placed symmetricly. */ + if (pOtherInRow != NULL AND pOtherInCol != NULL) + { if (pOtherInRow->Col == pOtherInCol->Row) + { LargestOffDiagonal = MAX(ELEMENT_MAG(pOtherInRow), + ELEMENT_MAG(pOtherInCol)); + if (Magnitude >= LargestOffDiagonal) + { +/* Accept pivot, it is unlikely to contribute excess error. */ + return pDiag; + } + } + } + } + + MinMarkowitzProduct = *pMarkowitzProduct; + ChosenPivot = pDiag; + } /* End of endless for loop. */ + + if (ChosenPivot != NULL) + { LargestInCol = FindBiggestInColExclude( Matrix, ChosenPivot, Step ); + if( ELEMENT_MAG(ChosenPivot) <= Matrix->RelThreshold * LargestInCol ) + ChosenPivot = NULL; + } + return ChosenPivot; +} +#endif /* Not MODIFIED_MARKOWITZ */ + + + + + + + + + +/* + * SEARCH DIAGONAL FOR PIVOT WITH MODIFIED MARKOWITZ CRITERION + * + * Searches the diagonal looking for the best pivot. For a pivot to be + * acceptable it must be larger than the pivot RelThreshold times the largest + * element in its reduced column. Among the acceptable diagonals, the + * one with the smallest MarkowitzProduct is sought. If a tie occurs + * between elements of equal MarkowitzProduct, then the element with + * the largest ratio between its magnitude and the largest element in its + * column is used. The search will be terminated after a given number of + * ties have occurred and the best (smallest ratio) of the tied element will + * be used as the pivot. The number of ties that will trigger an early + * termination is MinMarkowitzProduct * TIES_MULTIPLIER. + * + * >>> Returned: + * A pointer to the diagonal element chosen to be pivot. If no diagonal is + * acceptable, a NULL is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to the element that has been chosen to be the pivot. + * Size (int) + * Local version of size which is placed in a register to increase speed. + * Magnitude (RealNumber) + * Absolute value of diagonal element. + * MinMarkowitzProduct (long) + * Smallest Markowitz product found of those pivot candidates which are + * acceptable. + * NumberOfTies (int) + * A count of the number of Markowitz ties that have occurred at current + * MarkowitzProduct. + * pDiag (ElementPtr) + * Pointer to current diagonal element. + * pMarkowitzProduct (long*) + * Pointer that points into MarkowitzProduct array. It is used to quickly + * access successive Markowitz products. + * Ratio (RealNumber) + * For the current pivot candidate, Ratio is the + * Ratio of the largest element in its column to its magnitude. + * RatioOfAccepted (RealNumber) + * For the best pivot candidate found so far, RatioOfAccepted is the + * Ratio of the largest element in its column to its magnitude. + */ + +static ElementPtr +SearchDiagonal( + MatrixPtr Matrix, + register int Step +) +{ +register int J; +register long MinMarkowitzProduct, *pMarkowitzProduct; +register int I; +register ElementPtr pDiag; +int NumberOfTies = 0, Size = Matrix->Size; +ElementPtr ChosenPivot; +RealNumber Magnitude, Ratio, RatioOfAccepted = 0.0, LargestInCol; +RealNumber FindBiggestInColExclude(); + +/* Begin `SearchDiagonal'. */ + ChosenPivot = NULL; + MinMarkowitzProduct = LARGEST_LONG_INTEGER; + pMarkowitzProduct = &(Matrix->MarkowitzProd[Size+2]); + Matrix->MarkowitzProd[Size+1] = Matrix->MarkowitzProd[Step]; + +/* Start search of diagonal. */ + for (J = Size+1; J > Step; J--) + { + if (*(--pMarkowitzProduct) > MinMarkowitzProduct) + continue; /* for loop */ + if (J > Matrix->Size) + I = Step; + else + I = J; + if ((pDiag = Matrix->Diag[I]) == NULL) + continue; /* for loop */ + if ((Magnitude = ELEMENT_MAG(pDiag)) <= Matrix->AbsThreshold) + continue; /* for loop */ + +/* Test to see if diagonal's magnitude is acceptable. */ + LargestInCol = FindBiggestInColExclude( Matrix, pDiag, Step ); + if (Magnitude <= Matrix->RelThreshold * LargestInCol) + continue; /* for loop */ + + if (*pMarkowitzProduct < MinMarkowitzProduct) + { +/* Notice strict inequality in test. This is a new smallest MarkowitzProduct. */ + ChosenPivot = pDiag; + MinMarkowitzProduct = *pMarkowitzProduct; + RatioOfAccepted = LargestInCol / Magnitude; + NumberOfTies = 0; + } + else + { +/* This case handles Markowitz ties. */ + NumberOfTies++; + Ratio = LargestInCol / Magnitude; + if (Ratio < RatioOfAccepted) + { ChosenPivot = pDiag; + RatioOfAccepted = Ratio; + } + if (NumberOfTies >= MinMarkowitzProduct * TIES_MULTIPLIER) + return ChosenPivot; + } + } /* End of for(Step) */ + return ChosenPivot; +} +#endif /* DIAGONAL_PIVOTING */ + + + + + + + + + + +/* + * SEARCH ENTIRE MATRIX FOR BEST PIVOT + * + * Performs a search over the entire matrix looking for the acceptable + * element with the lowest MarkowitzProduct. If there are several that + * are tied for the smallest MarkowitzProduct, the tie is broken by using + * the ratio of the magnitude of the element being considered to the largest + * element in the same column. If no element is acceptable then the largest + * element in the reduced submatrix is used as the pivot and the + * matrix is declared to be spSMALL_PIVOT. If the largest element is + * zero, the matrix is declared to be spSINGULAR. + * + * >>> Returned: + * A pointer to the diagonal element chosen to be pivot. If no element is + * found, then NULL is returned and the matrix is spSINGULAR. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * ChosenPivot (ElementPtr) + * Pointer to the element that has been chosen to be the pivot. + * LargestElementMag (RealNumber) + * Magnitude of the largest element yet found in the reduced submatrix. + * Size (int) + * Local version of Size; placed in a register for speed. + * Magnitude (RealNumber) + * Absolute value of diagonal element. + * MinMarkowitzProduct (long) + * Smallest Markowitz product found of pivot candidates which are + * acceptable. + * NumberOfTies (int) + * A count of the number of Markowitz ties that have occurred at current + * MarkowitzProduct. + * pElement (ElementPtr) + * Pointer to current element. + * pLargestElement (ElementPtr) + * Pointer to the largest element yet found in the reduced submatrix. + * Product (long) + * Markowitz product for the current row and column. + * Ratio (RealNumber) + * For the current pivot candidate, Ratio is the + * Ratio of the largest element in its column to its magnitude. + * RatioOfAccepted (RealNumber) + * For the best pivot candidate found so far, RatioOfAccepted is the + * Ratio of the largest element in its column to its magnitude. + * + * >>> Possible errors: + * spSINGULAR + * spSMALL_PIVOT + */ + +static ElementPtr +SearchEntireMatrix( + MatrixPtr Matrix, + int Step +) +{ +register int I, Size = Matrix->Size; +register ElementPtr pElement; +int NumberOfTies = 0; +long Product, MinMarkowitzProduct; +ElementPtr ChosenPivot, pLargestElement = NULL; +RealNumber Magnitude, LargestElementMag, Ratio, RatioOfAccepted = 0.0, LargestInCol; + +/* Begin `SearchEntireMatrix'. */ + ChosenPivot = NULL; + LargestElementMag = 0.0; + MinMarkowitzProduct = LARGEST_LONG_INTEGER; + +/* Start search of matrix on column by column basis. */ + for (I = Step; I <= Size; I++) + { pElement = Matrix->FirstInCol[I]; + + while (pElement != NULL AND pElement->Row < Step) + pElement = pElement->NextInCol; + + if((LargestInCol = FindLargestInCol(pElement)) == 0.0) + continue; /* for loop */ + + while (pElement != NULL) + { +/* Check to see if element is the largest encountered so far. If so, record + its magnitude and address. */ + if ((Magnitude = ELEMENT_MAG(pElement)) > LargestElementMag) + { LargestElementMag = Magnitude; + pLargestElement = pElement; + } +/* Calculate element's MarkowitzProduct. */ + spcMarkoProd( Product, Matrix->MarkowitzRow[pElement->Row], + Matrix->MarkowitzCol[pElement->Col] ); + +/* Test to see if element is acceptable as a pivot candidate. */ + if ((Product <= MinMarkowitzProduct) AND + (Magnitude > Matrix->RelThreshold * LargestInCol) AND + (Magnitude > Matrix->AbsThreshold)) + { +/* Test to see if element has lowest MarkowitzProduct yet found, or whether it + is tied with an element found earlier. */ + if (Product < MinMarkowitzProduct) + { +/* Notice strict inequality in test. This is a new smallest MarkowitzProduct. */ + ChosenPivot = pElement; + MinMarkowitzProduct = Product; + RatioOfAccepted = LargestInCol / Magnitude; + NumberOfTies = 0; + } + else + { +/* This case handles Markowitz ties. */ + NumberOfTies++; + Ratio = LargestInCol / Magnitude; + if (Ratio < RatioOfAccepted) + { ChosenPivot = pElement; + RatioOfAccepted = Ratio; + } + if (NumberOfTies >= MinMarkowitzProduct * TIES_MULTIPLIER) + return ChosenPivot; + } + } + pElement = pElement->NextInCol; + } /* End of while(pElement != NULL) */ + } /* End of for(Step) */ + + if (ChosenPivot != NULL) return ChosenPivot; + + if (LargestElementMag == 0.0) + { Matrix->Error = spSINGULAR; + return NULL; + } + + Matrix->Error = spSMALL_PIVOT; + return pLargestElement; +} + + + + + + + + + + + + +/* + * DETERMINE THE MAGNITUDE OF THE LARGEST ELEMENT IN A COLUMN + * + * This routine searches a column and returns the magnitude of the largest + * element. This routine begins the search at the element pointed to by + * pElement, the parameter. + * + * The search is conducted by starting at the element specified by a pointer, + * which should be one below the diagonal, and moving down the column. On + * the way down the column, the magnitudes of the elements are tested to see + * if they are the largest yet found. + * + * >>> Returned: + * The magnitude of the largest element in the column below and including + * the one pointed to by the input parameter. + * + * >>> Arguments: + * pElement <input> (ElementPtr) + * The pointer to the first element to be tested. Also, used by the + * routine to access all lower elements in the column. + * + * >>> Local variables: + * Largest (RealNumber) + * The magnitude of the largest element. + * Magnitude (RealNumber) + * The magnitude of the currently active element. + */ + +static RealNumber +FindLargestInCol( register ElementPtr pElement ) +{ +RealNumber Magnitude, Largest = 0.0; + +/* Begin `FindLargestInCol'. */ +/* Search column for largest element beginning at Element. */ + while (pElement != NULL) + { if ((Magnitude = ELEMENT_MAG(pElement)) > Largest) + Largest = Magnitude; + pElement = pElement->NextInCol; + } + + return Largest; +} + + + + + + + + + + +/* + * DETERMINE THE MAGNITUDE OF THE LARGEST ELEMENT IN A COLUMN + * EXCLUDING AN ELEMENT + * + * This routine searches a column and returns the magnitude of the largest + * element. One given element is specifically excluded from the search.. + * + * The search is conducted by starting at the first element in the column + * and moving down the column until the active part of the matrix is entered, + * i.e. the reduced submatrix. The rest of the column is then traversed + * looking for the largest element. + * + * >>> Returned: + * The magnitude of the largest element in the active portion of the column, + * excluding the specified element, is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * pElement <input> (ElementPtr) + * The pointer to the element that is to be excluded from search. Column + * to be searched is one that contains this element. Also used to + * access the elements in the column. + * Step <input> (int) + * Index of the diagonal currently being eliminated. Indicates where + * the active part of the matrix begins. + * + * >>> Local variables: + * Col (int) + * The number of the column to be searched. Also the column number of + * the element to be avoided in the search. + * Largest (RealNumber) + * The magnitude of the largest element. + * Magnitude (RealNumber) + * The magnitude of the currently active element. + * Row (int) + * The row number of element to be excluded from the search. + */ + +static RealNumber +FindBiggestInColExclude( + MatrixPtr Matrix, + register ElementPtr pElement, + register int Step +) +{ +register int Row; +int Col; +RealNumber Largest, Magnitude; + +/* Begin `FindBiggestInColExclude'. */ + Row = pElement->Row; + Col = pElement->Col; + pElement = Matrix->FirstInCol[Col]; + +/* Travel down column until reduced submatrix is entered. */ + while ((pElement != NULL) AND (pElement->Row < Step)) + pElement = pElement->NextInCol; + +/* Initialize the variable Largest. */ + if (pElement->Row != Row) + Largest = ELEMENT_MAG(pElement); + else + Largest = 0.0; + +/* Search rest of column for largest element, avoiding excluded element. */ + while ((pElement = pElement->NextInCol) != NULL) + { if ((Magnitude = ELEMENT_MAG(pElement)) > Largest) + { if (pElement->Row != Row) + Largest = Magnitude; + } + } + + return Largest; +} + + + + + + + + + + +/* + * EXCHANGE ROWS AND COLUMNS + * + * Exchanges two rows and two columns so that the selected pivot is moved to + * the upper left corner of the remaining submatrix. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * pPivot <input> (ElementPtr) + * Pointer to the current pivot. + * Step <input> (int) + * Index of the diagonal currently being eliminated. + * + * >>> Local variables: + * Col (int) + * Column where the pivot was found. + * Row (int) + * Row where the pivot was found. + * OldMarkowitzProd_Col (long) + * Markowitz product associated with the diagonal element in the row + * the pivot was found in. + * OldMarkowitzProd_Row (long) + * Markowitz product associated with the diagonal element in the column + * the pivot was found in. + * OldMarkowitzProd_Step (long) + * Markowitz product associated with the diagonal element that is being + * moved so that the pivot can be placed in the upper left-hand corner + * of the reduced submatrix. + */ + +static void +ExchangeRowsAndCols( + MatrixPtr Matrix, + ElementPtr pPivot, + register int Step +) +{ +register int Row, Col; +long OldMarkowitzProd_Step, OldMarkowitzProd_Row, OldMarkowitzProd_Col; + +/* Begin `ExchangeRowsAndCols'. */ + Row = pPivot->Row; + Col = pPivot->Col; + Matrix->PivotsOriginalRow = Row; + Matrix->PivotsOriginalCol = Col; + + if ((Row == Step) AND (Col == Step)) return; + +/* Exchange rows and columns. */ + if (Row == Col) + { spcRowExchange( Matrix, Step, Row ); + spcColExchange( Matrix, Step, Col ); + SWAP( long, Matrix->MarkowitzProd[Step], Matrix->MarkowitzProd[Row] ); + SWAP( ElementPtr, Matrix->Diag[Row], Matrix->Diag[Step] ); + } + else + { + +/* Initialize variables that hold old Markowitz products. */ + OldMarkowitzProd_Step = Matrix->MarkowitzProd[Step]; + OldMarkowitzProd_Row = Matrix->MarkowitzProd[Row]; + OldMarkowitzProd_Col = Matrix->MarkowitzProd[Col]; + +/* Exchange rows. */ + if (Row != Step) + { spcRowExchange( Matrix, Step, Row ); + Matrix->NumberOfInterchangesIsOdd = + NOT Matrix->NumberOfInterchangesIsOdd; + spcMarkoProd( Matrix->MarkowitzProd[Row], + Matrix->MarkowitzRow[Row], + Matrix->MarkowitzCol[Row] ); + +/* Update singleton count. */ + if ((Matrix->MarkowitzProd[Row]==0) != (OldMarkowitzProd_Row==0)) + { if (OldMarkowitzProd_Row == 0) + Matrix->Singletons--; + else + Matrix->Singletons++; + } + } + +/* Exchange columns. */ + if (Col != Step) + { spcColExchange( Matrix, Step, Col ); + Matrix->NumberOfInterchangesIsOdd = + NOT Matrix->NumberOfInterchangesIsOdd; + spcMarkoProd( Matrix->MarkowitzProd[Col], + Matrix->MarkowitzCol[Col], + Matrix->MarkowitzRow[Col] ); + +/* Update singleton count. */ + if ((Matrix->MarkowitzProd[Col]==0) != (OldMarkowitzProd_Col==0)) + { if (OldMarkowitzProd_Col == 0) + Matrix->Singletons--; + else + Matrix->Singletons++; + } + + Matrix->Diag[Col] = spcFindDiag( Matrix, Col ); + } + if (Row != Step) + Matrix->Diag[Row] = spcFindDiag( Matrix, Row ); + Matrix->Diag[Step] = spcFindDiag( Matrix, Step ); + +/* Update singleton count. */ + Matrix->MarkowitzProd[Step] = Matrix->MarkowitzCol[Step] * + Matrix->MarkowitzRow[Step]; + if ((Matrix->MarkowitzProd[Step]==0) != (OldMarkowitzProd_Step==0)) + { if (OldMarkowitzProd_Step == 0) + Matrix->Singletons--; + else + Matrix->Singletons++; + } + } + return; +} + + + + + + + + + +/* + * EXCHANGE ROWS + * + * Performs all required operations to exchange two rows. Those operations + * include: swap FirstInRow pointers, fixing up the NextInCol pointers, + * swapping row indexes in MatrixElements, and swapping Markowitz row + * counts. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * Row1 <input> (int) + * Row index of one of the rows, becomes the smallest index. + * Row2 <input> (int) + * Row index of the other row, becomes the largest index. + * + * Local variables: + * Column (int) + * Column in which row elements are currently being exchanged. + * Row1Ptr (ElementPtr) + * Pointer to an element in Row1. + * Row2Ptr (ElementPtr) + * Pointer to an element in Row2. + * Element1 (ElementPtr) + * Pointer to the element in Row1 to be exchanged. + * Element2 (ElementPtr) + * Pointer to the element in Row2 to be exchanged. + */ + +void +spcRowExchange( + MatrixPtr Matrix, + int Row1, + int Row2 +) +{ +register ElementPtr Row1Ptr, Row2Ptr; +int Column; +ElementPtr Element1, Element2; + +/* Begin `spcRowExchange'. */ + if (Row1 > Row2) SWAP(int, Row1, Row2); + + Row1Ptr = Matrix->FirstInRow[Row1]; + Row2Ptr = Matrix->FirstInRow[Row2]; + while (Row1Ptr != NULL OR Row2Ptr != NULL) + { +/* Exchange elements in rows while traveling from left to right. */ + if (Row1Ptr == NULL) + { Column = Row2Ptr->Col; + Element1 = NULL; + Element2 = Row2Ptr; + Row2Ptr = Row2Ptr->NextInRow; + } + else if (Row2Ptr == NULL) + { Column = Row1Ptr->Col; + Element1 = Row1Ptr; + Element2 = NULL; + Row1Ptr = Row1Ptr->NextInRow; + } + else if (Row1Ptr->Col < Row2Ptr->Col) + { Column = Row1Ptr->Col; + Element1 = Row1Ptr; + Element2 = NULL; + Row1Ptr = Row1Ptr->NextInRow; + } + else if (Row1Ptr->Col > Row2Ptr->Col) + { Column = Row2Ptr->Col; + Element1 = NULL; + Element2 = Row2Ptr; + Row2Ptr = Row2Ptr->NextInRow; + } + else /* Row1Ptr->Col == Row2Ptr->Col */ + { Column = Row1Ptr->Col; + Element1 = Row1Ptr; + Element2 = Row2Ptr; + Row1Ptr = Row1Ptr->NextInRow; + Row2Ptr = Row2Ptr->NextInRow; + } + + ExchangeColElements( Matrix, Row1, Element1, Row2, Element2, Column); + } /* end of while(Row1Ptr != NULL OR Row2Ptr != NULL) */ + + if (Matrix->InternalVectorsAllocated) + SWAP( int, Matrix->MarkowitzRow[Row1], Matrix->MarkowitzRow[Row2]); + SWAP( ElementPtr, Matrix->FirstInRow[Row1], Matrix->FirstInRow[Row2]); + SWAP( int, Matrix->IntToExtRowMap[Row1], Matrix->IntToExtRowMap[Row2]); +#if TRANSLATE + Matrix->ExtToIntRowMap[ Matrix->IntToExtRowMap[Row1] ] = Row1; + Matrix->ExtToIntRowMap[ Matrix->IntToExtRowMap[Row2] ] = Row2; +#endif + + return; +} + + + + + + + + + +/* + * EXCHANGE COLUMNS + * + * Performs all required operations to exchange two columns. Those operations + * include: swap FirstInCol pointers, fixing up the NextInRow pointers, + * swapping column indexes in MatrixElements, and swapping Markowitz + * column counts. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * Col1 <input> (int) + * Column index of one of the columns, becomes the smallest index. + * Col2 <input> (int) + * Column index of the other column, becomes the largest index + * + * Local variables: + * Row (int) + * Row in which column elements are currently being exchanged. + * Col1Ptr (ElementPtr) + * Pointer to an element in Col1. + * Col2Ptr (ElementPtr) + * Pointer to an element in Col2. + * Element1 (ElementPtr) + * Pointer to the element in Col1 to be exchanged. + * Element2 (ElementPtr) + * Pointer to the element in Col2 to be exchanged. + */ + +void +spcColExchange( + MatrixPtr Matrix, + int Col1, + int Col2 +) +{ +register ElementPtr Col1Ptr, Col2Ptr; +int Row; +ElementPtr Element1, Element2; + +/* Begin `spcColExchange'. */ + if (Col1 > Col2) SWAP(int, Col1, Col2); + + Col1Ptr = Matrix->FirstInCol[Col1]; + Col2Ptr = Matrix->FirstInCol[Col2]; + while (Col1Ptr != NULL OR Col2Ptr != NULL) + { +/* Exchange elements in rows while traveling from top to bottom. */ + if (Col1Ptr == NULL) + { Row = Col2Ptr->Row; + Element1 = NULL; + Element2 = Col2Ptr; + Col2Ptr = Col2Ptr->NextInCol; + } + else if (Col2Ptr == NULL) + { Row = Col1Ptr->Row; + Element1 = Col1Ptr; + Element2 = NULL; + Col1Ptr = Col1Ptr->NextInCol; + } + else if (Col1Ptr->Row < Col2Ptr->Row) + { Row = Col1Ptr->Row; + Element1 = Col1Ptr; + Element2 = NULL; + Col1Ptr = Col1Ptr->NextInCol; + } + else if (Col1Ptr->Row > Col2Ptr->Row) + { Row = Col2Ptr->Row; + Element1 = NULL; + Element2 = Col2Ptr; + Col2Ptr = Col2Ptr->NextInCol; + } + else /* Col1Ptr->Row == Col2Ptr->Row */ + { Row = Col1Ptr->Row; + Element1 = Col1Ptr; + Element2 = Col2Ptr; + Col1Ptr = Col1Ptr->NextInCol; + Col2Ptr = Col2Ptr->NextInCol; + } + + ExchangeRowElements( Matrix, Col1, Element1, Col2, Element2, Row); + } /* end of while(Col1Ptr != NULL OR Col2Ptr != NULL) */ + + if (Matrix->InternalVectorsAllocated) + SWAP( int, Matrix->MarkowitzCol[Col1], Matrix->MarkowitzCol[Col2]); + SWAP( ElementPtr, Matrix->FirstInCol[Col1], Matrix->FirstInCol[Col2]); + SWAP( int, Matrix->IntToExtColMap[Col1], Matrix->IntToExtColMap[Col2]); +#if TRANSLATE + Matrix->ExtToIntColMap[ Matrix->IntToExtColMap[Col1] ] = Col1; + Matrix->ExtToIntColMap[ Matrix->IntToExtColMap[Col2] ] = Col2; +#endif + + return; +} + + + + + + + +/* + * EXCHANGE TWO ELEMENTS IN A COLUMN + * + * Performs all required operations to exchange two elements in a column. + * Those operations are: restring NextInCol pointers and swapping row indexes + * in the MatrixElements. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * Row1 <input> (int) + * Row of top element to be exchanged. + * Element1 <input> (ElementPtr) + * Pointer to top element to be exchanged. + * Row2 <input> (int) + * Row of bottom element to be exchanged. + * Element2 <input> (ElementPtr) + * Pointer to bottom element to be exchanged. + * Column <input> (int) + * Column that exchange is to take place in. + * + * >>> Local variables: + * ElementAboveRow1 (ElementPtr *) + * Location of pointer which points to the element above Element1. This + * pointer is modified so that it points to correct element on exit.. + * ElementAboveRow2 (ElementPtr *) + * Location of pointer which points to the element above Element2. This + * pointer is modified so that it points to correct element on exit.. + * ElementBelowRow1 (ElementPtr) + * Pointer to element below Element1. + * ElementBelowRow2 (ElementPtr) + * Pointer to element below Element2. + * pElement (ElementPtr) + * Pointer used to traverse the column. + */ + +static void +ExchangeColElements( + MatrixPtr Matrix, + int Row1, + register ElementPtr Element1, + int Row2, + register ElementPtr Element2, + int Column +) +{ +ElementPtr *ElementAboveRow1, *ElementAboveRow2; +ElementPtr ElementBelowRow1, ElementBelowRow2; +register ElementPtr pElement; + +/* Begin `ExchangeColElements'. */ +/* Search to find the ElementAboveRow1. */ + ElementAboveRow1 = &(Matrix->FirstInCol[Column]); + pElement = *ElementAboveRow1; + while (pElement->Row < Row1) + { ElementAboveRow1 = &(pElement->NextInCol); + pElement = *ElementAboveRow1; + } + if (Element1 != NULL) + { ElementBelowRow1 = Element1->NextInCol; + if (Element2 == NULL) + { +/* Element2 does not exist, move Element1 down to Row2. */ + if ( ElementBelowRow1 != NULL AND ElementBelowRow1->Row < Row2 ) + { +/* Element1 must be removed from linked list and moved. */ + *ElementAboveRow1 = ElementBelowRow1; + +/* Search column for Row2. */ + pElement = ElementBelowRow1; + do + { ElementAboveRow2 = &(pElement->NextInCol); + pElement = *ElementAboveRow2; + } while (pElement != NULL AND pElement->Row < Row2); + +/* Place Element1 in Row2. */ + *ElementAboveRow2 = Element1; + Element1->NextInCol = pElement; + *ElementAboveRow1 =ElementBelowRow1; + } + Element1->Row = Row2; + } + else + { +/* Element2 does exist, and the two elements must be exchanged. */ + if ( ElementBelowRow1->Row == Row2) + { +/* Element2 is just below Element1, exchange them. */ + Element1->NextInCol = Element2->NextInCol; + Element2->NextInCol = Element1; + *ElementAboveRow1 = Element2; + } + else + { +/* Element2 is not just below Element1 and must be searched for. */ + pElement = ElementBelowRow1; + do + { ElementAboveRow2 = &(pElement->NextInCol); + pElement = *ElementAboveRow2; + } while (pElement->Row < Row2); + + ElementBelowRow2 = Element2->NextInCol; + +/* Switch Element1 and Element2. */ + *ElementAboveRow1 = Element2; + Element2->NextInCol = ElementBelowRow1; + *ElementAboveRow2 = Element1; + Element1->NextInCol = ElementBelowRow2; + } + Element1->Row = Row2; + Element2->Row = Row1; + } + } + else + { +/* Element1 does not exist. */ + ElementBelowRow1 = pElement; + +/* Find Element2. */ + if (ElementBelowRow1->Row != Row2) + { do + { ElementAboveRow2 = &(pElement->NextInCol); + pElement = *ElementAboveRow2; + } while (pElement->Row < Row2); + + ElementBelowRow2 = Element2->NextInCol; + +/* Move Element2 to Row1. */ + *ElementAboveRow2 = Element2->NextInCol; + *ElementAboveRow1 = Element2; + Element2->NextInCol = ElementBelowRow1; + } + Element2->Row = Row1; + } + return; +} + + + + + + + +/* + * EXCHANGE TWO ELEMENTS IN A ROW + * + * Performs all required operations to exchange two elements in a row. + * Those operations are: restring NextInRow pointers and swapping column + * indexes in the MatrixElements. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * Col1 <input> (int) + * Col of left-most element to be exchanged. + * Element1 <input> (ElementPtr) + * Pointer to left-most element to be exchanged. + * Col2 <input> (int) + * Col of right-most element to be exchanged. + * Element2 <input> (ElementPtr) + * Pointer to right-most element to be exchanged. + * Row <input> (int) + * Row that exchange is to take place in. + * + * >>> Local variables: + * ElementLeftOfCol1 (ElementPtr *) + * Location of pointer which points to the element to the left of + * Element1. This pointer is modified so that it points to correct + * element on exit. + * ElementLeftOfCol2 (ElementPtr *) + * Location of pointer which points to the element to the left of + * Element2. This pointer is modified so that it points to correct + * element on exit. + * ElementRightOfCol1 (ElementPtr) + * Pointer to element right of Element1. + * ElementRightOfCol2 (ElementPtr) + * Pointer to element right of Element2. + * pElement (ElementPtr) + * Pointer used to traverse the row. + */ + +static void +ExchangeRowElements( + MatrixPtr Matrix, + int Col1, + register ElementPtr Element1, + int Col2, + register ElementPtr Element2, + int Row +) +{ +ElementPtr *ElementLeftOfCol1, *ElementLeftOfCol2; +ElementPtr ElementRightOfCol1, ElementRightOfCol2; +register ElementPtr pElement; + +/* Begin `ExchangeRowElements'. */ +/* Search to find the ElementLeftOfCol1. */ + ElementLeftOfCol1 = &(Matrix->FirstInRow[Row]); + pElement = *ElementLeftOfCol1; + while (pElement->Col < Col1) + { ElementLeftOfCol1 = &(pElement->NextInRow); + pElement = *ElementLeftOfCol1; + } + if (Element1 != NULL) + { ElementRightOfCol1 = Element1->NextInRow; + if (Element2 == NULL) + { +/* Element2 does not exist, move Element1 to right to Col2. */ + if ( ElementRightOfCol1 != NULL AND ElementRightOfCol1->Col < Col2 ) + { +/* Element1 must be removed from linked list and moved. */ + *ElementLeftOfCol1 = ElementRightOfCol1; + +/* Search Row for Col2. */ + pElement = ElementRightOfCol1; + do + { ElementLeftOfCol2 = &(pElement->NextInRow); + pElement = *ElementLeftOfCol2; + } while (pElement != NULL AND pElement->Col < Col2); + +/* Place Element1 in Col2. */ + *ElementLeftOfCol2 = Element1; + Element1->NextInRow = pElement; + *ElementLeftOfCol1 =ElementRightOfCol1; + } + Element1->Col = Col2; + } + else + { +/* Element2 does exist, and the two elements must be exchanged. */ + if ( ElementRightOfCol1->Col == Col2) + { +/* Element2 is just right of Element1, exchange them. */ + Element1->NextInRow = Element2->NextInRow; + Element2->NextInRow = Element1; + *ElementLeftOfCol1 = Element2; + } + else + { +/* Element2 is not just right of Element1 and must be searched for. */ + pElement = ElementRightOfCol1; + do + { ElementLeftOfCol2 = &(pElement->NextInRow); + pElement = *ElementLeftOfCol2; + } while (pElement->Col < Col2); + + ElementRightOfCol2 = Element2->NextInRow; + +/* Switch Element1 and Element2. */ + *ElementLeftOfCol1 = Element2; + Element2->NextInRow = ElementRightOfCol1; + *ElementLeftOfCol2 = Element1; + Element1->NextInRow = ElementRightOfCol2; + } + Element1->Col = Col2; + Element2->Col = Col1; + } + } + else + { +/* Element1 does not exist. */ + ElementRightOfCol1 = pElement; + +/* Find Element2. */ + if (ElementRightOfCol1->Col != Col2) + { do + { ElementLeftOfCol2 = &(pElement->NextInRow); + pElement = *ElementLeftOfCol2; + } while (pElement->Col < Col2); + + ElementRightOfCol2 = Element2->NextInRow; + +/* Move Element2 to Col1. */ + *ElementLeftOfCol2 = Element2->NextInRow; + *ElementLeftOfCol1 = Element2; + Element2->NextInRow = ElementRightOfCol1; + } + Element2->Col = Col1; + } + return; +} + + + + + + + + + + + +/* + * PERFORM ROW AND COLUMN ELIMINATION ON REAL MATRIX + * + * Eliminates a single row and column of the matrix and leaves single row of + * the upper triangular matrix and a single column of the lower triangular + * matrix in its wake. Uses Gauss's method. + * + * >>> Argument: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * pPivot <input> (ElementPtr) + * Pointer to the current pivot. + * + * >>> Local variables: + * pLower (ElementPtr) + * Points to matrix element in lower triangular column. + * pSub (ElementPtr) + * Points to elements in the reduced submatrix. + * Row (int) + * Row index. + * pUpper (ElementPtr) + * Points to matrix element in upper triangular row. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +static void +RealRowColElimination( + MatrixPtr Matrix, + register ElementPtr pPivot +) +{ +#if REAL +register ElementPtr pSub, *ppAbove; +register int Row; +register ElementPtr pLower, pUpper; + +/* Begin `RealRowColElimination'. */ + +/* Test for zero pivot. */ + if (ABS(pPivot->Real) == 0.0) + { (void)MatrixIsSingular( Matrix, pPivot->Row ); + return; + } + pPivot->Real = 1.0 / pPivot->Real; + + pUpper = pPivot->NextInRow; + while (pUpper != NULL) + { +/* Calculate upper triangular element. */ + pUpper->Real *= pPivot->Real; + + pSub = pUpper->NextInCol; + pLower = pPivot->NextInCol; + ppAbove = &pUpper->NextInCol; + while (pLower != NULL) + { Row = pLower->Row; + +/* Find element in row that lines up with current lower triangular element. */ + while (pSub != NULL AND pSub->Row < Row) + { ppAbove = &pSub->NextInCol; + pSub = pSub->NextInCol; + } + +/* Test to see if desired element was not found, if not, create fill-in. */ + if (pSub == NULL OR pSub->Row > Row) + { pSub = spcCreateElement( Matrix, Row, pUpper->Col, + &pLower->NextInRow, ppAbove, YES ); + if (pSub == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + } + pSub->Real -= pUpper->Real * pLower->Real; + pSub = pSub->NextInCol; + pLower = pLower->NextInCol; + } + pUpper = pUpper->NextInRow; + } + return; +#endif /* REAL */ +} + + + + + + + + + +/* + * PERFORM ROW AND COLUMN ELIMINATION ON COMPLEX MATRIX + * + * Eliminates a single row and column of the matrix and leaves single row of + * the upper triangular matrix and a single column of the lower triangular + * matrix in its wake. Uses Gauss's method. + * + * >>> Argument: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * pPivot <input> (ElementPtr) + * Pointer to the current pivot. + * + * >>> Local variables: + * pLower (ElementPtr) + * Points to matrix element in lower triangular column. + * pSub (ElementPtr) + * Points to elements in the reduced submatrix. + * Row (int) + * Row index. + * pUpper (ElementPtr) + * Points to matrix element in upper triangular row. + * + * Possible errors: + * spNO_MEMORY + */ + +static void +ComplexRowColElimination( + MatrixPtr Matrix, + register ElementPtr pPivot +) +{ +#if spCOMPLEX +register ElementPtr pSub, *ppAbove; +register int Row; +register ElementPtr pLower, pUpper; + +/* Begin `ComplexRowColElimination'. */ + +/* Test for zero pivot. */ + if (ELEMENT_MAG(pPivot) == 0.0) + { (void)MatrixIsSingular( Matrix, pPivot->Row ); + return; + } + CMPLX_RECIPROCAL(*pPivot, *pPivot); + + pUpper = pPivot->NextInRow; + while (pUpper != NULL) + { +/* Calculate upper triangular element. */ +/* Cmplx expr: *pUpper = *pUpper * (1.0 / *pPivot). */ + CMPLX_MULT_ASSIGN(*pUpper, *pPivot); + + pSub = pUpper->NextInCol; + pLower = pPivot->NextInCol; + ppAbove = &pUpper->NextInCol; + while (pLower != NULL) + { Row = pLower->Row; + +/* Find element in row that lines up with current lower triangular element. */ + while (pSub != NULL AND pSub->Row < Row) + { ppAbove = &pSub->NextInCol; + pSub = pSub->NextInCol; + } + +/* Test to see if desired element was not found, if not, create fill-in. */ + if (pSub == NULL OR pSub->Row > Row) + { pSub = spcCreateElement( Matrix, Row, pUpper->Col, + &pLower->NextInRow, ppAbove, YES ); + if (pSub == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + } + +/* Cmplx expr: pElement -= *pUpper * pLower. */ + CMPLX_MULT_SUBT_ASSIGN(*pSub, *pUpper, *pLower); + pSub = pSub->NextInCol; + pLower = pLower->NextInCol; + } + pUpper = pUpper->NextInRow; + } + return; +#endif /* spCOMPLEX */ +} + + + + + +/* + * UPDATE MARKOWITZ NUMBERS + * + * Updates the Markowitz numbers after a row and column have been eliminated. + * Also updates singleton count. + * + * >>> Argument: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * pPivot <input> (ElementPtr) + * Pointer to the current pivot. + * + * >>> Local variables: + * Row (int) + * Row index. + * Col (int) + * Column index. + * ColPtr (ElementPtr) + * Points to matrix element in upper triangular column. + * RowPtr (ElementPtr) + * Points to matrix element in lower triangular row. + */ + +static void +UpdateMarkowitzNumbers( + MatrixPtr Matrix, + ElementPtr pPivot +) +{ +register int Row, Col; +register ElementPtr ColPtr, RowPtr; +register int *MarkoRow = Matrix->MarkowitzRow, *MarkoCol = Matrix->MarkowitzCol; +double Product; + +/* Begin `UpdateMarkowitzNumbers'. */ + +/* Update Markowitz numbers. */ + for (ColPtr = pPivot->NextInCol; ColPtr != NULL; ColPtr = ColPtr->NextInCol) + { Row = ColPtr->Row; + --MarkoRow[Row]; + +/* Form Markowitz product while being cautious of overflows. */ + if ((MarkoRow[Row] > LARGEST_SHORT_INTEGER AND MarkoCol[Row] != 0) OR + (MarkoCol[Row] > LARGEST_SHORT_INTEGER AND MarkoRow[Row] != 0)) + { Product = (double)MarkoCol[Row] * (double)MarkoRow[Row]; + if (Product >= LARGEST_LONG_INTEGER) + Matrix->MarkowitzProd[Row] = LARGEST_LONG_INTEGER; + else + Matrix->MarkowitzProd[Row] = (long)Product; + } + else Matrix->MarkowitzProd[Row] = MarkoRow[Row] * MarkoCol[Row]; + if (MarkoRow[Row] == 0) + Matrix->Singletons++; + } + + for (RowPtr = pPivot->NextInRow; RowPtr != NULL; RowPtr = RowPtr->NextInRow) + { Col = RowPtr->Col; + --MarkoCol[Col]; + +/* Form Markowitz product while being cautious of overflows. */ + if ((MarkoRow[Col] > LARGEST_SHORT_INTEGER AND MarkoCol[Col] != 0) OR + (MarkoCol[Col] > LARGEST_SHORT_INTEGER AND MarkoRow[Col] != 0)) + { Product = (double)MarkoCol[Col] * (double)MarkoRow[Col]; + if (Product >= LARGEST_LONG_INTEGER) + Matrix->MarkowitzProd[Col] = LARGEST_LONG_INTEGER; + else + Matrix->MarkowitzProd[Col] = (long)Product; + } + else Matrix->MarkowitzProd[Col] = MarkoRow[Col] * MarkoCol[Col]; + if ((MarkoCol[Col] == 0) AND (MarkoRow[Col] != 0)) + Matrix->Singletons++; + } + return; +} + + + + + + +/* + * ZERO PIVOT ENCOUNTERED + * + * This routine is called when a singular matrix is found. It then + * records the current row and column and exits. + * + * >>> Returned: + * The error code spSINGULAR or spZERO_DIAG is returned. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to matrix. + * Step <input> (int) + * Index of diagonal that is zero. + */ + +static int +MatrixIsSingular( + MatrixPtr Matrix, + int Step +) +{ +/* Begin `MatrixIsSingular'. */ + + Matrix->SingularRow = Matrix->IntToExtRowMap[ Step ]; + Matrix->SingularCol = Matrix->IntToExtColMap[ Step ]; + return (Matrix->Error = spSINGULAR); +} + + +static int +ZeroPivot( + MatrixPtr Matrix, + int Step +) +{ +/* Begin `ZeroPivot'. */ + + Matrix->SingularRow = Matrix->IntToExtRowMap[ Step ]; + Matrix->SingularCol = Matrix->IntToExtColMap[ Step ]; + return (Matrix->Error = spZERO_DIAG); +} + + + + + + +#if (ANNOTATE == FULL) + +/* + * + * WRITE STATUS + * + * Write a summary of important variables to standard output. + */ + +static void +WriteStatus( + MatrixPtr Matrix, + int Step +) +{ +int I; + +/* Begin `WriteStatus'. */ + + printf("Step = %1d ", Step); + printf("Pivot found at %1d,%1d using ", Matrix->PivotsOriginalRow, + Matrix->PivotsOriginalCol); + switch(Matrix->PivotSelectionMethod) + { case 's': printf("SearchForSingleton\n"); break; + case 'q': printf("QuicklySearchDiagonal\n"); break; + case 'd': printf("SearchDiagonal\n"); break; + case 'e': printf("SearchEntireMatrix\n"); break; + } + + printf("MarkowitzRow = "); + for (I = 1; I <= Matrix->Size; I++) + printf("%2d ", Matrix->MarkowitzRow[I]); + printf("\n"); + + printf("MarkowitzCol = "); + for (I = 1; I <= Matrix->Size; I++) + printf("%2d ", Matrix->MarkowitzCol[I]); + printf("\n"); + + printf("MarkowitzProduct = "); + for (I = 1; I <= Matrix->Size; I++) + printf("%2d ", Matrix->MarkowitzProd[I]); + printf("\n"); + + printf("Singletons = %2d\n", Matrix->Singletons); + + printf("IntToExtRowMap = "); + for (I = 1; I <= Matrix->Size; I++) + printf("%2d ", Matrix->IntToExtRowMap[I]); + printf("\n"); + + printf("IntToExtColMap = "); + for (I = 1; I <= Matrix->Size; I++) + printf("%2d ", Matrix->IntToExtColMap[I]); + printf("\n"); + + printf("ExtToIntRowMap = "); + for (I = 1; I <= Matrix->ExtSize; I++) + printf("%2d ", Matrix->ExtToIntRowMap[I]); + printf("\n"); + + printf("ExtToIntColMap = "); + for (I = 1; I <= Matrix->ExtSize; I++) + printf("%2d ", Matrix->ExtToIntColMap[I]); + printf("\n\n"); + +/* spPrint((char *)Matrix, NO, YES); */ + + return; + +} +#endif /* ANNOTATE == FULL */ Added: trunk/math/SPARSE/spmatrix.h =================================================================== --- trunk/math/SPARSE/spmatrix.h (rev 0) +++ trunk/math/SPARSE/spmatrix.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,377 @@ +/* EXPORTS for sparse matrix routines. */ +/*! + * \file + * + * This file contains definitions that are useful to the calling + * program. In particular, this file contains error keyword + * definitions, some macro functions that are used to quickly enter + * data into the matrix and the type definition of a data structure + * that acts as a template for entering admittances into the matrix. + * Also included is the type definitions for the various functions + * available to the user. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ + + +/* + * Revision and copyright information. + * + * Copyright (c) 1985-2003 by Kenneth S. Kundert + * + * $Date: 2003/06/29 04:19:52 $ + * $Revision: 1.2 $ + */ + + + + +#ifndef spOKAY + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + */ + +#include "spconfig.h" + + + + + + +/* + * ERROR KEYWORDS + * + * The actual numbers used in the error codes are not sacred, they can be + * changed under the condition that the codes for the nonfatal errors are + * less than the code for spFATAL and similarly the codes for the fatal + * errors are greater than that for spFATAL. + */ + +/* Begin error macros. */ +#define spOKAY 0 /*!< + * Error code that indicates that no error has + * occurred. + */ +#define spSMALL_PIVOT 1 /*!< + * Non-fatal error code that indicates that, when + * reordering the matrix, no element was found that + * satisfies the absolute threshold criteria. The + * largest element in the matrix was chosen as pivot. + */ +#define spZERO_DIAG 2 /*!< + * Fatal error code that indicates that, a zero was + * encountered on the diagonal the matrix. This does + * not necessarily imply that the matrix is singular. + * When this error occurs, the matrix should be + * reconstructed and factored using + * spOrderAndFactor(). + */ +#define spSINGULAR 3 /*!< + * Fatal error code that indicates that, matrix is + * singular, so no unique solution exists. + */ +#define spMANGLED 4 /*!< + * Fatal error code that indicates that, matrix has + * been mangled, results of requested operation are + * garbage. + */ +#define spNO_MEMORY 5 /*!< + * Fatal error code that indicates that not enough + * memory is available. + */ +#define spPANIC 6 /*!< + * Fatal error code that indicates that the routines + * are not prepared to handle the matrix that has + * been requested. This may occur when the matrix + * is specified to be real and the routines are not + * compiled for real matrices, or when the matrix is + * specified to be complex and the routines are not + * compiled to handle complex matrices. + */ +#define spFATAL 2 /*!< + * Error code that is not an error flag, but rather + * the dividing line between fatal errors and + * warnings. + */ + + + + + + +/* + * KEYWORD DEFINITIONS + */ + +#define spREAL M_Real /*!< + * Defines the precision of the arithmetic used by + * \a Sparse will use. Double precision is suggested + * as being most appropriate for circuit simulation + * and for C. However, it is possible to change spREAL + * to a float for single precision arithmetic. Note + * that in C, single precision arithmetic is often + * slower than double precision. Sparse + * internally refers to spREALs as RealNumbers. + */ + + + +/* + * PARTITION TYPES + * + * When factoring a previously ordered matrix using spFactor(), Sparse + * operates on a row-at-a-time basis. For speed, on each step, the row + * being updated is copied into a full vector and the operations are + * performed on that vector. This can be done one of two ways, either + * using direct addressing or indirect addressing. Direct addressing + * is fastest when the matrix is relatively dense and indirect addressing + * is quite sparse. The user can select which partitioning mode is used. + * The following keywords are passed to spPartition() and indicate that + * Sparse should use only direct addressing, only indirect addressing, or + * that it should choose the best mode on a row-by-row basis. The time + * required to choose a partition is of the same order of the cost to factor + * the matrix. + * + * If you plan to factor a large number of matrices with the same structure, + * it is best to let Sparse choose the partition. Otherwise, you should + * choose the partition based on the predicted density of the matrix. + */ + +/* Begin partition keywords. */ + +#define spDEFAULT_PARTITION 0 /*!< + * Partition code for spPartition(). + * Indicates that the default partitioning + * mode should be used. + * \see spPartition() + */ +#define spDIRECT_PARTITION 1 /*!< + * Partition code for spPartition(). + * Indicates that all rows should be placed + * in the direct addressing partition. + * \see spPartition() + */ +#define spINDIRECT_PARTITION 2 /*!< + * Partition code for spPartition(). + * Indicates that all rows should be placed + * in the indirect addressing partition. + * \see spPartition() + */ +#define spAUTO_PARTITION 3 /*!< + * Partition code for spPartition(). + * Indicates that \a Sparse should chose + * the best partition for each row based + * on some simple rules. This is generally + * preferred. + * \see spPartition() + */ + + + + + +/* + * MACRO FUNCTION DEFINITIONS + */ + +/* Begin Macros. */ +/*! + * Macro function that adds data to a real element in the matrix by a pointer. + */ +#define spADD_REAL_ELEMENT(element,real) *(element) += real + +/*! + * Macro function that adds data to a imaginary element in the matrix by + * a pointer. + */ +#define spADD_IMAG_ELEMENT(element,imag) *(element+1) += imag + +/*! + * Macro function that adds data to a complex element in the matrix by + * a pointer. + */ +#define spADD_COMPLEX_ELEMENT(element,real,imag) \ +{ *(element) += real; \ + *(element+1) += imag; \ +} + +/*! + * Macro function that adds data to each of the four real matrix elements + * specified by the given template. + */ +#define spADD_REAL_QUAD(template,real) \ +{ *((template).Element1) += real; \ + *((template).Element2) += real; \ + *((template).Element3Negated) -= real; \ + *((template).Element4Negated) -= real; \ +} + +/*! + * Macro function that adds data to each of the four imaginary matrix + * elements specified by the given template. + */ +#define spADD_IMAG_QUAD(template,imag) \ +{ *((template).Element1+1) += imag; \ + *((template).Element2+1) += imag; \ + *((template).Element3Negated+1) -= imag; \ + *((template).Element4Negated+1) -= imag; \ +} + +/*! + * Macro function that adds data to each of the four complex matrix + * elements specified by the given template. + */ +#define spADD_COMPLEX_QUAD(template,real,imag) \ +{ *((template).Element1) += real; \ + *((template).Element2) += real; \ + *((template).Element3Negated) -= real; \ + *((template).Element4Negated) -= real; \ + *((template).Element1+1) += imag; \ + *((template).Element2+1) += imag; \ + *((template).Element3Negated+1) -= imag; \ + *((template).Element4Negated+1) -= imag; \ +} + + + + + + + +/* + * TYPE DEFINITION FOR EXTERNAL MATRIX ELEMENT REFERENCES + * + * External type definitions for Sparse data objects. + */ + +/*! Declares the type of the a pointer to a matrix. */ +typedef spGenericPtr spMatrix; + +/*! Declares the type of the a pointer to a matrix element. */ +typedef spREAL spElement; + +/*! Declares the type of the Sparse error codes. */ +typedef int spError; + + + + + +/* TYPE DEFINITION FOR COMPONENT TEMPLATE */ +/*! + * This data structure is used to hold pointers to four related elements in + * matrix. It is used in conjunction with the routines spGetAdmittance(), + * spGetQuad(), and spGetOnes(). These routines stuff the structure which + * is later used by the \a spADD_QUAD macro functions above. It is also + * possible for the user to collect four pointers returned by spGetElement() + * and stuff them into the template. The \a spADD_QUAD routines stuff data + * into the matrix in locations specified by \a Element1 and \a Element2 + * without changing the data. The data is negated before being placed in + * \a Element3 and \a Element4. + */ + +/* Begin `spTemplate'. */ +struct spTemplate +{ spElement *Element1; + spElement *Element2; + spElement *Element3Negated; + spElement *Element4Negated; +}; + + + + + +/* + * FUNCTION TYPE DEFINITIONS + * + * The type of every user accessible function is declared here. + */ + +/* Begin function declarations. */ + +spcEXTERN void spClear( spMatrix ); +spcEXTERN spREAL spCondition( spMatrix, spREAL, int* ); +spcEXTERN spMatrix spCreate( int, int, spError* ); +spcEXTERN void spDeleteRowAndCol( spMatrix, int, int ); +spcEXTERN void spDestroy( spMatrix ); +spcEXTERN int spElementCount( spMatrix ); +spcEXTERN spError spErrorState( spMatrix ); +#ifdef EOF + spcEXTERN void spErrorMessage( spMatrix, FILE*, char* ); +#else +# define spErrorMessage(a,b,c) spcFUNC_NEEDS_FILE(_spErrorMessage,stdio) +#endif + + +spcEXTERN spError spFactor( spMatrix ); +spcEXTERN int spFileMatrix( spMatrix, char*, char*, int, int, int ); +spcEXTERN int spFileStats( spMatrix, char*, char* ); +spcEXTERN int spFillinCount( spMatrix ); +spcEXTERN spElement *spFindElement( spMatrix, int, int ); +spcEXTERN spError spGetAdmittance( spMatrix, int, int, + struct spTemplate* ); +spcEXTERN spElement *spGetElement( spMatrix, int, int ); +spcEXTERN spGenericPtr spGetInitInfo( spElement* ); +spcEXTERN spError spGetOnes( spMatrix, int, int, int, + struct spTemplate* ); +spcEXTERN spError spGetQuad( spMatrix, int, int, int, int, + struct spTemplate* ); +spcEXTERN int spGetSize( spMatrix, int ); +spcEXTERN int spInitialize( spMatrix, int (*pInit)(spElement *, spGenericPtr, int, int) ); +spcEXTERN void spInstallInitInfo( spElement*, spGenericPtr ); +spcEXTERN spREAL spLargestElement( spMatrix ); +spcEXTERN void spMNA_Preorder( spMatrix ); +spcEXTERN spREAL spNorm( spMatrix ); +spcEXTERN spError spOrderAndFactor( spMatrix, spREAL[], spREAL, + spREAL, int ); +spcEXTERN void spPartition( spMatrix, int ); +spcEXTERN void spPrint( spMatrix, int, int, int ); +spcEXTERN spREAL spPseudoCondition( spMatrix ); +spcEXTERN spREAL spRoundoff( spMatrix, spREAL ); +spcEXTERN void spScale( spMatrix, spREAL[], spREAL[] ); +spcEXTERN void spSetComplex( spMatrix ); +spcEXTERN void spSetReal( spMatrix ); +spcEXTERN void spStripFills( spMatrix ); +spcEXTERN void spWhereSingular( spMatrix, int*, int* ); + +/* Functions added for edacious */ +spcEXTERN void spAddToReorderedDiag(spMatrix, spREAL); + +/* Functions with argument lists that are dependent on options. */ + +#if spCOMPLEX +spcEXTERN void spDeterminant( spMatrix, int*, spREAL*, spREAL* ); +#else /* NOT spCOMPLEX */ +spcEXTERN void spDeterminant( spMatrix, int*, spREAL* ); +#endif /* NOT spCOMPLEX */ +#if spCOMPLEX && spSEPARATED_COMPLEX_VECTORS +spcEXTERN int spFileVector( spMatrix, char* , + spREAL[], spREAL[]); +spcEXTERN void spMultiply( spMatrix, spREAL[], spREAL[], + spREAL[], spREAL[] ); +spcEXTERN void spMultTransposed( spMatrix, spREAL[], spREAL[], + spREAL[], spREAL[] ); +spcEXTERN void spSolve( spMatrix, spREAL[], spREAL[], spREAL[], + spREAL[] ); +spcEXTERN void spSolveTransposed( spMatrix, spREAL[], spREAL[], + spREAL[], spREAL[] ); +#else /* NOT (spCOMPLEX && spSEPARATED_COMPLEX_VECTORS) */ +spcEXTERN int spFileVector( spMatrix, char* , spREAL[] ); +spcEXTERN void spMultiply( spMatrix, spREAL[], spREAL[] ); +spcEXTERN void spMultTransposed( spMatrix, + spREAL[], spREAL[] ); +spcEXTERN void spSolve( spMatrix, spREAL[], spREAL[] ); +spcEXTERN void spSolveTransposed( spMatrix, + spREAL[], spREAL[] ); +#endif /* NOT (spCOMPLEX && spSEPARATED_COMPLEX_VECTORS) */ +#endif /* spOKAY */ Added: trunk/math/SPARSE/spoutput.c =================================================================== --- trunk/math/SPARSE/spoutput.c (rev 0) +++ trunk/math/SPARSE/spoutput.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,745 @@ +/* + * MATRIX OUTPUT MODULE + * + * Author: Advisor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*! \file + * + * This file contains the output-to-file and output-to-screen routines for + * the matrix package. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spPrint + * spFileMatrix + * spFileVector + * spFileStats + * + * >>> Other functions contained in this file: + */ + + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + + +#if DOCUMENTATION + +/*! + * Formats and send the matrix to standard output. Some elementary + * statistics are also output. The matrix is output in a format that is + * readable by people. + * + * \param eMatrix + * Pointer to matrix. + * \param PrintReordered + * Indicates whether the matrix should be printed out in its original + * form, as input by the user, or whether it should be printed in its + * reordered form, as used by the matrix routines. A zero indicates that + * the matrix should be printed as inputed, a one indicates that it + * should be printed reordered. + * \param Data + * Boolean flag that when false indicates that output should be + * compressed such that only the existence of an element should be + * indicated rather than giving the actual value. Thus 11 times as + * many can be printed on a row. A zero signifies that the matrix + * should be printed compressed. A one indicates that the matrix + * should be printed in all its glory. + * \param Header + * Flag indicating that extra information should be given, such as row + * and column numbers. + */ +/* >>> Local variables: + * Col (int) + * Column being printed. + * ElementCount (int) + * Variable used to count the number of nonzero elements in the matrix. + * LargestElement (RealNumber) + * The magnitude of the largest element in the matrix. + * LargestDiag (RealNumber) + * The magnitude of the largest diagonal in the matrix. + * Magnitude (RealNumber) + * The absolute value of the matrix element being printed. + * PrintOrdToIntColMap (int []) + * A translation array that maps the order that columns will be + * printed in (if not PrintReordered) to the internal column numbers. + * PrintOrdToIntRowMap (int []) + * A translation array that maps the order that rows will be + * printed in (if not PrintReordered) to the internal row numbers. + * pElement (ElementPtr) + * Pointer to the element in the matrix that is to be printed. + * pImagElements (ElementPtr [ ]) + * Array of pointers to elements in the matrix. These pointers point + * to the elements whose real values have just been printed. They are + * used to quickly access those same elements so their imaginary values + * can be printed. + * Row (int) + * Row being printed. + * Size (int) + * The size of the matrix. + * SmallestDiag (RealNumber) + * The magnitude of the smallest diagonal in the matrix. + * SmallestElement (RealNumber) + * The magnitude of the smallest element in the matrix excluding zero + * elements. + * StartCol (int) + * The column number of the first column to be printed in the group of + * columns currently being printed. + * StopCol (int) + * The column number of the last column to be printed in the group of + * columns currently being printed. + * Top (int) + * The largest expected external row or column number. + */ + +void +spPrint( + spMatrix eMatrix, + int PrintReordered, + int Data, + int Header +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int J = 0; +int I, Row, Col, Size, Top, StartCol = 1, StopCol, Columns, ElementCount = 0; +double Magnitude, SmallestDiag = 0.0, SmallestElement = 0.0; +double LargestElement = 0.0, LargestDiag = 0.0; +ElementPtr pElement, pImagElements[PRINTER_WIDTH/10+1]; +int *PrintOrdToIntRowMap, *PrintOrdToIntColMap; + +/* Begin `spPrint'. */ + ASSERT_IS_SPARSE( Matrix ); + Size = Matrix->Size; + +/* Create a packed external to internal row and column translation array.. */ +# if TRANSLATE + Top = Matrix->AllocatedExtSize; +#else + Top = Matrix->AllocatedSize; +#endif + CALLOC( PrintOrdToIntRowMap, int, Top + 1 ); + CALLOC( PrintOrdToIntColMap, int, Top + 1 ); + if ( PrintOrdToIntRowMap == NULL OR PrintOrdToIntColMap == NULL) + { Matrix->Error = spNO_MEMORY; + return; + } + for (I = 1; I <= Size; I++) + { PrintOrdToIntRowMap[ Matrix->IntToExtRowMap[I] ] = I; + PrintOrdToIntColMap[ Matrix->IntToExtColMap[I] ] = I; + } + +/* Pack the arrays. */ + for (J = 1, I = 1; I <= Top; I++) + { if (PrintOrdToIntRowMap[I] != 0) + PrintOrdToIntRowMap[ J++ ] = PrintOrdToIntRowMap[ I ]; + } + for (J = 1, I = 1; I <= Top; I++) + { if (PrintOrdToIntColMap[I] != 0) + PrintOrdToIntColMap[ J++ ] = PrintOrdToIntColMap[ I ]; + } + +/* Print header. */ + if (Header) + { printf("MATRIX SUMMARY\n\n"); + printf("Size of matrix = %1d x %1d.\n", Size, Size); + if ( Matrix->Reordered AND PrintReordered ) + printf("Matrix has been reordered.\n"); + putchar('\n'); + + if ( Matrix->Factored ) + printf("Matrix after factorization:\n"); + else + printf("Matrix before factorization:\n"); + + SmallestElement = LARGEST_REAL; + SmallestDiag = SmallestElement; + } + if (Size == 0) return; + +/* Determine how many columns to use. */ + Columns = PRINTER_WIDTH; + if (Header) Columns -= 5; + if (Data) Columns = (Columns+1) / 10; + +/* + * Print matrix by printing groups of complete columns until all the columns + * are printed. + */ + J = 0; + while ( J <= Size ) + +/* Calculate index of last column to printed in this group. */ + { StopCol = StartCol + Columns - 1; + if (StopCol > Size) + StopCol = Size; + +/* Label the columns. */ + if (Header) + { if (Data) + { printf(" "); + for (I = StartCol; I <= StopCol; I++) + { if (PrintReordered) + Col = I; + else + Col = PrintOrdToIntColMap[I]; + printf(" %9d", Matrix->IntToExtColMap[ Col ]); + } + printf("\n\n"); + } + else + { if (PrintReordered) + printf("Columns %1d to %1d.\n",StartCol,StopCol); + else + { printf("Columns %1d to %1d.\n", + Matrix->IntToExtColMap[ PrintOrdToIntColMap[StartCol] ], + Matrix->IntToExtColMap[ PrintOrdToIntColMap[StopCol] ]); + } + } + } + +/* Print every row ... */ + for (I = 1; I <= Size; I++) + { if (PrintReordered) + Row = I; + else + Row = PrintOrdToIntRowMap[I]; + + if (Header) + { if (PrintReordered AND NOT Data) + printf("%4d", I); + else + printf("%4d", Matrix->IntToExtRowMap[ Row ]); + if (NOT Data) putchar(' '); + } + +/* ... in each column of the group. */ + for (J = StartCol; J <= StopCol; J++) + { if (PrintReordered) + Col = J; + else + Col = PrintOrdToIntColMap[J]; + + pElement = Matrix->FirstInCol[Col]; + while(pElement != NULL AND pElement->Row != Row) + pElement = pElement->NextInCol; + + if (Data) + pImagElements[J - StartCol] = pElement; + + if (pElement != NULL) + +/* Case where element exists */ + { if (Data) + printf(" %9.3g", (double)pElement->Real); + else + putchar('x'); + +/* Update status variables */ + if ( (Magnitude = ELEMENT_MAG(pElement)) > LargestElement ) + LargestElement = Magnitude; + if ((Magnitude < SmallestElement) AND (Magnitude != 0.0)) + SmallestElement = Magnitude; + ElementCount++; + } + +/* Case where element is structurally zero */ + else + { if (Data) + printf(" ..."); + else + putchar('.'); + } + } + putchar('\n'); + +#if spCOMPLEX + if (Matrix->Complex AND Data) + { if (Header) + printf(" "); + for (J = StartCol; J <= StopCol; J++) + { if (pImagElements[J - StartCol] != NULL) + { printf(" %8.2gj", + (double)pImagElements[J-StartCol]->Imag); + } + else printf(" "); + } + putchar('\n'); + } +#endif /* spCOMPLEX */ + } + +/* Calculate index of first column in next group. */ + StartCol = StopCol; + StartCol++; + putchar('\n'); + } + if (Header) + { printf("\nLargest element in matrix = %-1.4g.\n", LargestElement); + printf("Smallest element in matrix = %-1.4g.\n", SmallestElement); + +/* Search for largest and smallest diagonal values */ + for (I = 1; I <= Size; I++) + { if (Matrix->Diag[I] != NULL) + { Magnitude = ELEMENT_MAG( Matrix->Diag[I] ); + if ( Magnitude > LargestDiag ) LargestDiag = Magnitude; + if ( Magnitude < SmallestDiag ) SmallestDiag = Magnitude; + } + } + + /* Print the largest and smallest diagonal values */ + if ( Matrix->Factored ) + { printf("\nLargest diagonal element = %-1.4g.\n", LargestDiag); + printf("Smallest diagonal element = %-1.4g.\n", SmallestDiag); + } + else + { printf("\nLargest pivot element = %-1.4g.\n", LargestDiag); + printf("Smallest pivot element = %-1.4g.\n", SmallestDiag); + } + + /* Calculate and print sparsity and number of fill-ins created. */ + printf("\nDensity = %2.2f%%.\n", ((double)ElementCount * 100.0) + / (((double)Size * (double)Size))); + if (NOT Matrix->NeedsOrdering) + printf("Number of fill-ins = %1d.\n", Matrix->Fillins); + } + putchar('\n'); + (void)fflush(stdout); + + FREE(PrintOrdToIntColMap); + FREE(PrintOrdToIntRowMap); + return; +} + + + + + + + + + + + +/*! + * Writes matrix to file in format suitable to be read back in by the + * matrix test program. + * + * \return + * One is returned if routine was successful, otherwise zero is returned. + * The calling function can query \a errno (the system global error variable) + * as to the reason why this routine failed. + * + * \param eMatrix + * Pointer to matrix. + * \param File + * Name of file into which matrix is to be written. + * \param Label + * String that is transferred to file and is used as a label. + * \param Reordered + * Specifies whether matrix should be output in reordered form, + * or in original order. + * \param Data + * Indicates that the element values should be output along with + * the indices for each element. This parameter must be true if + * matrix is to be read by the sparse test program. + * \param Header + * Indicates that header is desired. This parameter must be true if + * matrix is to be read by the sparse test program. + */ +/* >>> Local variables: + * Col (int) + * The original column number of the element being output. + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * pMatrixFile (FILE *) + * File pointer to the matrix file. + * Row (int) + * The original row number of the element being output. + * Size (int) + * The size of the matrix. + */ + +int +spFileMatrix( + spMatrix eMatrix, + char *File, + char *Label, + int Reordered, + int Data, + int Header +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int I, Size; +register ElementPtr pElement; +int Row, Col, Err; +FILE *pMatrixFile; + +/* Begin `spFileMatrix'. */ + ASSERT_IS_SPARSE( Matrix ); + +/* Open file matrix file in write mode. */ + if ((pMatrixFile = fopen(File, "w")) == NULL) + return 0; + +/* Output header. */ + Size = Matrix->Size; + if (Header) + { if (Matrix->Factored AND Data) + { Err = fprintf + ( pMatrixFile, + "Warning : The following matrix is factored in to LU form.\n" + ); + if (Err < 0) return 0; + } + if (fprintf(pMatrixFile, "%s\n", Label) < 0) return 0; + Err = fprintf( pMatrixFile, "%d\t%s\n", Size, + (Matrix->Complex ? "complex" : "real")); + if (Err < 0) return 0; + } + if (Size == 0) return 1; + +/* Output matrix. */ + if (NOT Data) + { for (I = 1; I <= Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { if (Reordered) + { Row = pElement->Row; + Col = I; + } + else + { Row = Matrix->IntToExtRowMap[pElement->Row]; + Col = Matrix->IntToExtColMap[I]; + } + pElement = pElement->NextInCol; + if (fprintf(pMatrixFile, "%d\t%d\n", Row, Col) < 0) return 0; + } + } +/* Output terminator, a line of zeros. */ + if (Header) + if (fprintf(pMatrixFile, "0\t0\n") < 0) return 0; + } + +#if spCOMPLEX + if (Data AND Matrix->Complex) + { for (I = 1; I <= Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { if (Reordered) + { Row = pElement->Row; + Col = I; + } + else + { Row = Matrix->IntToExtRowMap[pElement->Row]; + Col = Matrix->IntToExtColMap[I]; + } + Err = fprintf + ( pMatrixFile,"%d\t%d\t%-.15g\t%-.15g\n", + Row, Col, (double)pElement->Real, (double)pElement->Imag + ); + if (Err < 0) return 0; + pElement = pElement->NextInCol; + } + } +/* Output terminator, a line of zeros. */ + if (Header) + if (fprintf(pMatrixFile,"0\t0\t0.0\t0.0\n") < 0) return 0; + + } +#endif /* spCOMPLEX */ + +#if REAL + if (Data AND NOT Matrix->Complex) + { for (I = 1; I <= Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { Row = Matrix->IntToExtRowMap[pElement->Row]; + Col = Matrix->IntToExtColMap[I]; + Err = fprintf + ( pMatrixFile,"%d\t%d\t%-.15g\n", + Row, Col, (double)pElement->Real + ); + if (Err < 0) return 0; + pElement = pElement->NextInCol; + } + } +/* Output terminator, a line of zeros. */ + if (Header) + if (fprintf(pMatrixFile,"0\t0\t0.0\n") < 0) return 0; + + } +#endif /* REAL */ + +/* Close file. */ + if (fclose(pMatrixFile) < 0) return 0; + return 1; +} + + + + + + + +/*! + * Writes vector to file in format suitable to be read back in by the + * matrix test program. This routine should be executed after the function + * spFileMatrix. + * + * \return + * One is returned if routine was successful, otherwise zero is returned. + * The calling function can query \a errno (the system global error variable) + * as to the reason why this routine failed. + * + * \param eMatrix + * Pointer to matrix. + * \param File + * Name of file into which matrix is to be written. + * \param RHS + * Right-hand side vector. This is only the real portion if + * \a spSEPARATED_COMPLEX_VECTORS is true. + * \param iRHS + * Right-hand side vector, imaginary portion. Not necessary if matrix + * is real or if \a spSEPARATED_COMPLEX_VECTORS is set false. + * \a iRHS is a macro that replaces itself with `, iRHS' if the options + * \a spCOMPLEX and \a spSEPARATED_COMPLEX_VECTORS are set, otherwise + * it disappears without a trace. + */ +/* >>> Local variables: + * pMatrixFile (FILE *) + * File pointer to the matrix file. + * Size (int) + * The size of the matrix. + */ + +int +spFileVector( + spMatrix eMatrix, + char *File, + spREAL RHS[] +#if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS + , spREAL iRHS[] +#endif +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int I, Size, Err; +FILE *pMatrixFile; + +/* Begin `spFileVector'. */ + ASSERT_IS_SPARSE( Matrix ); + vASSERT( RHS != NULL, "Vector missing" ); + +/* Open File in append mode. */ + if ((pMatrixFile = fopen(File,"a")) == NULL) + return 0; + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spCOMPLEX + if (Matrix->Complex) + { +#if spSEPARATED_COMPLEX_VECTORS + vASSERT( iRHS != NULL, "Imaginary vector missing" ); + --RHS; + --iRHS; +#else + RHS -= 2; +#endif + } + else +#endif /* spCOMPLEX */ + --RHS; +#endif /* NOT ARRAY_OFFSET */ + + +/* Output vector. */ + Size = Matrix->Size; + if (Size == 0) return 1; + +#if spCOMPLEX + if (Matrix->Complex) + { +#if spSEPARATED_COMPLEX_VECTORS + for (I = 1; I <= Size; I++) + { Err = fprintf + ( pMatrixFile, "%-.15g\t%-.15g\n", + (double)RHS[I], (double)iRHS[I] + ); + if (Err < 0) return 0; + } +#else + for (I = 1; I <= Size; I++) + { Err = fprintf + ( pMatrixFile, "%-.15g\t%-.15g\n", + (double)RHS[2*I], (double)RHS[2*I+1] + ); + if (Err < 0) return 0; + } +#endif + } +#endif /* spCOMPLEX */ +#if REAL AND spCOMPLEX + else +#endif +#if REAL + { for (I = 1; I <= Size; I++) + { if (fprintf(pMatrixFile, "%-.15g\n", (double)RHS[I]) < 0) + return 0; + } + } +#endif /* REAL */ + +/* Close file. */ + if (fclose(pMatrixFile) < 0) return 0; + return 1; +} + + + + + + + + + +/*! + * Writes useful information concerning the matrix to a file. Should be + * executed after the matrix is factored. + * + * \return + * One is returned if routine was successful, otherwise zero is returned. + * The calling function can query \a errno (the system global error variable) + * as to the reason why this routine failed. + * + * \param eMatrix + * Pointer to matrix. + * \param File + * Name of file into which matrix is to be written. + * \param Label + * String that is transferred to file and is used as a label. + */ +/* >>> Local variables: + * Data (RealNumber) + * The value of the matrix element being output. + * LargestElement (RealNumber) + * The largest element in the matrix. + * NumberOfElements (int) + * Number of nonzero elements in the matrix. + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * pStatsFile (FILE *) + * File pointer to the statistics file. + * Size (int) + * The size of the matrix. + * SmallestElement (RealNumber) + * The smallest element in the matrix excluding zero elements. + */ + +int +spFileStats( + spMatrix eMatrix, + char *File, + char *Label +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int Size, I; +register ElementPtr pElement; +int NumberOfElements; +RealNumber Data, LargestElement, SmallestElement; +FILE *pStatsFile; + +/* Begin `spFileStats'. */ + ASSERT_IS_SPARSE( Matrix ); + +/* Open File in append mode. */ + if ((pStatsFile = fopen(File, "a")) == NULL) + return 0; + +/* Output statistics. */ + Size = Matrix->Size; + if (NOT Matrix->Factored) + fprintf(pStatsFile, "Matrix has not been factored.\n"); + fprintf(pStatsFile, "||| Starting new matrix |||\n"); + fprintf(pStatsFile, "%s\n", Label); + if (Matrix->Complex) + fprintf(pStatsFile, "Matrix is complex.\n"); + else + fprintf(pStatsFile, "Matrix is real.\n"); + fprintf(pStatsFile," Size = %d\n",Size); + if (Size == 0) return 1; + +/* Search matrix. */ + NumberOfElements = 0; + LargestElement = 0.0; + SmallestElement = LARGEST_REAL; + + for (I = 1; I <= Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { NumberOfElements++; + Data = ELEMENT_MAG(pElement); + if (Data > LargestElement) + LargestElement = Data; + if (Data < SmallestElement AND Data != 0.0) + SmallestElement = Data; + pElement = pElement->NextInCol; + } + } + + SmallestElement = MIN( SmallestElement, LargestElement ); + +/* Output remaining statistics. */ + fprintf(pStatsFile, " Initial number of elements = %d\n", + NumberOfElements - Matrix->Fillins); + fprintf(pStatsFile, + " Initial average number of elements per row = %f\n", + (double)(NumberOfElements - Matrix->Fillins) / (double)Size); + fprintf(pStatsFile, " Fill-ins = %d\n",Matrix->Fillins); + fprintf(pStatsFile, " Average number of fill-ins per row = %f%%\n", + (double)Matrix->Fillins / (double)Size); + fprintf(pStatsFile, " Total number of elements = %d\n", + NumberOfElements); + fprintf(pStatsFile, " Average number of elements per row = %f\n", + (double)NumberOfElements / (double)Size); + fprintf(pStatsFile," Density = %f%%\n", + (100.0*(double)NumberOfElements)/((double)Size*(double)Size)); + fprintf(pStatsFile," Relative Threshold = %e\n", Matrix->RelThreshold); + fprintf(pStatsFile," Absolute Threshold = %e\n", Matrix->AbsThreshold); + fprintf(pStatsFile," Largest Element = %e\n", LargestElement); + fprintf(pStatsFile," Smallest Element = %e\n\n\n", SmallestElement); + +/* Close file. */ + (void)fclose(pStatsFile); + return 1; +} +#endif /* DOCUMENTATION */ Added: trunk/math/SPARSE/spsolve.c =================================================================== --- trunk/math/SPARSE/spsolve.c (rev 0) +++ trunk/math/SPARSE/spsolve.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,683 @@ +/* + * MATRIX SOLVE MODULE + * + * Author: Advising professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*! \file + * This file contains the forward and backward substitution routines for + * the sparse matrix routines. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spSolve + * spSolveTransposed + * + * >>> Other functions contained in this file: + * SolveComplexMatrix + * SolveComplexTransposedMatrix + */ + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + +/* + * Function declarations + */ + +#if spSEPARATED_COMPLEX_VECTORS +static void SolveComplexMatrix( MatrixPtr, + RealVector, RealVector, RealVector, RealVector ); +static void SolveComplexTransposedMatrix( MatrixPtr, + RealVector, RealVector, RealVector, RealVector ); +#else +static void SolveComplexMatrix( MatrixPtr, RealVector, RealVector ); +static void SolveComplexTransposedMatrix( MatrixPtr, + RealVector, RealVector ); +#endif + + + + + + + +/*! + * Performs forward elimination and back substitution to find the + * unknown vector from the \a RHS vector and factored matrix. This + * routine assumes that the pivots are associated with the lower + * triangular matrix and that the diagonal of the upper triangular + * matrix consists of ones. This routine arranges the computation + * in different way than is traditionally used in order to exploit the + * sparsity of the right-hand side. See the reference in spRevision. + * + * \param eMatrix + * Pointer to matrix. + * \param RHS + * \a RHS is the input data array, the right hand side. This data is + * undisturbed and may be reused for other solves. + * \param Solution + * \a Solution is the output data array. This routine is constructed + * such that \a RHS and \a Solution can be the same array. + * \param iRHS + * \a iRHS is the imaginary portion of the input data array, the right + * hand side. This data is undisturbed and may be reused for other solves. + * This argument is only necessary if matrix is complex and if + * \a spSEPARATED_COMPLEX_VECTOR is set true. + * \param iSolution + * \a iSolution is the imaginary portion of the output data array. This + * routine is constructed such that \a iRHS and \a iSolution can be + * the same array. This argument is only necessary if matrix is complex + * and if \a spSEPARATED_COMPLEX_VECTOR is set true. + */ +/* >>> Local variables: + * Intermediate (RealVector) + * Temporary storage for use in forward elimination and backward + * substitution. Commonly referred to as c, when the LU factorization + * equations are given as Ax = b, Lc = b, Ux = c Local version of + * Matrix->Intermediate, which was created during the initial + * factorization in function spcCreateInternalVectors() in the matrix + * factorization module. + * pElement (ElementPtr) + * Pointer used to address elements in both the lower and upper triangle + * matrices. + * pExtOrder (int *) + * Pointer used to sequentially access each entry in IntToExtRowMap + * and IntToExtColMap arrays. Used to quickly scramble and unscramble + * RHS and Solution to account for row and column interchanges. + * pPivot (ElementPtr) + * Pointer that points to current pivot or diagonal element. + * Size (int) + * Size of matrix. Made local to reduce indirection. + * Temp (RealNumber) + * Temporary storage for entries in arrays. + * + * >>> Obscure Macros + * IMAG_VECTORS + * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and + * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears + * without a trace. + */ + +/*VARARGS3*/ + +void +spSolve( + spMatrix eMatrix, + spREAL RHS[], + spREAL Solution[] +# if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS + , spREAL iRHS[] + , spREAL iSolution[] +# endif +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register RealVector Intermediate; +register RealNumber Temp; +register int I, *pExtOrder, Size; +ElementPtr pPivot; + +/* Begin `spSolve'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + +#if spCOMPLEX + if (Matrix->Complex) + { SolveComplexMatrix( Matrix, RHS, Solution IMAG_VECTORS ); + return; + } +#endif + +#if REAL + Intermediate = Matrix->Intermediate; + Size = Matrix->Size; + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET + --RHS; + --Solution; +#endif + +/* Initialize Intermediate vector. */ + pExtOrder = &Matrix->IntToExtRowMap[Size]; + for (I = Size; I > 0; I--) + Intermediate[I] = RHS[*(pExtOrder--)]; + +/* Forward elimination. Solves Lc = b.*/ + for (I = 1; I <= Size; I++) + { +/* This step of the elimination is skipped if Temp equals zero. */ + if ((Temp = Intermediate[I]) != 0.0) + { pPivot = Matrix->Diag[I]; + Intermediate[I] = (Temp *= pPivot->Real); + + pElement = pPivot->NextInCol; + while (pElement != NULL) + { Intermediate[pElement->Row] -= Temp * pElement->Real; + pElement = pElement->NextInCol; + } + } + } + +/* Backward Substitution. Solves Ux = c.*/ + for (I = Size; I > 0; I--) + { Temp = Intermediate[I]; + pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { Temp -= pElement->Real * Intermediate[pElement->Col]; + pElement = pElement->NextInRow; + } + Intermediate[I] = Temp; + } + +/* Unscramble Intermediate vector while placing data in to Solution vector. */ + pExtOrder = &Matrix->IntToExtColMap[Size]; + for (I = Size; I > 0; I--) + Solution[*(pExtOrder--)] = Intermediate[I]; + + return; +#endif /* REAL */ +} + + + + + + + + + + + +#if spCOMPLEX +/*! + * Performs forward elimination and back substitution to find the + * unknown vector from the RHS vector and factored matrix. This + * routine assumes that the pivots are associated with the lower + * triangular matrix and that the diagonal of the upper triangular + * matrix consists of ones. This routine arranges the computation + * in different way than is traditionally used in order to exploit the + * sparsity of the right-hand side. See the reference in spRevision. + * + * \param Matrix + * Pointer to matrix. + * \param RHS + * RHS is the real portion of the input data array, the right hand + * side. This data is undisturbed and may be reused for other solves. + * \param Solution + * Solution is the real portion of the output data array. This routine + * is constructed such that RHS and Solution can be the same + * array. + * \param iRHS + * iRHS is the imaginary portion of the input data array, the right + * hand side. This data is undisturbed and may be reused for other solves. + * If spSEPARATED_COMPLEX_VECTOR is set false, there is no need to + * supply this array. + * \param iSolution + * iSolution is the imaginary portion of the output data array. This + * routine is constructed such that iRHS and iSolution can be + * the same array. If spSEPARATED_COMPLEX_VECTOR is set false, there is no + * need to supply this array. + */ +/* >>> Local variables: + * Intermediate (ComplexVector) + * Temporary storage for use in forward elimination and backward + * substitution. Commonly referred to as c, when the LU factorization + * equations are given as Ax = b, Lc = b, Ux = c. + * Local version of Matrix->Intermediate, which was created during + * the initial factorization in function spcCreateInternalVectors() in the + * matrix factorization module. + * pElement (ElementPtr) + * Pointer used to address elements in both the lower and upper triangle + * matrices. + * pExtOrder (int *) + * Pointer used to sequentially access each entry in IntToExtRowMap + * and IntToExtColMap arrays. Used to quickly scramble and unscramble + * RHS and Solution to account for row and column interchanges. + * pPivot (ElementPtr) + * Pointer that points to current pivot or diagonal element. + * Size (int) + * Size of matrix. Made local to reduce indirection. + * Temp (ComplexNumber) + * Temporary storage for entries in arrays. + */ + +static void +SolveComplexMatrix( + MatrixPtr Matrix, + RealVector RHS, + RealVector Solution +# if spSEPARATED_COMPLEX_VECTORS + , RealVector iRHS + , RealVector iSolution +# endif +) +{ +register ElementPtr pElement; +register ComplexVector Intermediate; +register int I, *pExtOrder, Size; +ElementPtr pPivot; +register ComplexVector ExtVector; +ComplexNumber Temp; + +/* Begin `SolveComplexMatrix'. */ + + Size = Matrix->Size; + Intermediate = (ComplexVector)Matrix->Intermediate; + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spSEPARATED_COMPLEX_VECTORS + --RHS; --iRHS; + --Solution; --iSolution; +#else + RHS -= 2; Solution -= 2; +#endif +#endif + +/* Initialize Intermediate vector. */ + pExtOrder = &Matrix->IntToExtRowMap[Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Size; I > 0; I--) + { Intermediate[I].Real = RHS[*(pExtOrder)]; + Intermediate[I].Imag = iRHS[*(pExtOrder--)]; + } +#else + ExtVector = (ComplexVector)RHS; + for (I = Size; I > 0; I--) + Intermediate[I] = ExtVector[*(pExtOrder--)]; +#endif + +/* Forward substitution. Solves Lc = b.*/ + for (I = 1; I <= Size; I++) + { Temp = Intermediate[I]; + +/* This step of the substitution is skipped if Temp equals zero. */ + if ((Temp.Real != 0.0) OR (Temp.Imag != 0.0)) + { pPivot = Matrix->Diag[I]; +/* Cmplx expr: Temp *= (1.0 / Pivot). */ + CMPLX_MULT_ASSIGN(Temp, *pPivot); + Intermediate[I] = Temp; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { +/* Cmplx expr: Intermediate[Element->Row] -= Temp * *Element. */ + CMPLX_MULT_SUBT_ASSIGN(Intermediate[pElement->Row], + Temp, *pElement); + pElement = pElement->NextInCol; + } + } + } + +/* Backward Substitution. Solves Ux = c.*/ + for (I = Size; I > 0; I--) + { Temp = Intermediate[I]; + pElement = Matrix->Diag[I]->NextInRow; + + while (pElement != NULL) + { +/* Cmplx expr: Temp -= *Element * Intermediate[Element->Col]. */ + CMPLX_MULT_SUBT_ASSIGN(Temp, *pElement,Intermediate[pElement->Col]); + pElement = pElement->NextInRow; + } + Intermediate[I] = Temp; + } + +/* Unscramble Intermediate vector while placing data in to Solution vector. */ + pExtOrder = &Matrix->IntToExtColMap[Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Size; I > 0; I--) + { Solution[*(pExtOrder)] = Intermediate[I].Real; + iSolution[*(pExtOrder--)] = Intermediate[I].Imag; + } +#else + ExtVector = (ComplexVector)Solution; + for (I = Size; I > 0; I--) + ExtVector[*(pExtOrder--)] = Intermediate[I]; +#endif + + return; +} +#endif /* spCOMPLEX */ + + + + + + + + + + + + + + +#if TRANSPOSE +/*! + * Performs forward elimination and back substitution to find the + * unknown vector from the RHS vector and transposed factored + * matrix. This routine is useful when performing sensitivity analysis + * on a circuit using the adjoint method. This routine assumes that + * the pivots are associated with the untransposed lower triangular + * matrix and that the diagonal of the untransposed upper + * triangular matrix consists of ones. + * + * \param eMatrix + * Pointer to matrix. + * \param RHS + * \a RHS is the input data array, the right hand side. This data is + * undisturbed and may be reused for other solves. + * \param Solution + * \a Solution is the output data array. This routine is constructed + * such that \a RHS and \a Solution can be the same array. + * \param iRHS + * \a iRHS is the imaginary portion of the input data array, the right + * hand side. This data is undisturbed and may be reused for other solves. + * If \a spSEPARATED_COMPLEX_VECTOR is set false, or if matrix is real, + * there is no need to supply this array. + * \param iSolution + * \a iSolution is the imaginary portion of the output data array. This + * routine is constructed such that \a iRHS and \a iSolution can be + * the same array. If \a spSEPARATED_COMPLEX_VECTOR is set false, or if + * matrix is real, there is no need to supply this array. + */ +/* >>> Local variables: + * Intermediate (RealVector) + * Temporary storage for use in forward elimination and backward + * substitution. Commonly referred to as c, when the LU factorization + * equations are given as Ax = b, Lc = b, Ux = c. Local version of + * Matrix->Intermediate, which was created during the initial + * factorization in function spcCreateInternalVectors() in the matrix + * factorization module. + * pElement (ElementPtr) + * Pointer used to address elements in both the lower and upper triangle + * matrices. + * pExtOrder (int *) + * Pointer used to sequentially access each entry in IntToExtRowMap + * and IntToExtRowMap arrays. Used to quickly scramble and unscramble + * RHS and Solution to account for row and column interchanges. + * pPivot (ElementPtr) + * Pointer that points to current pivot or diagonal element. + * Size (int) + * Size of matrix. Made local to reduce indirection. + * Temp (RealNumber) + * Temporary storage for entries in arrays. + */ + +/*VARARGS3*/ + +void +spSolveTransposed( + spMatrix eMatrix, + spREAL RHS[], + spREAL Solution[] +# if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS + , spREAL iRHS[] + , spREAL iSolution[] +# endif +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register RealVector Intermediate; +register int I, *pExtOrder, Size; +ElementPtr pPivot; +RealNumber Temp; + +/* Begin `spSolveTransposed'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + +#if spCOMPLEX + if (Matrix->Complex) + { SolveComplexTransposedMatrix( Matrix, RHS, Solution IMAG_VECTORS ); + return; + } +#endif + +#if REAL + Size = Matrix->Size; + Intermediate = Matrix->Intermediate; + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET + --RHS; + --Solution; +#endif + +/* Initialize Intermediate vector. */ + pExtOrder = &Matrix->IntToExtColMap[Size]; + for (I = Size; I > 0; I--) + Intermediate[I] = RHS[*(pExtOrder--)]; + +/* Forward elimination. */ + for (I = 1; I <= Size; I++) + { +/* This step of the elimination is skipped if Temp equals zero. */ + if ((Temp = Intermediate[I]) != 0.0) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { Intermediate[pElement->Col] -= Temp * pElement->Real; + pElement = pElement->NextInRow; + } + + } + } + +/* Backward Substitution. */ + for (I = Size; I > 0; I--) + { pPivot = Matrix->Diag[I]; + Temp = Intermediate[I]; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { Temp -= pElement->Real * Intermediate[pElement->Row]; + pElement = pElement->NextInCol; + } + Intermediate[I] = Temp * pPivot->Real; + } + +/* Unscramble Intermediate vector while placing data in to Solution vector. */ + pExtOrder = &Matrix->IntToExtRowMap[Size]; + for (I = Size; I > 0; I--) + Solution[*(pExtOrder--)] = Intermediate[I]; + + return; +#endif /* REAL */ +} +#endif /* TRANSPOSE */ + + + + + + + + + + +#if TRANSPOSE AND spCOMPLEX +/*! + * Performs forward elimination and back substitution to find the + * unknown vector from the RHS vector and transposed factored + * matrix. This routine is useful when performing sensitivity analysis + * on a circuit using the adjoint method. This routine assumes that + * the pivots are associated with the untransposed lower triangular + * matrix and that the diagonal of the untransposed upper + * triangular matrix consists of ones. + * + * \param Matrix + * Pointer to matrix. + * \param RHS + * \a RHS is the input data array, the right hand + * side. This data is undisturbed and may be reused for other solves. + * This vector is only the real portion if the matrix is complex and + * \a spSEPARATED_COMPLEX_VECTORS is set true. + * \param Solution + * \a Solution is the real portion of the output data array. This routine + * is constructed such that \a RHS and \a Solution can be the same array. + * This vector is only the real portion if the matrix is complex and + * \a spSEPARATED_COMPLEX_VECTORS is set true. + * \param iRHS + * \a iRHS is the imaginary portion of the input data array, the right + * hand side. This data is undisturbed and may be reused for other solves. + * If either \a spCOMPLEX or \a spSEPARATED_COMPLEX_VECTOR is set false, + * there is no need to supply this array. + * \param iSolution + * \a iSolution is the imaginary portion of the output data array. This + * routine is constructed such that \a iRHS and \a iSolution can be + * the same array. If \a spCOMPLEX or \a spSEPARATED_COMPLEX_VECTOR is set + * false, there is no need to supply this array. + */ +/* >>> Local variables: + * Intermediate (ComplexVector) + * Temporary storage for use in forward elimination and backward + * substitution. Commonly referred to as c, when the LU factorization + * equations are given as Ax = b, Lc = b, Ux = c. Local version of + * Matrix->Intermediate, which was created during + * the initial factorization in function spcCreateInternalVectors() in the + * matrix factorization module. + * pElement (ElementPtr) + * Pointer used to address elements in both the lower and upper triangle + * matrices. + * pExtOrder (int *) + * Pointer used to sequentially access each entry in IntToExtRowMap + * and IntToExtColMap arrays. Used to quickly scramble and unscramble + * RHS and Solution to account for row and column interchanges. + * pPivot (ElementPtr) + * Pointer that points to current pivot or diagonal element. + * Size (int) + * Size of matrix. Made local to reduce indirection. + * Temp (ComplexNumber) + * Temporary storage for entries in arrays. + */ + +static void +SolveComplexTransposedMatrix( + MatrixPtr Matrix, + RealVector RHS, + RealVector Solution +# if spSEPARATED_COMPLEX_VECTORS + , RealVector iRHS + , RealVector iSolution +# endif +) +{ +register ElementPtr pElement; +register ComplexVector Intermediate; +register int I, *pExtOrder, Size; +register ComplexVector ExtVector; +ElementPtr pPivot; +ComplexNumber Temp; + +/* Begin `SolveComplexTransposedMatrix'. */ + + Size = Matrix->Size; + Intermediate = (ComplexVector)Matrix->Intermediate; + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spSEPARATED_COMPLEX_VECTORS + --RHS; --iRHS; + --Solution; --iSolution; +#else + RHS -= 2; Solution -= 2; +#endif +#endif + +/* Initialize Intermediate vector. */ + pExtOrder = &Matrix->IntToExtColMap[Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Size; I > 0; I--) + { Intermediate[I].Real = RHS[*(pExtOrder)]; + Intermediate[I].Imag = iRHS[*(pExtOrder--)]; + } +#else + ExtVector = (ComplexVector)RHS; + for (I = Size; I > 0; I--) + Intermediate[I] = ExtVector[*(pExtOrder--)]; +#endif + +/* Forward elimination. */ + for (I = 1; I <= Size; I++) + { Temp = Intermediate[I]; + +/* This step of the elimination is skipped if Temp equals zero. */ + if ((Temp.Real != 0.0) OR (Temp.Imag != 0.0)) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { +/* Cmplx expr: Intermediate[Element->Col] -= Temp * *Element. */ + CMPLX_MULT_SUBT_ASSIGN( Intermediate[pElement->Col], + Temp, *pElement); + pElement = pElement->NextInRow; + } + } + } + +/* Backward Substitution. */ + for (I = Size; I > 0; I--) + { pPivot = Matrix->Diag[I]; + Temp = Intermediate[I]; + pElement = pPivot->NextInCol; + + while (pElement != NULL) + { +/* Cmplx expr: Temp -= Intermediate[Element->Row] * *Element. */ + CMPLX_MULT_SUBT_ASSIGN(Temp,Intermediate[pElement->Row],*pElement); + + pElement = pElement->NextInCol; + } +/* Cmplx expr: Intermediate = Temp * (1.0 / *pPivot). */ + CMPLX_MULT(Intermediate[I], Temp, *pPivot); + } + +/* Unscramble Intermediate vector while placing data in to Solution vector. */ + pExtOrder = &Matrix->IntToExtRowMap[Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Size; I > 0; I--) + { Solution[*(pExtOrder)] = Intermediate[I].Real; + iSolution[*(pExtOrder--)] = Intermediate[I].Imag; + } +#else + ExtVector = (ComplexVector)Solution; + for (I = Size; I > 0; I--) + ExtVector[*(pExtOrder--)] = Intermediate[I]; +#endif + + return; +} +#endif /* TRANSPOSE AND spCOMPLEX */ Added: trunk/math/SPARSE/sputils.c =================================================================== --- trunk/math/SPARSE/sputils.c (rev 0) +++ trunk/math/SPARSE/sputils.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,2188 @@ +/* + * MATRIX UTILITY MODULE + * + * Author: Advising professor: + * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli + * UC Berkeley + */ +/*! \file + * This file contains various optional utility routines. + * + * Objects that begin with the \a spc prefix are considered private + * and should not be used. + * + * \author + * Kenneth S. Kundert <kundert-Rn4VEauK+AKRv+LV9MX5uipxlwaOVQ5f@xxxxxxxxxxxxxxxx> + */ +/* >>> User accessible functions contained in this file: + * spMNA_Preorder + * spScale + * spMultiply + * spMultTransposed + * spDeterminant + * spStrip + * spDeleteRowAndCol + * spPseudoCondition + * spCondition + * spNorm + * spLargestElement + * spRoundoff + * spErrorMessage + * + * >>> Other functions contained in this file: + * CountTwins + * SwapCols + * ScaleComplexMatrix + * ComplexMatrixMultiply + * ComplexCondition + */ + +/* + * IMPORTS + * + * >>> Import descriptions: + * spConfig.h + * Macros that customize the sparse matrix routines. + * spMatrix.h + * Macros and declarations to be imported by the user. + * spDefs.h + * Matrix type and macro definitions for the sparse matrix routines.. + */ + +#define spINSIDE_SPARSE +#include <core/core.h> +#include "../m.h" +#include "spconfig.h" +#include "spmatrix.h" +#include "spdefs.h" + + + + + +/* + * Function declarations + */ + +static int CountTwins( MatrixPtr, int, ElementPtr*, ElementPtr* ); +static void SwapCols( MatrixPtr, ElementPtr, ElementPtr ); +static void ScaleComplexMatrix( MatrixPtr, RealVector, RealVector ); +#if spSEPARATED_COMPLEX_VECTORS +static void ComplexMatrixMultiply( MatrixPtr, + RealVector, RealVector, RealVector, RealVector ); +static void ComplexTransposedMatrixMultiply( MatrixPtr, + RealVector, RealVector, RealVector, RealVector ); +#else +static void ComplexMatrixMultiply( MatrixPtr, + RealVector, RealVector ); +static void ComplexTransposedMatrixMultiply( MatrixPtr, + RealVector, RealVector ); +#endif +static RealNumber ComplexCondition( MatrixPtr, RealNumber, int* ); + + + + + + +#if MODIFIED_NODAL +/*! + * This routine massages modified node admittance matrices to remove + * zeros from the diagonal. It takes advantage of the fact that the + * row and column associated with a zero diagonal usually have + * structural ones placed symmetricly. This routine should be used + * only on modified node admittance matrices and should be executed + * after the matrix has been built but before the factorization + * begins. It should be executed for the initial factorization only + * and should be executed before the rows have been linked. Thus it + * should be run before using spScale(), spMultiply(), + * spDeleteRowAndCol(), or spNorm(). + * + * This routine exploits the fact that the structural ones are placed + * in the matrix in symmetric twins. For example, the stamps for + * grounded and a floating voltage sources are \code + * grounded: floating: + * [ x x 1 ] [ x x 1 ] + * [ x x ] [ x x -1 ] + * [ 1 ] [ 1 -1 ] + * \endcode + * Notice for the grounded source, there is one set of twins, and for + * the floating, there are two sets. We remove the zero from the diagonal + * by swapping the rows associated with a set of twins. For example: \code + * grounded: floating 1: floating 2: + * [ 1 ] [ 1 -1 ] [ x x 1 ] + * [ x x ] [ x x -1 ] [ 1 -1 ] + * [ x x 1 ] [ x x 1 ] [ x x -1 ] + * \endcode + * + * It is important to deal with any zero diagonals that only have one + * set of twins before dealing with those that have more than one because + * swapping row destroys the symmetry of any twins in the rows being + * swapped, which may limit future moves. Consider \code + * [ x x 1 ] + * [ x x -1 1 ] + * [ 1 -1 ] + * [ 1 ] + * \endcode + * There is one set of twins for diagonal 4 and two for diagonal 3. + * Dealing with diagonal 4 first requires swapping rows 2 and 4. \code + * [ x x 1 ] + * [ 1 ] + * [ 1 -1 ] + * [ x x -1 1 ] + * \endcode + * We can now deal with diagonal 3 by swapping rows 1 and 3. \code + * [ 1 -1 ] + * [ 1 ] + * [ x x 1 ] + * [ x x -1 1 ] + * \endcode + * And we are done, there are no zeros left on the diagonal. However, if + * we originally dealt with diagonal 3 first, we could swap rows 2 and 3 \code + * [ x x 1 ] + * [ 1 -1 ] + * [ x x -1 1 ] + * [ 1 ] + * \endcode + * Diagonal 4 no longer has a symmetric twin and we cannot continue. + * + * So we always take care of lone twins first. When none remain, we + * choose arbitrarily a set of twins for a diagonal with more than one set + * and swap the rows corresponding to that twin. We then deal with any + * lone twins that were created and repeat the procedure until no + * zero diagonals with symmetric twins remain. + * + * In this particular implementation, columns are swapped rather than rows. + * The algorithm used in this function was developed by Ken Kundert and + * Tom Quarles. + * + * \param * eMatrix + * Pointer to the matrix to be preordered. + */ +/* >>> Local variables; + * J (int) + * Column with zero diagonal being currently considered. + * pTwin1 (ElementPtr) + * Pointer to the twin found in the column belonging to the zero diagonal. + * pTwin2 (ElementPtr) + * Pointer to the twin found in the row belonging to the zero diagonal. + * belonging to the zero diagonal. + * AnotherPassNeeded (BOOLEAN) + * Flag indicating that at least one zero diagonal with symmetric twins + * remain. + * StartAt (int) + * Column number of first zero diagonal with symmetric twins. + * Swapped (BOOLEAN) + * Flag indicating that columns were swapped on this pass. + * Twins (int) + * Number of symmetric twins corresponding to current zero diagonal.. + */ + +void +spMNA_Preorder( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int J, Size; +ElementPtr pTwin1=NULL, pTwin2=NULL; +int Twins, StartAt = 1; +BOOLEAN Swapped, AnotherPassNeeded; + +/* Begin `spMNA_Preorder'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + + if (Matrix->RowsLinked) return; + Size = Matrix->Size; + Matrix->Reordered = YES; + + do + { AnotherPassNeeded = Swapped = NO; + +/* Search for zero diagonals with lone twins. */ + for (J = StartAt; J <= Size; J++) + { if (Matrix->Diag[J] == NULL) + { Twins = CountTwins( Matrix, J, &pTwin1, &pTwin2 ); + if (Twins == 1) + { /* Lone twins found, swap rows. */ + SwapCols( Matrix, pTwin1, pTwin2 ); + Swapped = YES; + } + else if ((Twins > 1) AND NOT AnotherPassNeeded) + { AnotherPassNeeded = YES; + StartAt = J; + } + } + } + +/* All lone twins are gone, look for zero diagonals with multiple twins. */ + if (AnotherPassNeeded) + { for (J = StartAt; NOT Swapped AND (J <= Size); J++) + { if (Matrix->Diag[J] == NULL) + { Twins = CountTwins( Matrix, J, &pTwin1, &pTwin2 ); + SwapCols( Matrix, pTwin1, pTwin2 ); + Swapped = YES; + } + } + } + } while (AnotherPassNeeded); + return; +} + + + + +/* + * COUNT TWINS + * + * This function counts the number of symmetric twins associated with + * a zero diagonal and returns one set of twins if any exist. The + * count is terminated early at two. + */ + +static int +CountTwins( + MatrixPtr Matrix, + int Col, + ElementPtr *ppTwin1, + ElementPtr *ppTwin2 +) +{ +int Row, Twins = 0; +ElementPtr pTwin1, pTwin2; + +/* Begin `CountTwins'. */ + + pTwin1 = Matrix->FirstInCol[Col]; + while (pTwin1 != NULL) + { if (ABS(pTwin1->Real) == 1.0) + { Row = pTwin1->Row; + pTwin2 = Matrix->FirstInCol[Row]; + while ((pTwin2 != NULL) AND (pTwin2->Row != Col)) + pTwin2 = pTwin2->NextInCol; + if ((pTwin2 != NULL) AND (ABS(pTwin2->Real) == 1.0)) + { /* Found symmetric twins. */ + if (++Twins >= 2) return Twins; + (*ppTwin1 = pTwin1)->Col = Col; + (*ppTwin2 = pTwin2)->Col = Row; + } + } + pTwin1 = pTwin1->NextInCol; + } + return Twins; +} + + + + +/* + * SWAP COLUMNS + * + * This function swaps two columns and is applicable before the rows are + * linked. + */ + +static void +SwapCols( + MatrixPtr Matrix, + ElementPtr pTwin1, + ElementPtr pTwin2 +) +{ +int Col1 = pTwin1->Col, Col2 = pTwin2->Col; + +/* Begin `SwapCols'. */ + + SWAP (ElementPtr, Matrix->FirstInCol[Col1], Matrix->FirstInCol[Col2]); + SWAP (int, Matrix->IntToExtColMap[Col1], Matrix->IntToExtColMap[Col2]); +#if TRANSLATE + Matrix->ExtToIntColMap[Matrix->IntToExtColMap[Col2]]=Col2; + Matrix->ExtToIntColMap[Matrix->IntToExtColMap[Col1]]=Col1; +#endif + + Matrix->Diag[Col1] = pTwin2; + Matrix->Diag[Col2] = pTwin1; + Matrix->NumberOfInterchangesIsOdd = NOT Matrix->NumberOfInterchangesIsOdd; + return; +} +#endif /* MODIFIED_NODAL */ + + + + + + + + + +#if SCALING +/*! + * This function scales the matrix to enhance the possibility of + * finding a good pivoting order. Note that scaling enhances accuracy + * of the solution only if it affects the pivoting order, so it makes + * no sense to scale the matrix before spFactor(). If scaling is + * desired it should be done before spOrderAndFactor(). There + * are several things to take into account when choosing the scale + * factors. First, the scale factors are directly multiplied against + * the elements in the matrix. To prevent roundoff, each scale factor + * should be equal to an integer power of the number base of the + * machine. Since most machines operate in base two, scale factors + * should be a power of two. Second, the matrix should be scaled such + * that the matrix of element uncertainties is equilibrated. Third, + * this function multiplies the scale factors by the elements, so if + * one row tends to have uncertainties 1000 times smaller than the + * other rows, then its scale factor should be 1024, not 1/1024. + * Fourth, to save time, this function does not scale rows or columns + * if their scale factors are equal to one. Thus, the scale factors + * should be normalized to the most common scale factor. Rows and + * columns should be normalized separately. For example, if the size + * of the matrix is 100 and 10 rows tend to have uncertainties near + * 1e-6 and the remaining 90 have uncertainties near 1e-12, then the + * scale factor for the 10 should be 1/1,048,576 and the scale factors + * for the remaining 90 should be 1. Fifth, since this routine + * directly operates on the matrix, it is necessary to apply the scale + * factors to the RHS and Solution vectors. It may be easier to + * simply use spOrderAndFactor() on a scaled matrix to choose the + * pivoting order, and then throw away the matrix. Subsequent + * factorizations, performed with spFactor(), will not need to have + * the RHS and Solution vectors descaled. Lastly, this function + * should not be executed before the function spMNA_Preorder(). + * + * \param eMatrix + * Pointer to the matrix to be scaled. + * \param SolutionScaleFactors + * The array of Solution scale factors. These factors scale the columns. + * All scale factors are real valued. + * \param RHS_ScaleFactors + * The array of RHS scale factors. These factors scale the rows. + * All scale factors are real valued. + */ +/* >>> Local variables: + * lSize (int) + * Local version of the size of the matrix. + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * pExtOrder (int *) + * Pointer into either IntToExtRowMap or IntToExtColMap vector. Used to + * compensate for any row or column swaps that have been performed. + * ScaleFactor (RealNumber) + * The scale factor being used on the current row or column. + */ + +void +spScale( + spMatrix eMatrix, + spREAL RHS_ScaleFactors[], + spREAL SolutionScaleFactors[] +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register int I, lSize, *pExtOrder; +RealNumber ScaleFactor; + +/* Begin `spScale'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + if (NOT Matrix->RowsLinked) spcLinkRows( Matrix ); + +#if spCOMPLEX + if (Matrix->Complex) + { ScaleComplexMatrix( Matrix, RHS_ScaleFactors, SolutionScaleFactors ); + return; + } +#endif + +#if REAL + lSize = Matrix->Size; + +/* Correct pointers to arrays for ARRAY_OFFSET */ +#if NOT ARRAY_OFFSET + --RHS_ScaleFactors; + --SolutionScaleFactors; +#endif + +/* Scale Rows */ + pExtOrder = &Matrix->IntToExtRowMap[1]; + for (I = 1; I <= lSize; I++) + { if ((ScaleFactor = RHS_ScaleFactors[*(pExtOrder++)]) != 1.0) + { pElement = Matrix->FirstInRow[I]; + + while (pElement != NULL) + { pElement->Real *= ScaleFactor; + pElement = pElement->NextInRow; + } + } + } + +/* Scale Columns */ + pExtOrder = &Matrix->IntToExtColMap[1]; + for (I = 1; I <= lSize; I++) + { if ((ScaleFactor = SolutionScaleFactors[*(pExtOrder++)]) != 1.0) + { pElement = Matrix->FirstInCol[I]; + + while (pElement != NULL) + { pElement->Real *= ScaleFactor; + pElement = pElement->NextInCol; + } + } + } + return; + +#endif /* REAL */ +} +#endif /* SCALING */ + + + + + + + + + +#if spCOMPLEX AND SCALING +/* + * SCALE COMPLEX MATRIX + * + * This function scales the matrix to enhance the possibility of + * finding a good pivoting order. Note that scaling enhances accuracy + * of the solution only if it affects the pivoting order, so it makes + * no sense to scale the matrix before spFactor(). If scaling is + * desired it should be done before spOrderAndFactor(). There + * are several things to take into account when choosing the scale + * factors. First, the scale factors are directly multiplied against + * the elements in the matrix. To prevent roundoff, each scale factor + * should be equal to an integer power of the number base of the + * machine. Since most machines operate in base two, scale factors + * should be a power of two. Second, the matrix should be scaled such + * that the matrix of element uncertainties is equilibrated. Third, + * this function multiplies the scale factors by the elements, so if + * one row tends to have uncertainties 1000 times smaller than the + * other rows, then its scale factor should be 1024, not 1/1024. + * Fourth, to save time, this function does not scale rows or columns + * if their scale factors are equal to one. Thus, the scale factors + * should be normalized to the most common scale factor. Rows and + * columns should be normalized separately. For example, if the size + * of the matrix is 100 and 10 rows tend to have uncertainties near + * 1e-6 and the remaining 90 have uncertainties near 1e-12, then the + * scale factor for the 10 should be 1/1,048,576 and the scale factors + * for the remaining 90 should be 1. Fifth, since this routine + * directly operates on the matrix, it is necessary to apply the scale + * factors to the RHS and Solution vectors. It may be easier to + * simply use spOrderAndFactor() on a scaled matrix to choose the + * pivoting order, and then throw away the matrix. Subsequent + * factorizations, performed with spFactor(), will not need to have + * the RHS and Solution vectors descaled. Lastly, this function + * should not be executed before the function spMNA_Preorder. + * + * >>> Arguments: + * Matrix <input> (char *) + * Pointer to the matrix to be scaled. + * SolutionScaleFactors <input> (RealVector) + * The array of Solution scale factors. These factors scale the columns. + * All scale factors are real valued. + * RHS_ScaleFactors <input> (RealVector) + * The array of RHS scale factors. These factors scale the rows. + * All scale factors are real valued. + * + * >>> Local variables: + * lSize (int) + * Local version of the size of the matrix. + * pElement (ElementPtr) + * Pointer to an element in the matrix. + * pExtOrder (int *) + * Pointer into either IntToExtRowMap or IntToExtColMap vector. Used to + * compensate for any row or column swaps that have been performed. + * ScaleFactor (RealNumber) + * The scale factor being used on the current row or column. + */ + +static void +ScaleComplexMatrix( + MatrixPtr Matrix, + register RealVector RHS_ScaleFactors, + register RealVector SolutionScaleFactors +) +{ +register ElementPtr pElement; +register int I, lSize, *pExtOrder; +RealNumber ScaleFactor; + +/* Begin `ScaleComplexMatrix'. */ + lSize = Matrix->Size; + +/* Correct pointers to arrays for ARRAY_OFFSET */ +#if NOT ARRAY_OFFSET + --RHS_ScaleFactors; + --SolutionScaleFactors; +#endif + +/* Scale Rows */ + pExtOrder = &Matrix->IntToExtRowMap[1]; + for (I = 1; I <= lSize; I++) + { if ((ScaleFactor = RHS_ScaleFactors[*(pExtOrder++)]) != 1.0) + { pElement = Matrix->FirstInRow[I]; + + while (pElement != NULL) + { pElement->Real *= ScaleFactor; + pElement->Imag *= ScaleFactor; + pElement = pElement->NextInRow; + } + } + } + +/* Scale Columns */ + pExtOrder = &Matrix->IntToExtColMap[1]; + for (I = 1; I <= lSize; I++) + { if ((ScaleFactor = SolutionScaleFactors[*(pExtOrder++)]) != 1.0) + { pElement = Matrix->FirstInCol[I]; + + while (pElement != NULL) + { pElement->Real *= ScaleFactor; + pElement->Imag *= ScaleFactor; + pElement = pElement->NextInCol; + } + } + } + return; +} +#endif /* SCALING AND spCOMPLEX */ + + + + + + + + +#if MULTIPLICATION +/*! + * Multiplies matrix by solution vector to find source vector. + * Assumes matrix has not been factored. This routine can be used + * as a test to see if solutions are correct. It should not be used + * before spMNA_Preorder(). + * + * \param eMatrix + * Pointer to the matrix. + * \param RHS + * RHS is the right hand side. This is what is being solved for. + * \param Solution + * Solution is the vector being multiplied by the matrix. + * \param iRHS + * iRHS is the imaginary portion of the right hand side. This is + * what is being solved for. This is only necessary if the matrix is + * complex and \a spSEPARATED_COMPLEX_VECTORS is true. + * \param iSolution + * iSolution is the imaginary portion of the vector being multiplied + * by the matrix. This is only necessary if the matrix is + * complex and \a spSEPARATED_COMPLEX_VECTORS is true. + */ + +void +spMultiply( + spMatrix eMatrix, + spREAL RHS[], + spREAL Solution[] +#if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS + , spREAL iRHS[] + , spREAL iSolution[] +#endif +) +{ +register ElementPtr pElement; +register RealVector Vector; +register RealNumber Sum; +register int I, *pExtOrder; +MatrixPtr Matrix = (MatrixPtr)eMatrix; + +/* Begin `spMultiply'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + if (NOT Matrix->RowsLinked) + spcLinkRows(Matrix); + if (NOT Matrix->InternalVectorsAllocated) + spcCreateInternalVectors( Matrix ); + +#if spCOMPLEX + if (Matrix->Complex) + { ComplexMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS ); + return; + } +#endif + +#if REAL +#if NOT ARRAY_OFFSET +/* Correct array pointers for ARRAY_OFFSET. */ + --RHS; + --Solution; +#endif + +/* Initialize Intermediate vector with reordered Solution vector. */ + Vector = Matrix->Intermediate; + pExtOrder = &Matrix->IntToExtColMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + Vector[I] = Solution[*(pExtOrder--)]; + + pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInRow[I]; + Sum = 0.0; + + while (pElement != NULL) + { Sum += pElement->Real * Vector[pElement->Col]; + pElement = pElement->NextInRow; + } + RHS[*pExtOrder--] = Sum; + } + return; +#endif /* REAL */ +} +#endif /* MULTIPLICATION */ + + + + + + + +#if spCOMPLEX AND MULTIPLICATION +/* + * COMPLEX MATRIX MULTIPLICATION + * + * Multiplies matrix by solution vector to find source vector. + * Assumes matrix has not been factored. This routine can be used + * as a test to see if solutions are correct. + * + * >>> Arguments: + * Matrix <input> (char *) + * Pointer to the matrix. + * RHS <output> (RealVector) + * RHS is the right hand side. This is what is being solved for. + * This is only the real portion of the right-hand side if the matrix + * is complex and spSEPARATED_COMPLEX_VECTORS is set true. + * Solution <input> (RealVector) + * Solution is the vector being multiplied by the matrix. This is only + * the real portion if the matrix is complex and + * spSEPARATED_COMPLEX_VECTORS is set true. + * iRHS <output> (RealVector) + * iRHS is the imaginary portion of the right hand side. This is + * what is being solved for. This is only necessary if the matrix is + * complex and spSEPARATED_COMPLEX_VECTORS is true. + * iSolution <input> (RealVector) + * iSolution is the imaginary portion of the vector being multiplied + * by the matrix. This is only necessary if the matrix is + * complex and spSEPARATED_COMPLEX_VECTORS is true. + */ + +static void +ComplexMatrixMultiply( + MatrixPtr Matrix, + RealVector RHS, + RealVector Solution +#if spSEPARATED_COMPLEX_VECTORS + , RealVector iRHS + , RealVector iSolution +#endif +) +{ +register ElementPtr pElement; +register ComplexVector Vector; +ComplexNumber Sum; +register int I, *pExtOrder; + +/* Begin `ComplexMatrixMultiply'. */ + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spSEPARATED_COMPLEX_VECTORS + --RHS; --iRHS; + --Solution; --iSolution; +#else + RHS -= 2; Solution -= 2; +#endif +#endif + +/* Initialize Intermediate vector with reordered Solution vector. */ + Vector = (ComplexVector)Matrix->Intermediate; + pExtOrder = &Matrix->IntToExtColMap[Matrix->Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Matrix->Size; I > 0; I--) + { Vector[I].Real = Solution[*pExtOrder]; + Vector[I].Imag = iSolution[*(pExtOrder--)]; + } +#else + for (I = Matrix->Size; I > 0; I--) + Vector[I] = ((ComplexVector)Solution)[*(pExtOrder--)]; +#endif + + pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInRow[I]; + Sum.Real = Sum.Imag = 0.0; + + while (pElement != NULL) + { /* Cmplx expression : Sum += Element * Vector[Col] */ + CMPLX_MULT_ADD_ASSIGN( Sum, *pElement, Vector[pElement->Col] ); + pElement = pElement->NextInRow; + } + +#if spSEPARATED_COMPLEX_VECTORS + RHS[*pExtOrder] = Sum.Real; + iRHS[*pExtOrder--] = Sum.Imag; +#else + ((ComplexVector)RHS)[*pExtOrder--] = Sum; +#endif + } + return; +} +#endif /* spCOMPLEX AND MULTIPLICATION */ + + + + + + + + +#if MULTIPLICATION AND TRANSPOSE +/*! + * Multiplies transposed matrix by solution vector to find source vector. + * Assumes matrix has not been factored. This routine can be used + * as a test to see if solutions are correct. It should not be used + * before spMNA_Preorder(). + * + * \param eMatrix + * Pointer to the matrix. + * \param RHS + * RHS is the right hand side. This is what is being solved for. + * \param Solution + * Solution is the vector being multiplied by the matrix. + * \param iRHS + * iRHS is the imaginary portion of the right hand side. This is + * what is being solved for. This is only necessary if the matrix is + * complex and \a spSEPARATED_COMPLEX_VECTORS is true. + * \param iSolution + * iSolution is the imaginary portion of the vector being multiplied + * by the matrix. This is only necessary if the matrix is + * complex and \a spSEPARATED_COMPLEX_VECTORS is true. + */ + +void +spMultTransposed( + spMatrix eMatrix, + spREAL RHS[], + spREAL Solution[] +#if spCOMPLEX AND spSEPARATED_COMPLEX_VECTORS + , spREAL iRHS[] + , spREAL iSolution[] +#endif +) +{ +register ElementPtr pElement; +register RealVector Vector; +register RealNumber Sum; +register int I, *pExtOrder; +MatrixPtr Matrix = (MatrixPtr)eMatrix; + +/* Begin `spMultTransposed'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + if (NOT Matrix->InternalVectorsAllocated) + spcCreateInternalVectors( Matrix ); + +#if spCOMPLEX + if (Matrix->Complex) + { ComplexTransposedMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS ); + return; + } +#endif + +#if REAL +#if NOT ARRAY_OFFSET +/* Correct array pointers for ARRAY_OFFSET. */ + --RHS; + --Solution; +#endif + +/* Initialize Intermediate vector with reordered Solution vector. */ + Vector = Matrix->Intermediate; + pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + Vector[I] = Solution[*(pExtOrder--)]; + + pExtOrder = &Matrix->IntToExtColMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInCol[I]; + Sum = 0.0; + + while (pElement != NULL) + { Sum += pElement->Real * Vector[pElement->Row]; + pElement = pElement->NextInCol; + } + RHS[*pExtOrder--] = Sum; + } + return; +#endif /* REAL */ +} +#endif /* MULTIPLICATION AND TRANSPOSE */ + + + + + + + +#if spCOMPLEX AND MULTIPLICATION AND TRANSPOSE +/* + * COMPLEX TRANSPOSED MATRIX MULTIPLICATION + * + * Multiplies transposed matrix by solution vector to find source vector. + * Assumes matrix has not been factored. This routine can be used + * as a test to see if solutions are correct. + * + * >>> Arguments: + * Matrix <input> (char *) + * Pointer to the matrix. + * RHS <output> (RealVector) + * RHS is the right hand side. This is what is being solved for. + * This is only the real portion of the right-hand side if the matrix + * is complex and spSEPARATED_COMPLEX_VECTORS is set true. + * Solution <input> (RealVector) + * Solution is the vector being multiplied by the matrix. This is only + * the real portion if the matrix is complex and + * spSEPARATED_COMPLEX_VECTORS is set true. + * iRHS <output> (RealVector) + * iRHS is the imaginary portion of the right hand side. This is + * what is being solved for. This is only necessary if the matrix is + * complex and spSEPARATED_COMPLEX_VECTORS is true. + * iSolution <input> (RealVector) + * iSolution is the imaginary portion of the vector being multiplied + * by the matrix. This is only necessary if the matrix is + * complex and spSEPARATED_COMPLEX_VECTORS is true. + * + * >>> Obscure Macros + * IMAG_VECTORS + * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and + * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears + * without a trace. + */ + +static void +ComplexTransposedMatrixMultiply( + MatrixPtr Matrix, + RealVector RHS, + RealVector Solution +#if spSEPARATED_COMPLEX_VECTORS + , RealVector iRHS + , RealVector iSolution +#endif +) +{ +register ElementPtr pElement; +register ComplexVector Vector; +ComplexNumber Sum; +register int I, *pExtOrder; + +/* Begin `ComplexTransposedMatrixMultiply'. */ + +/* Correct array pointers for ARRAY_OFFSET. */ +#if NOT ARRAY_OFFSET +#if spSEPARATED_COMPLEX_VECTORS + --RHS; --iRHS; + --Solution; --iSolution; +#else + RHS -= 2; Solution -= 2; +#endif +#endif + +/* Initialize Intermediate vector with reordered Solution vector. */ + Vector = (ComplexVector)Matrix->Intermediate; + pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size]; + +#if spSEPARATED_COMPLEX_VECTORS + for (I = Matrix->Size; I > 0; I--) + { Vector[I].Real = Solution[*pExtOrder]; + Vector[I].Imag = iSolution[*(pExtOrder--)]; + } +#else + for (I = Matrix->Size; I > 0; I--) + Vector[I] = ((ComplexVector)Solution)[*(pExtOrder--)]; +#endif + + pExtOrder = &Matrix->IntToExtColMap[Matrix->Size]; + for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInCol[I]; + Sum.Real = Sum.Imag = 0.0; + + while (pElement != NULL) + { /* Cmplx expression : Sum += Element * Vector[Row] */ + CMPLX_MULT_ADD_ASSIGN( Sum, *pElement, Vector[pElement->Row] ); + pElement = pElement->NextInCol; + } + +#if spSEPARATED_COMPLEX_VECTORS + RHS[*pExtOrder] = Sum.Real; + iRHS[*pExtOrder--] = Sum.Imag; +#else + ((ComplexVector)RHS)[*pExtOrder--] = Sum; +#endif + } + return; +} +#endif /* spCOMPLEX AND MULTIPLICATION AND TRANSPOSE */ + + + + + + + + +#if DETERMINANT +/*! + * This routine in capable of calculating the determinant of the + * matrix once the LU factorization has been performed. Hence, only + * use this routine after spFactor() and before spClear(). + * The determinant equals the product of all the diagonal elements of + * the lower triangular matrix L, except that this product may need + * negating. Whether the product or the negative product equals the + * determinant is determined by the number of row and column + * interchanges performed. Note that the determinants of matrices can + * be very large or very small. On large matrices, the determinant + * can be far larger or smaller than can be represented by a floating + * point number. For this reason the determinant is scaled to a + * reasonable value and the logarithm of the scale factor is returned. + * + * \param eMatrix + * A pointer to the matrix for which the determinant is desired. + * \param pExponent + * The logarithm base 10 of the scale factor for the determinant. To find + * the actual determinant, Exponent should be added to the exponent of + * Determinant. + * \param pDeterminant + * The real portion of the determinant. This number is scaled to be + * greater than or equal to 1.0 and less than 10.0. + * \param piDeterminant + * The imaginary portion of the determinant. When the matrix is real + * this pointer need not be supplied, nothing will be returned. This + * number is scaled to be greater than or equal to 1.0 and less than 10.0. + */ +/* >>> Local variables: + * Norm (RealNumber) + * L-infinity norm of a complex number. + * Size (int) + * Local storage for Matrix->Size. Placed in a register for speed. + * Temp (RealNumber) + * Temporary storage for real portion of determinant. + */ + +void +spDeterminant( + spMatrix eMatrix, + int *pExponent, + spREAL *pDeterminant +#if spCOMPLEX + , spREAL *piDeterminant +#endif +) +{ +register MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int I, Size; +RealNumber Norm, nr, ni; +ComplexNumber Pivot, cDeterminant; + +#define NORM(a) (nr = ABS((a).Real), ni = ABS((a).Imag), MAX (nr,ni)) + +/* Begin `spDeterminant'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + *pExponent = 0; + + if (Matrix->Error == spSINGULAR) + { *pDeterminant = 0.0; +#if spCOMPLEX + if (Matrix->Complex) *piDeterminant = 0.0; +#endif + return; + } + + Size = Matrix->Size; + I = 0; + +#if spCOMPLEX + if (Matrix->Complex) /* Complex Case. */ + { cDeterminant.Real = 1.0; + cDeterminant.Imag = 0.0; + + while (++I <= Size) + { CMPLX_RECIPROCAL( Pivot, *Matrix->Diag[I] ); + CMPLX_MULT_ASSIGN( cDeterminant, Pivot ); + +/* Scale Determinant. */ + Norm = NORM( cDeterminant ); + if (Norm != 0.0) + { while (Norm >= 1.0e12) + { cDeterminant.Real *= 1.0e-12; + cDeterminant.Imag *= 1.0e-12; + *pExponent += 12; + Norm = NORM( cDeterminant ); + } + while (Norm < 1.0e-12) + { cDeterminant.Real *= 1.0e12; + cDeterminant.Imag *= 1.0e12; + *pExponent -= 12; + Norm = NORM( cDeterminant ); + } + } + } + +/* Scale Determinant again, this time to be between 1.0 <= x < 10.0. */ + Norm = NORM( cDeterminant ); + if (Norm != 0.0) + { while (Norm >= 10.0) + { cDeterminant.Real *= 0.1; + cDeterminant.Imag *= 0.1; + (*pExponent)++; + Norm = NORM( cDeterminant ); + } + while (Norm < 1.0) + { cDeterminant.Real *= 10.0; + cDeterminant.Imag *= 10.0; + (*pExponent)--; + Norm = NORM( cDeterminant ); + } + } + if (Matrix->NumberOfInterchangesIsOdd) + CMPLX_NEGATE( cDeterminant ); + + *pDeterminant = cDeterminant.Real; + *piDeterminant = cDeterminant.Imag; + } +#endif /* spCOMPLEX */ +#if REAL AND spCOMPLEX + else +#endif +#if REAL + { /* Real Case. */ + *pDeterminant = 1.0; + + while (++I <= Size) + { *pDeterminant /= Matrix->Diag[I]->Real; + +/* Scale Determinant. */ + if (*pDeterminant != 0.0) + { while (ABS(*pDeterminant) >= 1.0e12) + { *pDeterminant *= 1.0e-12; + *pExponent += 12; + } + while (ABS(*pDeterminant) < 1.0e-12) + { *pDeterminant *= 1.0e12; + *pExponent -= 12; + } + } + } + +/* Scale Determinant again, this time to be between 1.0 <= x < 10.0. */ + if (*pDeterminant != 0.0) + { while (ABS(*pDeterminant) >= 10.0) + { *pDeterminant *= 0.1; + (*pExponent)++; + } + while (ABS(*pDeterminant) < 1.0) + { *pDeterminant *= 10.0; + (*pExponent)--; + } + } + if (Matrix->NumberOfInterchangesIsOdd) + *pDeterminant = -*pDeterminant; + } +#endif /* REAL */ +} +#endif /* DETERMINANT */ + + + + + + + + +#if STRIP + +/*! + * Strips the matrix of all fill-ins. + * + * \param eMatrix + * Pointer to the matrix to be stripped. + */ +/* >>> Local variables: + * pElement (ElementPtr) + * Pointer that is used to step through the matrix. + * ppElement (ElementPtr *) + * Pointer to the location of an ElementPtr. This location will be + * updated if a fill-in is stripped from the matrix. + * pFillin (ElementPtr) + * Pointer used to step through the lists of fill-ins while marking them. + * pLastFillin (ElementPtr) + * A pointer to the last fill-in in the list. Used to terminate a loop. + * pListNode (struct FillinListNodeStruct *) + * A pointer to a node in the FillinList linked-list. + */ + +void +spStripFills( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +struct FillinListNodeStruct *pListNode; + +/* Begin `spStripFills'. */ + ASSERT_IS_SPARSE( Matrix ); + if (Matrix->Fillins == 0) return; + Matrix->NeedsOrdering = YES; + Matrix->Elements -= Matrix->Fillins; + Matrix->Fillins = 0; + +/* Mark the fill-ins. */ + { register ElementPtr pFillin, pLastFillin; + + pListNode = Matrix->LastFillinListNode = Matrix->FirstFillinListNode; + Matrix->FillinsRemaining = pListNode->NumberOfFillinsInList; + Matrix->NextAvailFillin = pListNode->pFillinList; + + while (pListNode != NULL) + { pFillin = pListNode->pFillinList; + pLastFillin = &(pFillin[ pListNode->NumberOfFillinsInList - 1 ]); + while (pFillin <= pLastFillin) + (pFillin++)->Row = 0; + pListNode = pListNode->Next; + } + } + +/* Unlink fill-ins by searching for elements marked with Row = 0. */ + { register ElementPtr pElement, *ppElement; + register int I, Size = Matrix->Size; + +/* Unlink fill-ins in all columns. */ + for (I = 1; I <= Size; I++) + { ppElement = &(Matrix->FirstInCol[I]); + while ((pElement = *ppElement) != NULL) + { if (pElement->Row == 0) + { *ppElement = pElement->NextInCol; /* Unlink fill-in. */ + if (Matrix->Diag[pElement->Col] == pElement) + Matrix->Diag[pElement->Col] = NULL; + } + else + ppElement = &pElement->NextInCol; /* Skip element.. */ + } + } + +/* Unlink fill-ins in all rows. */ + for (I = 1; I <= Size; I++) + { ppElement = &(Matrix->FirstInRow[I]); + while ((pElement = *ppElement) != NULL) + { if (pElement->Row == 0) + *ppElement = pElement->NextInRow; /* Unlink fill-in. */ + else + ppElement = &pElement->NextInRow; /* Skip element.. */ + } + } + } + return; +} +#endif + + + + + + + +#if TRANSLATE AND DELETE +/*! + * Deletes a row and a column from a matrix. + * + * Sparse will abort if an attempt is made to delete a row or column that + * doesn't exist. + * + * \param eMatrix + * Pointer to the matrix in which the row and column are to be deleted. + * \param Row + * Row to be deleted. + * \param Col + * Column to be deleted. + */ +/* >>> Local variables: + * ExtCol (int) + * The external column that is being deleted. + * ExtRow (int) + * The external row that is being deleted. + * pElement (ElementPtr) + * Pointer to an element in the matrix. Used when scanning rows and + * columns in order to eliminate elements from the last row or column. + * ppElement (ElementPtr *) + * Pointer to the location of an ElementPtr. This location will be + * filled with a NULL pointer if it is the new last element in its row + * or column. + * pElement (ElementPtr) + * Pointer to an element in the last row or column of the matrix. + * Size (int) + * The local version Matrix->Size, the size of the matrix. + */ + +void +spDeleteRowAndCol( + spMatrix eMatrix, + int Row, + int Col +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement, *ppElement, pLastElement; +int Size, ExtRow, ExtCol; + +/* Begin `spDeleteRowAndCol'. */ + ASSERT_IS_SPARSE( Matrix ); + vASSERT( (Row > 0) AND (Col > 0), "Nonpositive row or column number" ); + vASSERT( (Row <= Matrix->ExtSize) AND (Col <= Matrix->ExtSize), + "Row or column number too large" ); + + Size = Matrix->Size; + ExtRow = Row; + ExtCol = Col; + if (NOT Matrix->RowsLinked) spcLinkRows( Matrix ); + + Row = Matrix->ExtToIntRowMap[Row]; + Col = Matrix->ExtToIntColMap[Col]; + ASSERT( Row > 0 AND Col > 0 ); + +/* Move Row so that it is the last row in the matrix. */ + if (Row != Size) spcRowExchange( Matrix, Row, Size ); + +/* Move Col so that it is the last column in the matrix. */ + if (Col != Size) spcColExchange( Matrix, Col, Size ); + +/* Correct Diag pointers. */ + if (Row == Col) + SWAP( ElementPtr, Matrix->Diag[Row], Matrix->Diag[Size] ) + else + { Matrix->Diag[Row] = spcFindDiag( Matrix, Row ); + Matrix->Diag[Col] = spcFindDiag( Matrix, Col ); + } + +/* + * Delete last row and column of the matrix. + */ +/* Break the column links to every element in the last row. */ + pLastElement = Matrix->FirstInRow[ Size ]; + while (pLastElement != NULL) + { ppElement = &(Matrix->FirstInCol[ pLastElement->Col ]); + while ((pElement = *ppElement) != NULL) + { if (pElement == pLastElement) + *ppElement = NULL; /* Unlink last element in column. */ + else + ppElement = &pElement->NextInCol; /* Skip element. */ + } + pLastElement = pLastElement->NextInRow; + } + +/* Break the row links to every element in the last column. */ + pLastElement = Matrix->FirstInCol[ Size ]; + while (pLastElement != NULL) + { ppElement = &(Matrix->FirstInRow[ pLastElement->Row ]); + while ((pElement = *ppElement) != NULL) + { if (pElement == pLastElement) + *ppElement = NULL; /* Unlink last element in row. */ + else + ppElement = &pElement->NextInRow; /* Skip element. */ + } + pLastElement = pLastElement->NextInCol; + } + +/* Clean up some details. */ + Matrix->Size = Size - 1; + Matrix->Diag[Size] = NULL; + Matrix->FirstInRow[Size] = NULL; + Matrix->FirstInCol[Size] = NULL; + Matrix->CurrentSize--; + Matrix->ExtToIntRowMap[ExtRow] = -1; + Matrix->ExtToIntColMap[ExtCol] = -1; + Matrix->NeedsOrdering = YES; + + return; +} +#endif + + + + + + + + +#if PSEUDOCONDITION +/*! + * Computes the magnitude of the ratio of the largest to the smallest + * pivots. This quantity is an indicator of ill-conditioning in the + * matrix. If this ratio is large, and if the matrix is scaled such + * that uncertainties in the RHS and the matrix entries are + * equilibrated, then the matrix is ill-conditioned. However, a small + * ratio does not necessarily imply that the matrix is + * well-conditioned. This routine must only be used after a matrix has + * been factored by spOrderAndFactor() or spFactor() and before it is + * cleared by spClear() or spInitialize(). The pseudocondition is + * faster to compute than the condition number calculated by + * spCondition(), but is not as informative. + * + * \return + * The magnitude of the ratio of the largest to smallest pivot used during + * previous factorization. If the matrix was singular, zero is returned. + * + * \param eMatrix + * Pointer to the matrix. + */ + +spREAL +spPseudoCondition( spMatrix eMatrix ) +{ + MatrixPtr Matrix = (MatrixPtr)eMatrix; + register int I; + register ArrayOfElementPtrs Diag; + RealNumber MaxPivot, MinPivot, Mag; + + /* Begin `spPseudoCondition'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + if (Matrix->Error == spSINGULAR OR Matrix->Error == spZERO_DIAG) + return 0.0; + + Diag = Matrix->Diag; + MaxPivot = MinPivot = ELEMENT_MAG( Diag[1] ); + for (I = 2; I <= Matrix->Size; I++) + { Mag = ELEMENT_MAG( Diag[I] ); + if (Mag > MaxPivot) + MaxPivot = Mag; + else if (Mag < MinPivot) + MinPivot = Mag; + } + ASSERT( MaxPivot > 0.0 ); + return MaxPivot / MinPivot; +} +#endif + + + + + + + + +#if CONDITION +/*! + * Computes an estimate of the condition number using a variation on + * the LINPACK condition number estimation algorithm. This quantity is + * an indicator of ill-conditioning in the matrix. To avoid problems + * with overflow, the reciprocal of the condition number is returned. + * If this number is small, and if the matrix is scaled such that + * uncertainties in the RHS and the matrix entries are equilibrated, + * then the matrix is ill-conditioned. If the this number is near + * one, the matrix is well conditioned. This routine must only be + * used after a matrix has been factored by spOrderAndFactor() or + * spFactor() and before it is cleared by spClear() or spInitialize(). + * + * Unlike the LINPACK condition number estimator, this routines + * returns the L infinity condition number. This is an artifact of + * Sparse placing ones on the diagonal of the upper triangular matrix + * rather than the lower. This difference should be of no importance. + * + * \b References: + * + * A.K. Cline, C.B. Moler, G.W. Stewart, J.H. Wilkinson. An estimate + * for the condition number of a matrix. SIAM Journal on Numerical + * Analysis. Vol. 16, No. 2, pages 368-375, April 1979. + * + * J.J. Dongarra, C.B. Moler, J.R. Bunch, G.W. Stewart. LINPACK + * User's Guide. SIAM, 1979. + * + * Roger G. Grimes, John G. Lewis. Condition number estimation for + * sparse matrices. SIAM Journal on Scientific and Statistical + * Computing. Vol. 2, No. 4, pages 384-388, December 1981. + * + * Dianne Prost O'Leary. Estimating matrix condition numbers. SIAM + * Journal on Scientific and Statistical Computing. Vol. 1, No. 2, + * pages 205-209, June 1980. + * + * \return + * The reciprocal of the condition number. If the matrix was singular, + * zero is returned. + * + * \param eMatrix + * Pointer to the matrix. + * \param NormOfMatrix + * The L-infinity norm of the unfactored matrix as computed by + * spNorm(). + * \param pError + * Used to return error code. Possible errors include \a spSINGULAR + * or \a spNO_MEMORY. + */ + +spREAL +spCondition( + spMatrix eMatrix, + spREAL NormOfMatrix, + int *pError +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register RealVector T, Tm; +register int I, K, Row; +ElementPtr pPivot; +int Size; +RealNumber E, Em, Wp, Wm, ASp, ASm, ASw, ASy, ASv, ASz, MaxY, ScaleFactor; +RealNumber Linpack, OLeary, InvNormOfInverse; +#define SLACK 1e4 + +/* Begin `spCondition'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + *pError = Matrix->Error; + if (Matrix->Error >= spFATAL) return 0.0; + if (NormOfMatrix == 0.0) + { *pError = spSINGULAR; + return 0.0; + } + +#if spCOMPLEX + if (Matrix->Complex) + return ComplexCondition( Matrix, NormOfMatrix, pError ); +#endif + +#if REAL + Size = Matrix->Size; + T = Matrix->Intermediate; +#if spCOMPLEX + Tm = Matrix->Intermediate + Size; +#else + Tm = ALLOC( RealNumber, Size+1 ); + if (Tm == NULL) + { *pError = spNO_MEMORY; + return 0.0; + } +#endif + for (I = Size; I > 0; I--) T[I] = 0.0; + +/* + * Part 1. Ay = e. + * Solve Ay = LUy = e where e consists of +1 and -1 terms with the sign + * chosen to maximize the size of w in Lw = e. Since the terms in w can + * get very large, scaling is used to avoid overflow. + */ + +/* Forward elimination. Solves Lw = e while choosing e. */ + E = 1.0; + for (I = 1; I <= Size; I++) + { pPivot = Matrix->Diag[I]; + if (T[I] < 0.0) Em = -E; else Em = E; + Wm = (Em + T[I]) * pPivot->Real; + if (ABS(Wm) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(Wm) ); + for (K = Size; K > 0; K--) T[K] *= ScaleFactor; + E *= ScaleFactor; + Em *= ScaleFactor; + Wm = (Em + T[I]) * pPivot->Real; + } + Wp = (T[I] - Em) * pPivot->Real; + ASp = ABS(T[I] - Em); + ASm = ABS(Em + T[I]); + +/* Update T for both values of W, minus value is placed in Tm. */ + pElement = pPivot->NextInCol; + while (pElement != NULL) + { Row = pElement->Row; + Tm[Row] = T[Row] - (Wm * pElement->Real); + T[Row] -= (Wp * pElement->Real); + ASp += ABS(T[Row]); + ASm += ABS(Tm[Row]); + pElement = pElement->NextInCol; + } + +/* If minus value causes more growth, overwrite T with its values. */ + if (ASm > ASp) + { T[I] = Wm; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { T[pElement->Row] = Tm[pElement->Row]; + pElement = pElement->NextInCol; + } + } + else T[I] = Wp; + } + +/* Compute 1-norm of T, which now contains w, and scale ||T|| to 1/SLACK.. */ + for (ASw = 0.0, I = Size; I > 0; I--) ASw += ABS(T[I]); + ScaleFactor = 1.0 / (SLACK * ASw); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) T[I] *= ScaleFactor; + E *= ScaleFactor; + } + +/* Backward Substitution. Solves Uy = w.*/ + for (I = Size; I >= 1; I--) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { T[I] -= pElement->Real * T[pElement->Col]; + pElement = pElement->NextInRow; + } + if (ABS(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) ); + for (K = Size; K > 0; K--) T[K] *= ScaleFactor; + E *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains y, and scale ||T|| to 1/SLACK.. */ + for (ASy = 0.0, I = Size; I > 0; I--) ASy += ABS(T[I]); + ScaleFactor = 1.0 / (SLACK * ASy); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) T[I] *= ScaleFactor; + ASy = 1.0 / SLACK; + E *= ScaleFactor; + } + +/* Compute infinity-norm of T for O'Leary's estimate. */ + for (MaxY = 0.0, I = Size; I > 0; I--) + if (MaxY < ABS(T[I])) MaxY = ABS(T[I]); + +/* + * Part 2. A* z = y where the * represents the transpose. + * Recall that A = LU implies A* = U* L*. + */ + +/* Forward elimination, U* v = y. */ + for (I = 1; I <= Size; I++) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { T[pElement->Col] -= T[I] * pElement->Real; + pElement = pElement->NextInRow; + } + if (ABS(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) ); + for (K = Size; K > 0; K--) T[K] *= ScaleFactor; + ASy *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains v, and scale ||T|| to 1/SLACK.. */ + for (ASv = 0.0, I = Size; I > 0; I--) ASv += ABS(T[I]); + ScaleFactor = 1.0 / (SLACK * ASv); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) T[I] *= ScaleFactor; + ASy *= ScaleFactor; + } + +/* Backward Substitution, L* z = v. */ + for (I = Size; I >= 1; I--) + { pPivot = Matrix->Diag[I]; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { T[I] -= pElement->Real * T[pElement->Row]; + pElement = pElement->NextInCol; + } + T[I] *= pPivot->Real; + if (ABS(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) ); + for (K = Size; K > 0; K--) T[K] *= ScaleFactor; + ASy *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains z. */ + for (ASz = 0.0, I = Size; I > 0; I--) ASz += ABS(T[I]); + +#if NOT spCOMPLEX + FREE( Tm ); +#endif + + Linpack = ASy / ASz; + OLeary = E / MaxY; + InvNormOfInverse = MIN( Linpack, OLeary ); + return InvNormOfInverse / NormOfMatrix; +#endif /* REAL */ +} + + + + + +#if spCOMPLEX +/* + * ESTIMATE CONDITION NUMBER + * + * Complex version of spCondition(). + * + * >>> Returns: + * The reciprocal of the condition number. + * + * >>> Arguments: + * Matrix <input> (MatrixPtr) + * Pointer to the matrix. + * NormOfMatrix <input> (RealNumber) + * The L-infinity norm of the unfactored matrix as computed by + * spNorm(). + * pError <output> (int *) + * Used to return error code. + * + * >>> Possible errors: + * spNO_MEMORY + */ + +static RealNumber +ComplexCondition( + MatrixPtr Matrix, + RealNumber NormOfMatrix, + int *pError +) +{ +register ElementPtr pElement; +register ComplexVector T, Tm; +register int I, K, Row; +ElementPtr pPivot; +int Size; +RealNumber E, Em, ASp, ASm, ASw, ASy, ASv, ASz, MaxY, ScaleFactor; +RealNumber Linpack, OLeary, InvNormOfInverse; +ComplexNumber Wp, Wm; + +/* Begin `ComplexCondition'. */ + + Size = Matrix->Size; + T = (ComplexVector)Matrix->Intermediate; + Tm = ALLOC( ComplexNumber, Size+1 ); + if (Tm == NULL) + { *pError = spNO_MEMORY; + return 0.0; + } + for (I = Size; I > 0; I--) T[I].Real = T[I].Imag = 0.0; + +/* + * Part 1. Ay = e. + * Solve Ay = LUy = e where e consists of +1 and -1 terms with the sign + * chosen to maximize the size of w in Lw = e. Since the terms in w can + * get very large, scaling is used to avoid overflow. + */ + +/* Forward elimination. Solves Lw = e while choosing e. */ + E = 1.0; + for (I = 1; I <= Size; I++) + { pPivot = Matrix->Diag[I]; + if (T[I].Real < 0.0) Em = -E; else Em = E; + Wm = T[I]; + Wm.Real += Em; + ASm = CMPLX_1_NORM( Wm ); + CMPLX_MULT_ASSIGN( Wm, *pPivot ); + if (CMPLX_1_NORM(Wm) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(Wm) ); + for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor ); + E *= ScaleFactor; + Em *= ScaleFactor; + ASm *= ScaleFactor; + SCLR_MULT_ASSIGN( Wm, ScaleFactor ); + } + Wp = T[I]; + Wp.Real -= Em; + ASp = CMPLX_1_NORM( Wp ); + CMPLX_MULT_ASSIGN( Wp, *pPivot ); + +/* Update T for both values of W, minus value is placed in Tm. */ + pElement = pPivot->NextInCol; + while (pElement != NULL) + { Row = pElement->Row; + /* Cmplx expr: Tm[Row] = T[Row] - (Wp * *pElement). */ + CMPLX_MULT_SUBT( Tm[Row], Wm, *pElement, T[Row] ); + /* Cmplx expr: T[Row] -= Wp * *pElement. */ + CMPLX_MULT_SUBT_ASSIGN( T[Row], Wm, *pElement ); + ASp += CMPLX_1_NORM(T[Row]); + ASm += CMPLX_1_NORM(Tm[Row]); + pElement = pElement->NextInCol; + } + +/* If minus value causes more growth, overwrite T with its values. */ + if (ASm > ASp) + { T[I] = Wm; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { T[pElement->Row] = Tm[pElement->Row]; + pElement = pElement->NextInCol; + } + } + else T[I] = Wp; + } + +/* Compute 1-norm of T, which now contains w, and scale ||T|| to 1/SLACK.. */ + for (ASw = 0.0, I = Size; I > 0; I--) ASw += CMPLX_1_NORM(T[I]); + ScaleFactor = 1.0 / (SLACK * ASw); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor ); + E *= ScaleFactor; + } + +/* Backward Substitution. Solves Uy = w.*/ + for (I = Size; I >= 1; I--) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { /* Cmplx expr: T[I] -= T[pElement->Col] * *pElement. */ + CMPLX_MULT_SUBT_ASSIGN( T[I], T[pElement->Col], *pElement ); + pElement = pElement->NextInRow; + } + if (CMPLX_1_NORM(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) ); + for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor ); + E *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains y, and scale ||T|| to 1/SLACK.. */ + for (ASy = 0.0, I = Size; I > 0; I--) ASy += CMPLX_1_NORM(T[I]); + ScaleFactor = 1.0 / (SLACK * ASy); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor ); + ASy = 1.0 / SLACK; + E *= ScaleFactor; + } + +/* Compute infinity-norm of T for O'Leary's estimate. */ + for (MaxY = 0.0, I = Size; I > 0; I--) + if (MaxY < CMPLX_1_NORM(T[I])) MaxY = CMPLX_1_NORM(T[I]); + +/* + * Part 2. A* z = y where the * represents the transpose. + * Recall that A = LU implies A* = U* L*. + */ + +/* Forward elimination, U* v = y. */ + for (I = 1; I <= Size; I++) + { pElement = Matrix->Diag[I]->NextInRow; + while (pElement != NULL) + { /* Cmplx expr: T[pElement->Col] -= T[I] * *pElement. */ + CMPLX_MULT_SUBT_ASSIGN( T[pElement->Col], T[I], *pElement ); + pElement = pElement->NextInRow; + } + if (CMPLX_1_NORM(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) ); + for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor ); + ASy *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains v, and scale ||T|| to 1/SLACK.. */ + for (ASv = 0.0, I = Size; I > 0; I--) ASv += CMPLX_1_NORM(T[I]); + ScaleFactor = 1.0 / (SLACK * ASv); + if (ScaleFactor < 0.5) + { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor ); + ASy *= ScaleFactor; + } + +/* Backward Substitution, L* z = v. */ + for (I = Size; I >= 1; I--) + { pPivot = Matrix->Diag[I]; + pElement = pPivot->NextInCol; + while (pElement != NULL) + { /* Cmplx expr: T[I] -= T[pElement->Row] * *pElement. */ + CMPLX_MULT_SUBT_ASSIGN( T[I], T[pElement->Row], *pElement ); + pElement = pElement->NextInCol; + } + CMPLX_MULT_ASSIGN( T[I], *pPivot ); + if (CMPLX_1_NORM(T[I]) > SLACK) + { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) ); + for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor ); + ASy *= ScaleFactor; + } + } + +/* Compute 1-norm of T, which now contains z. */ + for (ASz = 0.0, I = Size; I > 0; I--) ASz += CMPLX_1_NORM(T[I]); + + FREE( Tm ); + + Linpack = ASy / ASz; + OLeary = E / MaxY; + InvNormOfInverse = MIN( Linpack, OLeary ); + return InvNormOfInverse / NormOfMatrix; +} +#endif /* spCOMPLEX */ + + + + + +/*! + * Computes the L-infinity norm of an unfactored matrix. It is a fatal + * error to pass this routine a factored matrix. + * + * \return + * The largest absolute row sum of matrix. + * + * \param eMatrix + * Pointer to the matrix. + */ + +spREAL +spNorm( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register int I; +RealNumber Max = 0.0, AbsRowSum; + +/* Begin `spNorm'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_NOT_FACTORED( Matrix ); + if (NOT Matrix->RowsLinked) spcLinkRows( Matrix ); + +/* Compute row sums. */ +#if REAL + if (NOT Matrix->Complex) + { for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInRow[I]; + AbsRowSum = 0.0; + while (pElement != NULL) + { AbsRowSum += ABS( pElement->Real ); + pElement = pElement->NextInRow; + } + if (Max < AbsRowSum) Max = AbsRowSum; + } + } +#endif +#if spCOMPLEX + if (Matrix->Complex) + { for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInRow[I]; + AbsRowSum = 0.0; + while (pElement != NULL) + { AbsRowSum += CMPLX_1_NORM( *pElement ); + pElement = pElement->NextInRow; + } + if (Max < AbsRowSum) Max = AbsRowSum; + } + } +#endif + return Max; +} +#endif /* CONDITION */ + + + + + + +#if STABILITY +/*! + * This routine, along with spRoundoff(), are used to gauge the stability of a + * factorization. If the factorization is determined to be too unstable, + * then the matrix should be reordered. The routines compute quantities + * that are needed in the computation of a bound on the error attributed + * to any one element in the matrix during the factorization. In other + * words, there is a matrix \f$ E = [e_{ij}] \f$ of error terms such that + * \f$ A+E = LU \f$. This routine finds a bound on \f$ |e_{ij}| \f$. + * Erisman & Reid [1] showed that \f$ |e_{ij}| < 3.01 u \rho m_{ij} \f$, + * where \f$ u \f$ is the machine rounding unit, + * \f$ \rho = \max a_{ij} \f$ where the max is taken over every row \f$ i \f$, + * column \f$ j \f$, and step \f$ k \f$, and \f$ m_{ij} \f$ is the number + * of multiplications required in the computation of \f$ l_{ij} \f$ if + * \f$ i > j \f$ or \f$ u_{ij} \f$ otherwise. Barlow [2] showed that + * \f$ \rho < \max_i || l_i ||_p \max_j || u_j ||_q \f$ where + * \f$ 1/p + 1/q = 1 \f$. + * + * spLargestElement() finds the magnitude on the largest element in the + * matrix. If the matrix has not yet been factored, the largest + * element is found by direct search. If the matrix is factored, a + * bound on the largest element in any of the reduced submatrices is + * computed using Barlow with \f$ p = \infty \f$ and \f$ q = 1 \f$. + * The ratio of these + * two numbers is the growth, which can be used to determine if the + * pivoting order is adequate. A large growth implies that + * considerable error has been made in the factorization and that it + * is probably a good idea to reorder the matrix. If a large growth + * in encountered after using spFactor(), reconstruct the matrix and + * refactor using spOrderAndFactor(). If a large growth is + * encountered after using spOrderAndFactor(), refactor using + * spOrderAndFactor() with the pivot threshold increased, say to 0.1. + * + * Using only the size of the matrix as an upper bound on \f$ m_{ij} \f$ and + * Barlow's bound, the user can estimate the size of the matrix error + * terms \f$ e_{ij} \f$ using the bound of Erisman and Reid. spRoundoff() + * computes a tighter bound (with more work) based on work by Gear + * [3], \f$ |e_{ij}| < 1.01 u \rho (t c^3 + (1 + t)c^2) \f$ where + * \f$ t \f$ is the threshold and \f$ c \f$ is the maximum number of + * off-diagonal elements in any row of \f$ L \f$. The expensive part + * of computing this bound is determining the maximum number of + * off-diagonals in \f$ L \f$, which changes + * only when the order of the matrix changes. This number is computed + * and saved, and only recomputed if the matrix is reordered. + * + * [1] A. M. Erisman, J. K. Reid. Monitoring the stability of the + * triangular factorization of a sparse matrix. Numerische + * Mathematik. Vol. 22, No. 3, 1974, pp 183-186. + * + * [2] J. L. Barlow. A note on monitoring the stability of triangular + * decomposition of sparse matrices. "SIAM Journal of Scientific + * and Statistical Computing." Vol. 7, No. 1, January 1986, pp 166-168. + * + * [3] I. S. Duff, A. M. Erisman, J. K. Reid. "Direct Methods for Sparse + * Matrices." Oxford 1986. pp 99. + * + * \return + * If matrix is not factored, returns the magnitude of the largest element in + * the matrix. If the matrix is factored, a bound on the magnitude of the + * largest element in any of the reduced submatrices is returned. + * + * \param eMatrix + * Pointer to the matrix. + */ + +spREAL +spLargestElement( spMatrix eMatrix ) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register int I; +RealNumber Mag, AbsColSum, Max = 0.0, MaxRow = 0.0, MaxCol = 0.0; +RealNumber Pivot; +ComplexNumber cPivot; +register ElementPtr pElement, pDiag; + +/* Begin `spLargestElement'. */ + ASSERT_IS_SPARSE( Matrix ); + +#if REAL + if (Matrix->Factored AND NOT Matrix->Complex) + { if (Matrix->Error == spSINGULAR) return 0.0; + +/* Find the bound on the size of the largest element over all factorization. */ + for (I = 1; I <= Matrix->Size; I++) + { pDiag = Matrix->Diag[I]; + +/* Lower triangular matrix. */ + Pivot = 1.0 / pDiag->Real; + Mag = ABS( Pivot ); + if (Mag > MaxRow) MaxRow = Mag; + pElement = Matrix->FirstInRow[I]; + while (pElement != pDiag) + { Mag = ABS( pElement->Real ); + if (Mag > MaxRow) MaxRow = Mag; + pElement = pElement->NextInRow; + } + +/* Upper triangular matrix. */ + pElement = Matrix->FirstInCol[I]; + AbsColSum = 1.0; /* Diagonal of U is unity. */ + while (pElement != pDiag) + { AbsColSum += ABS( pElement->Real ); + pElement = pElement->NextInCol; + } + if (AbsColSum > MaxCol) MaxCol = AbsColSum; + } + } + else if (NOT Matrix->Complex) + { for (I = 1; I <= Matrix->Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { Mag = ABS( pElement->Real ); + if (Mag > Max) Max = Mag; + pElement = pElement->NextInCol; + } + } + return Max; + } +#endif +#if spCOMPLEX + if (Matrix->Factored AND Matrix->Complex) + { if (Matrix->Error == spSINGULAR) return 0.0; + +/* Find the bound on the size of the largest element over all factorization. */ + for (I = 1; I <= Matrix->Size; I++) + { pDiag = Matrix->Diag[I]; + +/* Lower triangular matrix. */ + CMPLX_RECIPROCAL( cPivot, *pDiag ); + Mag = CMPLX_INF_NORM( cPivot ); + if (Mag > MaxRow) MaxRow = Mag; + pElement = Matrix->FirstInRow[I]; + while (pElement != pDiag) + { Mag = CMPLX_INF_NORM( *pElement ); + if (Mag > MaxRow) MaxRow = Mag; + pElement = pElement->NextInRow; + } + +/* Upper triangular matrix. */ + pElement = Matrix->FirstInCol[I]; + AbsColSum = 1.0; /* Diagonal of U is unity. */ + while (pElement != pDiag) + { AbsColSum += CMPLX_INF_NORM( *pElement ); + pElement = pElement->NextInCol; + } + if (AbsColSum > MaxCol) MaxCol = AbsColSum; + } + } + else if (Matrix->Complex) + { for (I = 1; I <= Matrix->Size; I++) + { pElement = Matrix->FirstInCol[I]; + while (pElement != NULL) + { Mag = CMPLX_INF_NORM( *pElement ); + if (Mag > Max) Max = Mag; + pElement = pElement->NextInCol; + } + } + return Max; + } +#endif + return MaxRow * MaxCol; +} + + + + +/*! + * This routine, along with spLargestElement(), are used to gauge the + * stability of a factorization. See description of spLargestElement() + * for more information. + * + * \return + * Returns a bound on the magnitude of the largest element in + * \f$ E = A - LU \f$. + * + * \param eMatrix + * Pointer to the matrix. + * \param Rho + * The bound on the magnitude of the largest element in any of the + * reduced submatrices. This is the number computed by the function + * spLargestElement() when given a factored matrix. If this number is + * negative, the bound will be computed automatically. + */ + +spREAL +spRoundoff( + spMatrix eMatrix, + spREAL Rho +) +{ +MatrixPtr Matrix = (MatrixPtr)eMatrix; +register ElementPtr pElement; +register int Count, I, MaxCount = 0; +RealNumber Reid, Gear; + +/* Begin `spRoundoff'. */ + ASSERT_IS_SPARSE( Matrix ); + ASSERT_NO_ERRORS( Matrix ); + ASSERT_IS_FACTORED( Matrix ); + +/* Compute Barlow's bound if it is not given. */ + if (Rho < 0.0) Rho = spLargestElement( eMatrix ); + +/* Find the maximum number of off-diagonals in L if not previously computed. */ + if (Matrix->MaxRowCountInLowerTri < 0) + { for (I = Matrix->Size; I > 0; I--) + { pElement = Matrix->FirstInRow[I]; + Count = 0; + while (pElement->Col < I) + { Count++; + pElement = pElement->NextInRow; + } + if (Count > MaxCount) MaxCount = Count; + } + Matrix->MaxRowCountInLowerTri = MaxCount; + } + else MaxCount = Matrix->MaxRowCountInLowerTri; + +/* Compute error bound. */ + Gear = 1.01*((MaxCount + 1) * Matrix->RelThreshold + 1.0) * SQR(MaxCount); + Reid = 3.01 * Matrix->Size; + + if (Gear < Reid) + return (MACHINE_RESOLUTION * Rho * Gear); + else + return (MACHINE_RESOLUTION * Rho * Reid); +} +#endif + + + + + + + +#if DOCUMENTATION +/*! + * This routine prints a short message describing the error error state + * of sparse. No message is produced if there is no error. + * The error state is cleared. + * + * \param eMatrix + * Matrix for which the error message is to be printed. + * \param Stream + * Stream to which the error message is to be printed. + * \param Originator + * Name of originator of error message. If NULL, `sparse' is used. + * If zero-length string, no originator is printed. + */ + +void +spErrorMessage( + spMatrix eMatrix, + FILE *Stream, + char *Originator +) +{ +int Row, Col, Error; + +/* Begin `spErrorMessage'. */ + if (eMatrix == NULL) + Error = spNO_MEMORY; + else + { ASSERT_IS_SPARSE( (MatrixPtr)eMatrix ); + Error = ((MatrixPtr)eMatrix)->Error; + } + + if (Error == spOKAY) return; + if (Originator == NULL) Originator = "sparse"; + if (Stream == NULL) Stream = stderr; + if (Originator[0] != '\0') fprintf( Stream, "%s: ", Originator ); + if (Error >= spFATAL) + fprintf( Stream, "fatal error: "); + else + fprintf( Stream, "warning: "); +/* + * Print particular error message. + * Do not use switch statement because error codes may not be unique. + */ + if (Error == spPANIC) + fprintf( Stream, "Sparse called improperly.\n"); + else if (Error == spNO_MEMORY) + fprintf( Stream, "insufficient memory available.\n"); + else if (Error == spMANGLED) + fprintf( Stream, "matrix is mangled.\n"); + else if (Error == spSINGULAR) + { spWhereSingular( eMatrix, &Row, &Col ); + fprintf( Stream, "singular matrix detected at row %d and column %d.\n", + Row, Col); + } + else if (Error == spZERO_DIAG) + { spWhereSingular( eMatrix, &Row, &Col ); + fprintf( Stream, "zero diagonal detected at row %d and column %d.\n", + Row, Col); + } + else if (Error == spSMALL_PIVOT) + { fprintf( Stream, + "unable to find a pivot that is larger than absolute threshold.\n"); + } + else ABORT(); + + ((MatrixPtr)eMatrix)->Error = spOKAY; + return; +} +#endif /* DOCUMENTATION */ Added: trunk/math/m.h =================================================================== --- trunk/math/m.h (rev 0) +++ trunk/math/m.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,30 @@ +/* Public domain */ + +#ifndef _AGAR_MATH_M_H_ +#define _AGAR_MATH_M_H_ + +#include <agar/math/m_begin.h> + +#define spREAL M_Real + +#include <agar/math/m_math.h> +#include <agar/math/m_int_vector.h> +#include <agar/math/m_complex.h> +#include <agar/math/m_vector.h> +#include <agar/math/m_matrix.h> +#include <agar/math/m_quaternion.h> +#include <agar/math/m_coordinates.h> +#include <agar/math/m_color.h> +#include <agar/math/m_geometry.h> +#include <agar/math/m_gaussj.h> +#include <agar/math/m_lu.h> + +#ifdef _M_INTERNAL +# undef _ +# undef N_ +# define _(s) (s) +# define N_(s) (s) +#endif + +#include <agar/math/m_close.h> +#endif /* _AGAR_MATH_M_H_ */ Added: trunk/math/m_begin.h =================================================================== --- trunk/math/m_begin.h (rev 0) +++ trunk/math/m_begin.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,47 @@ +/* Public domain */ +/* + * Definitions internal to our headers + */ + +#ifdef SINGLE_PRECISION +# define _M_UNDEFINED_SINGLE_PRECISION +# undef SINGLE_PRECISION +#endif +#ifdef DOUBLE_PRECISION +# define _M_UNDEFINED_DOUBLE_PRECISION +# undef DOUBLE_PRECISION +#endif +#ifdef QUAD_PRECISION +# define _M_UNDEFINED_QUAD_PRECISION +# undef QUAD_PRECISION +#endif +#include <agar/config/single_precision.h> +#include <agar/config/quad_precision.h> +#include <agar/config/double_precision.h> + +#undef _MK_HAVE_UNSIGNED_TYPEDEFS +#include <agar/config/_mk_have_unsigned_typedefs.h> +#ifndef _MK_HAVE_UNSIGNED_TYPEDEFS +# define _MK_HAVE_UNSIGNED_TYPEDEFS +# define Uint unsigned int +# define Uchar unsigned char +# define Ulong unsigned long +#endif +#if !defined(__BEGIN_DECLS) || !defined(__END_DECLS) +# define _M_DEFINED_CDECLS +# if defined(__cplusplus) +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +# else +# define __BEGIN_DECLS +# define __END_DECLS +# endif +#endif + +/* Definitions internal to the math library */ +#ifdef _M_INTERNAL +# undef MAX +# define MAX(h,i) ((h) > (i) ? (h) : (i)) +# undef MIN +# define MIN(l,o) ((l) < (o) ? (l) : (o)) +#endif /* _M_INTERNAL */ Added: trunk/math/m_bitstring.h =================================================================== --- trunk/math/m_bitstring.h (rev 0) +++ trunk/math/m_bitstring.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,125 @@ +/* + * Copyright (c) 1989, 1993 + * The Regents of the University of California. All rights reserved. + * + * This code is derived from software contributed to Berkeley by + * Paul Vixie. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * @(#)bitstring.h 8.1 (Berkeley) 7/19/93 + */ + +#ifndef _AGAR_MATH_M_BITSTRING_H_ +#define _AGAR_MATH_M_BITSTRING_H_ + +/* modified for SV/AT and bitstring bugfix by M.R.Murphy, 11oct91 + * bitstr_size changed gratuitously, but shorter + * bit_alloc spelling error fixed + * the following were efficient, but didn't work, they've been made to + * work, but are no longer as efficient :-) + * bit_nclear, bit_nset, bit_ffc, bit_ffs + */ +typedef unsigned char bitstr_t; + +/* internal macros */ + /* byte of the bitstring bit is in */ +#define _bit_byte(bit) \ + ((bit) >> 3) + + /* mask for the bit within its byte */ +#define _bit_mask(bit) \ + (1 << ((bit)&0x7)) + +/* external macros */ + /* bytes in a bitstring of nbits bits */ +#define bitstr_size(nbits) \ + (((nbits) + 7) >> 3) + + /* allocate a bitstring */ +#define bit_alloc(nbits) \ + (bitstr_t *)calloc((size_t)bitstr_size(nbits), sizeof(bitstr_t)) + + /* allocate a bitstring on the stack */ +#define bit_decl(name, nbits) \ + ((name)[bitstr_size(nbits)]) + + /* is bit N of bitstring name set? */ +#define bit_test(name, bit) \ + ((name)[_bit_byte(bit)] & _bit_mask(bit)) + + /* set bit N of bitstring name */ +#define bit_set(name, bit) \ + ((name)[_bit_byte(bit)] |= _bit_mask(bit)) + + /* clear bit N of bitstring name */ +#define bit_clear(name, bit) \ + ((name)[_bit_byte(bit)] &= ~_bit_mask(bit)) + + /* clear bits start ... stop in bitstring */ +#define bit_nclear(name, start, stop) do { \ + register bitstr_t *_name = name; \ + register int _start = start, _stop = stop; \ + while (_start <= _stop) { \ + bit_clear(_name, _start); \ + _start++; \ + } \ +} while(0) + + /* set bits start ... stop in bitstring */ +#define bit_nset(name, start, stop) do { \ + register bitstr_t *_name = name; \ + register int _start = start, _stop = stop; \ + while (_start <= _stop) { \ + bit_set(_name, _start); \ + _start++; \ + } \ +} while(0) + + /* find first bit clear in name */ +#define bit_ffc(name, nbits, value) do { \ + register bitstr_t *_name = name; \ + register int _bit, _nbits = nbits, _value = -1; \ + for (_bit = 0; _bit < _nbits; ++_bit) \ + if (!bit_test(_name, _bit)) { \ + _value = _bit; \ + break; \ + } \ + *(value) = _value; \ +} while(0) + + /* find first bit set in name */ +#define bit_ffs(name, nbits, value) do { \ + register bitstr_t *_name = name; \ + register int _bit, _nbits = nbits, _value = -1; \ + for (_bit = 0; _bit < _nbits; ++_bit) \ + if (bit_test(_name, _bit)) { \ + _value = _bit; \ + break; \ + } \ + *(value) = _value; \ +} while(0) + +#endif /* !_AGAR_MATH_M_BITSTRING_H_ */ Added: trunk/math/m_circle.c =================================================================== --- trunk/math/m_circle.c (rev 0) +++ trunk/math/m_circle.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,187 @@ +/* + * Copyright (c) 2008 Hypertriton, Inc. <http://hypertriton.com/> + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Routines related to circles. + */ + +#include <core/core.h> +#include "m.h" + +M_Circle2 +M_CircleRead2(AG_DataSource *ds) +{ + M_Circle2 C; + + C.p = M_ReadVector2(ds); + C.r = M_ReadReal(ds); + return (C); +} +M_Circle3 +M_CircleRead3(AG_DataSource *ds) +{ + M_Circle3 C; + + C.p = M_ReadVector3(ds); + C.r = M_ReadReal(ds); + return (C); +} + +void +M_CircleWrite2(AG_DataSource *ds, M_Circle2 *C) +{ + M_WriteVector2(ds, &C->p); + M_WriteReal(ds, C->r); +} +void +M_CircleWrite3(AG_DataSource *ds, M_Circle3 *C) +{ + M_WriteVector3(ds, &C->p); + M_WriteReal(ds, C->r); +} + +/* Create a line from a point, direction vector and length. */ +M_Circle2 +M_CircleFromPt(M_Vector2 p, M_Real r) +{ + M_Circle2 C; + + C.p = p; + C.r = r; + return (C); +} + +/* Compute minimal distance from a circle to a point p. */ +M_Real +M_CirclePointDistance2(M_Circle2 C, M_Vector2 p) +{ + M_Vector2 vR = M_VecSub2(p, C.p); + M_Real theta = Atan2(vR.y, vR.x); + + return M_VecDistance2(p, M_VECTOR2(C.p.x + C.r*Cos(theta), + C.p.y + C.r*Sin(theta))); +} + +/* Compute the intersection of two circles. */ +M_GeomSet2 +M_IntersectCircleCircle2(M_Circle2 C1, M_Circle2 C2) +{ + M_GeomSet2 Sint = M_GEOM_SET_EMPTY; + M_Real d12 = M_VecDistance2(C1.p, C2.p); + M_Real a, h, b; + M_Vector2 p; + M_Geom2 G1, G2; + + if (Fabs(C1.p.x - C2.p.x) <= M_MACHEP && + Fabs(C1.p.x - C2.p.x) <= M_MACHEP && + Fabs(C1.r - C2.r) <= M_MACHEP) { + G1.type = M_CIRCLE; + G1.g_circle = C1; + M_GeomSetAdd2(&Sint, &G1); + return (Sint); + } + + if (d12 > (C1.r + C2.r) || + d12 < Fabs(C1.r - C2.r)) { + return (Sint); + } + + a = (C1.r*C1.r - C2.r*C2.r + d12*d12) / (2.0*d12); + h = Sqrt(C1.r*C1.r - a*a); + p = M_VecLERP2(C1.p, C2.p, a/d12); + b = h/d12; + + G1.type = M_POINT; + G1.g_point.x = p.x - b*(C2.p.y - C1.p.y); + G1.g_point.y = p.y + b*(C2.p.x - C1.p.x); + G2.type = M_POINT; + G2.g_point.x = p.x + b*(C2.p.y - C1.p.y); + G2.g_point.y = p.y - b*(C2.p.x - C1.p.x); + + M_GeomSetAdd2(&Sint, &G1); + if (M_VecDistance2(G1.g_point, G2.g_point) > M_MACHEP) { + M_GeomSetAdd2(&Sint, &G2); + } + return (Sint); +} + +/* Compute the intersection of a circle and a line. */ +M_GeomSet2 +M_IntersectCircleLine2(M_Circle2 C, M_Line2 L) +{ + M_GeomSet2 Sint = M_GEOM_SET_EMPTY; + M_Vector2 p1 = M_LineFirstPt2(L); + M_Vector2 p2 = M_LineSecondPt2(L); + M_Vector2 p3 = C.p; + M_Real a, b, c, det; + M_Geom2 G; + + a = (p2.x - p1.x)*(p2.x - p1.x) + (p2.y - p1.y)*(p2.y - p1.y); + b = 2.0*( (p2.x - p1.x)*(p1.x - p3.x) + (p2.y - p1.y)*(p1.y - p3.y) ); + c = p3.x*p3.x + p3.y*p3.y + p1.x*p1.x + p1.y*p1.y - + 2.0*(p3.x*p1.x + p3.y*p1.y) - C.r*C.r; + det = b*b - 4.0*a*c; + + if (det < 0.0) { + return (Sint); + } else if (det == 0.0) { + /* TODO Tangent! */ + return (Sint); + } else { + M_Real e = Sqrt(det); + M_Real u1 = (-b + e) / (2.0*a); + M_Real u2 = (-b - e) / (2.0*a); + + if ((u1 < 0.0 || u1 > 1.0) && + (u2 < 0.0 || u2 > 1.0)) { + if ((u1 < 0.0 && u2 < 0.0) || + (u1 > 1.0 && u2 > 1.0)) { + return (Sint); + } else { + if (u1 >= 0.0 && u1 <= 1.0) { + G.type = M_POINT; + G.g_point = M_VecLERP2(p1,p2,u1); + M_GeomSetAdd2(&Sint, &G); + } + if (u2 >= 0.0 && u2 <= 1.0) { + G.type = M_POINT; + G.g_point = M_VecLERP2(p1,p2,u2); + M_GeomSetAdd2(&Sint, &G); + } + } + } else { + if (u1 >= 0.0 && u1 <= 1.0) { + G.type = M_POINT; + G.g_point = M_VecLERP2(p1,p2,u1); + M_GeomSetAdd2(&Sint, &G); + } + if (u2 >= 0.0 && u2 <= 1.0) { + G.type = M_POINT; + G.g_point = M_VecLERP2(p1,p2,u2); + M_GeomSetAdd2(&Sint, &G); + } + } + } + return (Sint); +} Added: trunk/math/m_circle.h =================================================================== --- trunk/math/m_circle.h (rev 0) +++ trunk/math/m_circle.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,13 @@ +/* Public domain */ + +__BEGIN_DECLS +M_Circle2 M_CircleRead2(AG_DataSource *); +M_Circle3 M_CircleRead3(AG_DataSource *); +void M_CircleWrite2(AG_DataSource *, M_Circle2 *); +void M_CircleWrite3(AG_DataSource *, M_Circle3 *); + +M_Circle2 M_CircleFromPt(M_Vector2, M_Real); +M_Real M_CirclePointDistance2(M_Circle2, M_Vector2); +M_GeomSet2 M_IntersectCircleCircle2(M_Circle2, M_Circle2); +M_GeomSet2 M_IntersectCircleLine2(M_Circle2, M_Line2); +__END_DECLS Added: trunk/math/m_close.h =================================================================== --- trunk/math/m_close.h (rev 0) +++ trunk/math/m_close.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,30 @@ +/* Public domain */ +/* + * Clean up internal header definitions. + */ +#ifndef _M_INTERNAL +# ifdef _MK_HAVE_UNSIGNED_TYPEDEFS +# undef _MK_HAVE_UNSIGNED_TYPEDEFS +# undef Uint +# undef Uchar +# undef Ulong +# endif +# ifdef _M_DEFINED_CDECLS +# undef _M_DEFINED_CDECLS +# undef __BEGIN_DECLS +# undef __END_DECLS +# endif + +# undef SINGLE_PRECISION +# undef DOUBLE_PRECISION +# undef QUAD_PRECISION +# ifdef _M_UNDEFINED_SINGLE_PRECISION +# define SINGLE_PRECISION +# endif +# ifdef _M_UNDEFINED_DOUBLE_PRECISION +# define DOUBLE_PRECISION +# endif +# ifdef _M_UNDEFINED_QUAD_PRECISION +# define QUAD_PRECISION +# endif +#endif /* !_M_INTERNAL */ Added: trunk/math/m_color.c =================================================================== --- trunk/math/m_color.c (rev 0) +++ trunk/math/m_color.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,113 @@ +/* + * Copyright (c) 2008 Hypertriton, Inc. <http://hypertriton.com/> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Color-related operations and conversions between different color spaces. + */ + +#include <core/core.h> +#include "m.h" + +M_Color +M_ColorHSVA(M_Real h, M_Real s, M_Real v, M_Real a) +{ + M_Color C; + M_Real var[3], hv; + int iv; + + if (M_MACHZERO(s)) { /* Gray */ + C.r = v; + C.g = v; + C.b = v; + C.a = a; + return (C); + } + + hv = h/60.0; + iv = (int)Floor(hv); + var[0] = v*(1.0F - s); + var[1] = v*(1.0F - s*(hv-iv)); + var[2] = v*(1.0F - s*(1.0-hv-iv)); + + switch (iv) { + case 0: C.r = v; C.g = var[2]; C.b = var[0]; break; + case 1: C.r = var[1]; C.g = v; C.b = var[0]; break; + case 2: C.r = var[0]; C.g = v; C.b = var[2]; break; + case 3: C.r = var[0]; C.g = var[1]; C.b = v; break; + case 4: C.r = var[2]; C.g = var[0]; C.b = v; break; + default: C.r = v; C.g = var[0]; C.b = var[1]; break; + } + return (C); +} + +M_Color +M_ReadColor(AG_DataSource *buf) +{ + M_Color C; + + AG_ReadUint8(buf); /* Expn: type */ + C.r = M_ReadReal(buf); + C.g = M_ReadReal(buf); + C.b = M_ReadReal(buf); + C.a = M_ReadReal(buf); + return (C); +} + +void +M_WriteColor(AG_DataSource *buf, const M_Color *C) +{ + AG_WriteUint8(buf, 0); /* Expn: type */ + M_WriteReal(buf, C->r); + M_WriteReal(buf, C->g); + M_WriteReal(buf, C->b); + M_WriteReal(buf, C->a); +} + +void +M_ColorTo4fv(const M_Color *C, float *v) +{ +#ifdef SINGLE_PRECISION + memcpy(v, C, 4*sizeof(float)); +#else + v[0] = (float)C->r; + v[1] = (float)C->g; + v[2] = (float)C->b; + v[3] = (float)C->a; +#endif +} + +void +M_ColorTo4dv(const M_Color *C, double *v) +{ +#ifdef DOUBLE_PRECISION + memcpy(v, C, 4*sizeof(double)); +#else + /* TODO SIMD */ + v[0] = (double)C->r; + v[1] = (double)C->g; + v[2] = (double)C->b; + v[3] = (double)C->a; +#endif +} Added: trunk/math/m_color.h =================================================================== --- trunk/math/m_color.h (rev 0) +++ trunk/math/m_color.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,39 @@ +/* Public domain */ + +__BEGIN_DECLS +static __inline__ M_Color +M_ColorRGB(M_Real r, M_Real g, M_Real b) +{ + M_Color c; + + c.r = r; + c.g = g; + c.b = b; + c.a = 1.0; + return (c); +} + +static __inline__ M_Color +M_ColorRGBA(M_Real r, M_Real g, M_Real b, M_Real a) +{ + M_Color c; + + c.r = r; + c.g = g; + c.b = b; + c.a = a; + return (c); +} + +void M_WriteColor(AG_DataSource *, const M_Color *); +M_Color M_ReadColor(AG_DataSource *); +M_Color M_ColorRGB(M_Real, M_Real, M_Real); +M_Color M_ColorRGBA(M_Real, M_Real, M_Real, M_Real); +M_Color M_ColorHSVA(M_Real, M_Real, M_Real, M_Real); +void M_ColorTo4fv(const M_Color *, float *); +void M_ColorTo4dv(const M_Color *, double *); +#define M_ColorHSV(h,s,v) M_ColorHSVA((h),(s),(v),1.0) +#define M_ColorBlack() M_ColorRGB(0.0, 0.0, 0.0) +#define M_ColorWhite() M_ColorRGB(1.0, 1.0, 1.0) +#define M_ColorGray(x) M_ColorRGB((x),(x),(x)) +__END_DECLS Added: trunk/math/m_complex.c =================================================================== --- trunk/math/m_complex.c (rev 0) +++ trunk/math/m_complex.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,458 @@ +/* Public domain */ +/* + * Complex number arithmetic. + */ + +#include <core/core.h> +#include "m.h" + +static M_Real Ctans(M_Complex); + +/* + * Compute the complex absolute value (sqrt(r^2 + i^2)). If the magnitude + * of either the real or imaginary parts are outside half of the precision + * range, both parts are rescaled prior to squaring. + */ +M_Real +M_ComplexAbs(M_Complex z) +{ + M_Real x, y, b, rPart, iPart; + int ex, ey, e; + + if (z.r == M_INFINITY || z.i == M_INFINITY || + z.r == -M_INFINITY || z.i == -M_INFINITY) { + return (M_INFINITY); + } + if ((rPart = Fabs(z.r)) == 0.0) { return (iPart); } + if ((iPart = Fabs(z.i)) == 0.0) { return (rPart); } + x = Frexp(rPart, &ex); + y = Frexp(iPart, &ey); + e = ex - ey; + if (e > M_PRECISION_2) { return (rPart); } + if (e < -M_PRECISION_2) { return (iPart); } + e = (ex + ey)/2; + x = Ldexp(rPart, -e); + y = Ldexp(iPart, -e); + b = Sqrt(x*x + y*y); + y = Frexp(b, &ey); + ey = e + ey; + if (ey < -M_EXPMIN) { return (0.0); } + if (ey > M_EXPMAX) { return (M_INFINITY); } + b = Ldexp(b, e); + return (b); +} + +/* Divide two complex numbers. */ +M_Complex +M_ComplexDiv(M_Complex a, M_Complex b) +{ + M_Real y, p, q, w; + M_Complex z; + + y = a.r*a.r + a.i*a.i; + p = b.r*a.r + b.i*a.i; + q = b.i*a.r - b.r*a.i; + if (y < 1.0) { + w = M_INFINITY*y; + if (Fabs(p) > w || Fabs(q) > w || y == 0.0) { + z.r = M_INFINITY; + z.i = M_INFINITY; + return (z); + } + } + z.r = p/y; + z.i = q/y; + return (z); +} + +/* Compute the complex square root of z. */ +M_Complex +M_ComplexSqrt(M_Complex z) +{ + M_Complex w; + M_Real x = z.r; + M_Real y = z.i; + M_Real r, t, scale; + + if (y == 0.0) { + if (x == 0.0) { + w.r = 0.0; + w.i = y; + } else { + r = Fabs(x); + r = Sqrt(r); + if (x < 0.0) { + w.r = 0.0; + w.i = r; + } else { + w.r = r; + w.i = y; + } + } + return (w); + } + if (x == 0.0) { + r = Fabs(y); + r = Sqrt(r/2.0); + if (y > 0) { + w.r = r; + w.i = r; + } else { + w.r = r; + w.i = -r; + } + return (w); + } + if (Fabs(x) > 4.0 || Fabs(y) > 4.0) { /* Rescale */ + x /= 4.0; + y /= 4.0; + scale = 2.0; + } else { + x *= 1.8014398509481984e16; /* 2^54 */ + y *= 1.8014398509481984e16; /* 2^54 */ + scale = 7.450580596923828125e-9; /* 2^-27 */ + } + w.r = x; + w.i = y; + r = M_ComplexAbs(w); + if (x > 0) { + t = Sqrt(0.5*r + 0.5*x); + r = scale*Fabs((0.5*y)/t); + t *= scale; + } else { + r = Sqrt(0.5*r - 0.5*x); + t = scale*Fabs((0.5*y)/r); + r *= scale; + } + if (y < 0) { + w.r = t; + w.i = -r; + } else { + w.r = t; + w.i = r; + } + return (w); + +} + +/* Compute the complex natural logarithm of z. */ +M_Complex +M_ComplexLog(M_Complex z) +{ + M_Complex w; + M_Real p, rr; + + rr = M_ComplexAbs(z); + p = Log(rr); + rr = Atan2(z.i, z.r); + w.r = p; + w.i = rr; + return (w); +} + +/* Compute the exponential of z. */ +M_Complex +M_ComplexExp(M_Complex z) +{ + M_Complex w; + M_Real r; + + r = Exp(z.r); + w.r = r*Cos(z.i); + w.i = r*Sin(z.i); + return (w); +} + +/* Compute a to the complex power z. */ +M_Complex +M_ComplexPow(M_Complex a, M_Complex z) +{ + M_Complex w; + M_Real aAbs, aArg; + M_Real r, theta; + + if ((aAbs = M_ComplexAbs(a)) == 0.0) { + w.r = 0.0; + w.i = 0.0; + return (w); + } + aArg = M_ComplexArg(a); + r = Pow(aAbs, z.r); + theta = z.r*aArg; + if (z.i != 0.0) { + r = r*Exp(-z.i*aArg); + theta += z.i*Log(aAbs); + } + w.r = r*Cos(theta); + w.i = r*Sin(theta); + return (w); +} + +/* Compute the complex sine of z. */ +M_Complex +M_ComplexSin(M_Complex z) +{ + M_Complex w; + M_Real ch, sh; + + if (Fabs(z.i) <= 0.5) { + ch = Cosh(z.i); + sh = Sinh(z.i); + } else { + M_Real e, ei; + e = Exp(z.i); + ei = 0.5/e; + e = 0.5*e; + ch = e+ei; + sh = e-ei; + } + w.r = Sin(z.r)*ch; + w.i = Cos(z.r)*sh; + return (w); +} + +/* Compute the complex cosine of z. */ +M_Complex +M_ComplexCos(M_Complex z) +{ + M_Complex w; + M_Real ch, sh; + + if (Fabs(z.i) <= 0.5) { + ch = Cosh(z.i); + sh = Sinh(z.i); + } else { + M_Real e, ei; + e = Exp(z.i); + ei = 0.5/e; + e = 0.5*e; + ch = e+ei; + sh = e-ei; + } + w.r = Cos(z.r)*ch; + w.i = -Sin(z.r)*sh; + return (w); +} + +/* Compute the complex tangent of z. */ +M_Complex +M_ComplexTan(M_Complex z) +{ + M_Complex w; + M_Real d; + + d = Cos(2.0*z.r) + Cosh(2.0*z.i); + if (Fabs(d) < 0.25) { + d = Ctans(z); + } + if (d == 0.0) { + w.r = M_INFINITY; + w.i = M_INFINITY; + return (w); + } + w.r = Sin(2.0*z.r) / d; + w.i = Sinh(2.0*z.i) / d; + return (w); +} + +/* Compute the complex cotangent of z. */ +M_Complex +M_ComplexCot(M_Complex z) +{ + M_Complex w; + M_Real d; + + d = Cosh(2.0*z.i) - Cos(2.0*z.r); + if (Fabs(d) < 0.25) { + d = Ctans(z); + } + if (d == 0.0) { + w.r = M_INFINITY; + w.i = M_INFINITY; + return (w); + } + w.r = Sin(2.0*z.r) / d; + w.i = -Sinh(2.0*z.i) / d; + return (w); +} + +/* Subtract nearest integer multiple of pi. */ +static M_Real +SubNearestIntMultOfPi(M_Real x) +{ + const M_Real dp1 = 3.14159265160560607910E0; + const M_Real dp2 = 1.98418714791870343106E-9; + const M_Real dp3 = 1.14423774522196636802E-17; + M_Real t; + long i; + + t = x/M_PI; + if (t >= 0.0) { + t += 0.5; + } else { + t -= 0.5; + } + i = t; + t = i; + t = ((x - t*dp1) - t*dp2) - t*dp3; + return (t); +} + +/* Taylor series expansion for cosh(2y) - cos(2x) */ +static M_Real +Ctans(M_Complex z) +{ + M_Real x2 = 1.0, y2 = 1.0, f = 1.0, rn = 0.0, d = 0.0; + M_Real x, y, t; + + x = Fabs(2.0*z.r); + y = Fabs(2.0*z.i); + x = SubNearestIntMultOfPi(x); + x = x*x; + y = y*y; + do { + rn += 1.0; f *= rn; + rn += 1.0; f *= rn; + x2 *= x; y2 *= y; + t = y2+x2; t /= f; d += t; + rn += 1.0; f *= rn; + rn += 1.0; f *= rn; + x2 *= x; y2 *= y; + t = y2-x2; t /= f; d += t; + } while (Fabs(t/d) > M_MACHEP); + return (d); +} + +/* Compute the complex arc sine of z. */ +M_Complex +M_ComplexAsin(M_Complex z) +{ + M_Complex ca, ct, zz, z2; + M_Real x = z.r, y = z.i; + + if (y == 0.0) { + M_Complex w; + w.r = (Fabs(x) > 1.0) ? M_PI_2 : Asin(x); + w.i = 0.0; + return (w); + } + ca.r = x; + ca.i = y; + ct = M_ComplexMult(ca, M_ComplexI()); + zz.r = (x-y)*(x+y); + zz.i = (2.0*x*y); + zz.r = 1.0-zz.r; + zz.i = -zz.i; + z2 = M_ComplexSqrt(zz); + zz = M_ComplexAdd(ct, z2); + zz = M_ComplexLog(zz); + return M_ComplexMult(zz, M_ComplexMinusI()); +} + +/* Compute the complex arc cosine of z. */ +M_Complex +M_ComplexAcos(M_Complex z) +{ + M_Complex w; + + w = M_ComplexAsin(z); + w.r = M_PI_2 - w.r; + w.i = -w.i; + return (w); +} + +/* Compute the complex arc tangent of z. */ +M_Complex +M_ComplexAtan(M_Complex z) +{ + M_Complex w; + M_Real a, t, x, x2, y; + + x = z.r; + y = z.i; + + if ((x == 0.0) && (y > 1.0)) { + goto oflow; + } + x2 = x*x; + a = 1.0 - x2 - y*y; + if (a == 0.0) { goto oflow; } + t = Atan2(2.0*x,a)/2.0; + + w.r = SubNearestIntMultOfPi(t); + w.i = 0.0; + + t = y-1.0; + a = (x2 + t*t); + if (a == 0.0) { goto oflow; } + t = y+1.0; + a = (x2 + t*t)/a; + w.i += Log(a)/4.0; + return (w); +oflow: + w.r = M_INFINITY; + w.i = M_INFINITY; + return (w); +} + +/* Compute the complex hyperbolic sine of z. */ +M_Complex +M_ComplexSinh(M_Complex z) +{ + M_Complex w; + + w.r = Sinh(z.r) * Cos(z.i); + w.i = Cosh(z.r) * Sin(z.i); + return (w); +} + +/* Compute the complex hyperbolic arc sine of z. */ +M_Complex +M_ComplexAsinh(M_Complex z) +{ + M_Complex zi; + + zi = M_ComplexMult(z, M_ComplexI()); + return M_ComplexMult(M_ComplexAsin(zi), M_ComplexMinusI()); +} + +/* Compute the complex hyperbolic cosine of z. */ +M_Complex +M_ComplexCosh(M_Complex z) +{ + M_Complex w; + + w.r = Cosh(z.r)*Cos(z.i); + w.i = Sinh(z.r)*Sin(z.i); + return (w); +} + +/* Compute the complex hyperbolic arc cosine of z. */ +M_Complex +M_ComplexAcosh(M_Complex z) +{ + return M_ComplexMult(M_ComplexI(), M_ComplexAcos(z)); +} + +/* Compute the complex hyperbolic tangent of z. */ +M_Complex +M_ComplexTanh(M_Complex z) +{ + M_Complex w; + M_Real d; + + d = Cosh(2.0*z.r) + Cos(2.0*z.i); + w.r = Sinh(2.0*z.r)/d; + w.i = Sin (2.0*z.i)/d; + return (w); +} + +/* Compute the complex hyperbolic arc tangent of z. */ +M_Complex +M_ComplexAtanh(M_Complex z) +{ + M_Complex zi; + + zi = M_ComplexMult(z, M_ComplexI()); + return M_ComplexMult(zi, M_ComplexMinusI()); +} Added: trunk/math/m_complex.h =================================================================== --- trunk/math/m_complex.h (rev 0) +++ trunk/math/m_complex.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,135 @@ +/* Public domain */ +/* + * Complex number arithmetic. + */ + +__BEGIN_DECLS +static __inline__ M_Complex +M_ComplexGet(M_Real r, M_Real i) +{ + M_Complex z; + + z.r = r; + z.i = i; + return (z); +} + +static __inline__ M_Complex +M_ComplexAddIdentity(void) +{ + M_Complex z; + + z.r = 0.0; + z.i = 0.0; + return (z); +} + +static __inline__ M_Complex +M_ComplexMultIdentity(void) +{ + M_Complex z; + + z.r = 1.0; + z.i = 0.0; + return (z); +} + +static __inline__ M_Complex +M_ComplexAddInverse(M_Complex z) +{ + M_Complex w; + + w.r = -z.r; + w.i = -z.i; + return (z); +} + +static __inline__ M_Complex +M_ComplexMultInverse(M_Complex z) +{ + M_Complex w; + M_Real divisor; + + divisor = z.r*z.r + z.i*z.i; + w.r = z.r/divisor; + w.i = -z.i/divisor; + return (w); +} + +static __inline__ M_Real +M_ComplexModulus(M_Complex z) +{ + return M_Sqrt(z.r*z.r + z.i*z.i); +} + +static __inline__ M_Real +M_ComplexArg(M_Complex z) +{ + return M_Atan2(z.i, z.r); +} + +static __inline__ void +M_ComplexPolar(M_Complex z, M_Real *r, M_Real *theta) +{ + *r = M_ComplexModulus(z); + *theta = M_ComplexArg(z); +} + +static __inline__ M_Complex +M_ComplexAdd(M_Complex a, M_Complex b) +{ + M_Complex w; + + w.r = a.r + b.r; + w.i = a.i + b.i; + return (w); +} + +static __inline__ M_Complex +M_ComplexSub(M_Complex a, M_Complex b) +{ + M_Complex w; + + w.r = a.r - b.r; + w.i = a.i - b.i; + return (w); +} + +static __inline__ M_Complex +M_ComplexMult(M_Complex a, M_Complex b) +{ + M_Complex rv; + + rv.r = a.r*b.r - a.i*b.i; + rv.i = a.i*b.r + a.r*b.i; + return (rv); +} +__END_DECLS + +__BEGIN_DECLS +#define M_ComplexI() M_ComplexGet(0.0, 1.0) +#define M_ComplexMinusI() M_ComplexGet(0.0, -1.0) +#define M_ComplexReal(z) ((z).r) +#define M_ComplexImag(z) ((z).i) +M_Real M_ComplexAbs(M_Complex); +M_Complex M_ComplexDiv(M_Complex, M_Complex); +M_Complex M_ComplexSqrt(M_Complex); +M_Complex M_ComplexLog(M_Complex); +M_Complex M_ComplexExp(M_Complex); +M_Complex M_ComplexPow(M_Complex, M_Complex); + +M_Complex M_ComplexSin(M_Complex); +M_Complex M_ComplexCos(M_Complex); +M_Complex M_ComplexTan(M_Complex); +M_Complex M_ComplexCot(M_Complex); +M_Complex M_ComplexAsin(M_Complex); +M_Complex M_ComplexAcos(M_Complex); +M_Complex M_ComplexAtan(M_Complex); +M_Complex M_ComplexSinh(M_Complex); +M_Complex M_ComplexAsinh(M_Complex); +M_Complex M_ComplexCosh(M_Complex); +M_Complex M_ComplexAcosh(M_Complex); +M_Complex M_ComplexTanh(M_Complex); +M_Complex M_ComplexAtanh(M_Complex); +M_Complex M_ComplexPow(M_Complex, M_Complex); +__END_DECLS Added: trunk/math/m_convexhull.c =================================================================== --- trunk/math/m_convexhull.c (rev 0) +++ trunk/math/m_convexhull.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,37 @@ +/* + * Copyright (c) 2008 Hypertriton, Inc. <http://hypertriton.com/> + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Compute the convex hull of a set of points. + */ + +#include <core/core.h> +#include "m.h" + +M_PointSet2 +M_ConvexHull2(M_PointSet2 *P) +{ + M_PointSet2 *CH; + +} Added: trunk/math/m_coordinates.c =================================================================== --- trunk/math/m_coordinates.c (rev 0) +++ trunk/math/m_coordinates.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,97 @@ +/* + * Copyright (c) 2008 Hypertriton, Inc. <http://hypertriton.com/> + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Conversion between different coordinate systems. + */ + +#include <core/core.h> +#include "m.h" + +M_Rectangular +M_RectangularFromSpherical(M_Spherical s) +{ + M_Rectangular r; + + r.x = s.r*Cos(s.phi)*Cos(s.theta); + r.y = s.r*Cos(s.phi)*Sin(s.theta); + r.z = s.r*Sin(s.phi); + return (r); +} + +M_Rectangular +M_RectangularFromCylindrical(M_Cylindrical c) +{ + M_Rectangular r; + + r.x = c.rho*Cos(c.phi); + r.y = c.rho*Sin(c.phi); + r.z = c.z; + return (r); +} + +M_Spherical +M_SphericalFromRectangular(M_Rectangular r) +{ + M_Spherical s; + M_Real xy2 = r.x*r.x + r.y*r.y; + + s.theta = Atan2(r.y, r.x); + s.phi = Atan2(Sqrt(xy2), r.z); + s.r = Sqrt(xy2 + r.z*r.z); + return (s); +} + +M_Spherical +M_SphericalFromCylindrical(M_Cylindrical c) +{ + M_Spherical s; + + s.theta = Atan2(c.rho, c.z); + s.phi = c.phi; + s.r = Sqrt(c.rho*c.rho + c.z*c.z); + return (s); +} + +M_Cylindrical +M_CylindricalFromRectangular(M_Rectangular r) +{ + M_Cylindrical c; + + c.rho = Sqrt(r.x*r.x + r.y*r.y); + c.phi = Atan2(r.y, r.x); + c.z = r.z; + return (c); +} + +M_Cylindrical +M_CylindricalFromSpherical(M_Spherical s) +{ + M_Cylindrical c; + + c.rho = s.r*Sin(s.theta); + c.phi = s.phi; + c.z = s.r*Cos(s.theta); + return (c); +} Added: trunk/math/m_coordinates.h =================================================================== --- trunk/math/m_coordinates.h (rev 0) +++ trunk/math/m_coordinates.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,10 @@ +/* Public domain */ + +__BEGIN_DECLS +M_Rectangular M_RectangularFromSpherical(M_Spherical); +M_Rectangular M_RectangularFromCylindrical(M_Cylindrical); +M_Spherical M_SphericalFromRectangular(M_Rectangular); +M_Spherical M_SphericalFromCylindrical(M_Cylindrical); +M_Cylindrical M_CylindricalFromRectangular(M_Rectangular); +M_Cylindrical M_CylindricalFromSpherical(M_Spherical); +__END_DECLS Added: trunk/math/m_gaussj.c =================================================================== --- trunk/math/m_gaussj.c (rev 0) +++ trunk/math/m_gaussj.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,119 @@ +/* Public domain */ + +#include <core/core.h> +#include "m.h" + +#undef SWAP +#define SWAP(a,b) { tmp=(a); (a)=(b); (b)=tmp; } + +/* + * Apply Gauss-Jordan elimination to a matrix A and a right-hand side b. + * The original contents of A are destroyed, as it is replaced by the matrix + * inverse. The solution vectors are returned in b. + */ +int +M_InvertGaussJordanv_FPU(void *pA, void *pb) +{ + M_MatrixFPU *A=pA, *b=pb; + M_IntVector *iCol, *iRow, *iPivot; + int col = 0, row = 0; + int i, j, k, l, m; + M_Real big, dum, pivinv, tmp; + + M_ASSERT_SQUARE_MATRIX(A, -1); + iRow = M_IntVectorNew(MCOLS(A)); + iCol = M_IntVectorNew(MCOLS(A)); + iPivot = M_IntVectorNew(MCOLS(A)); + M_IntVectorSet(iPivot, 0); + + for (i = 0; i < MCOLS(A); i++) { + big = 0.0; + + /* Search for the pivot element of this column. */ + for (j = 0; j < MCOLS(A); j++) { + if (iPivot->v[j] != 1) { + for (k = 0; k < MCOLS(A); k++) { + if (iPivot->v[k] == 0) { + if (Fabs(A->v[j][k]) >= big) { + big = Fabs(A->v[j][k]); + row = j; + col = k; + } + } else if (iPivot->v[k] > 1) { + AG_SetError("Singular matrix"); + goto fail; + } + } + } + } + iPivot->v[col]++; + + /* Move the pivot to the diagonal and record the interchange. */ + if (row != col) { + for (l = 0; l < MCOLS(A); l++) + SWAP(A->v[row][l], A->v[col][l]); + for (l = 0; l < MCOLS(b); l++) + SWAP(b->v[row][l], b->v[col][l]); + } + iRow->v[i] = row; + iCol->v[i] = col; + + if (Fabs(A->v[col][col]) < M_MACHEP) { + AG_SetError("Matrix singular to machine precision"); + goto fail; + } + pivinv = 1.0/A->v[col][col]; + A->v[col][col] = 1.0; + + for (l = 0; l < MCOLS(A); l++) { A->v[col][l] *= pivinv; } + for (l = 0; l < MCOLS(b); l++) { b->v[col][l] *= pivinv; } + + /* Reduce the rows except for the pivot one. */ + for (m = 0; m < MCOLS(A); m++) { + if (m == col) { + continue; + } + dum = A->v[m][col]; + A->v[m][col] = 0.0; + + for (l = 0; l < MCOLS(A); l++) + A->v[m][l] -= A->v[col][l]*dum; + for (l = 0; l < MCOLS(b); l++) + b->v[m][l] -= b->v[col][l]*dum; + } + } + + for (l = MCOLS(A)-1; l >= 0; l--) { + if (iRow->v[l] != iCol->v[l]) { + for (k = 0; k < MCOLS(A); k++) + SWAP(A->v[k][iRow->v[l]], + A->v[k][iCol->v[l]]); + } + } + + M_IntVectorFree(iRow); + M_IntVectorFree(iCol); + M_IntVectorFree(iPivot); + return (0); +fail: + M_IntVectorFree(iRow); + M_IntVectorFree(iCol); + M_IntVectorFree(iPivot); + return (-1); +} + +void * +M_InvertGaussJordan_FPU(const void *pA, void *pb) +{ + const M_MatrixFPU *A=pA; + M_MatrixFPU *b=pb, *Ainv; + + if ((Ainv = M_Dup(A)) == NULL) { + return (NULL); + } + if (M_InvertGaussJordanv(Ainv, b) == -1) { + M_Free(Ainv); + return (NULL); + } + return (Ainv); +} Added: trunk/math/m_gaussj.h =================================================================== --- trunk/math/m_gaussj.h (rev 0) +++ trunk/math/m_gaussj.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,6 @@ +/* Public domain */ + +__BEGIN_DECLS +int M_InvertGaussJordanv_FPU(void *, void *); +void *M_InvertGaussJordan_FPU(const void *, void *); +__END_DECLS Added: trunk/math/m_geometry.h =================================================================== --- trunk/math/m_geometry.h (rev 0) +++ trunk/math/m_geometry.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,236 @@ +/* Public domain */ + +/* + * Line segment or ray in R2/R3. + */ +typedef struct m_line2 { + M_Vector2 p; /* Origin point */ + M_Vector2 d; /* Direction vector (unit-length) */ + M_Real t; /* Length of line (or Inf for a halfline) */ +} M_Line2; +typedef struct m_line3 { + M_Vector3 p; + M_Vector3 d; + M_Real t; +} M_Line3; + +#define M_LINE2_INITIALIZER(px,py,nx,ny,t) { {px,py}, {nx,ny}, t } +#define M_LINE3_INITIALIZER(px,py,pz,nx,ny,nz,t) { {px,py,pz}, {nx,ny,nz}, t } +#define MLINE2(v) ((M_Line2 *)(v)) +#define MLINE3(v) ((M_Line3 *)(v)) + +/* + * Circle in R2/R3. + */ +typedef struct m_circle2 { + M_Vector2 p; /* Origin point */ + M_Real r; /* Radius */ +} M_Circle2; +typedef struct m_circle3 { + M_Vector3 p; + M_Real r; +} M_Circle3; + +#define M_CIRCLE2_INITIALIZER(px,py,r) { { px,py }, r } +#define M_CIRCLE3_INITIALIZER(px,py,pz,r) { { px,py,pz }, r } + +/* + * Sphere in R3 + */ +typedef struct m_sphere3 { + M_Vector3 p; /* Origin point */ + M_Real r; /* Radius */ +} M_Sphere3; + +#define M_SPHERE_INITIALIZER(px,py,pz,r) { { px,py,pz }, r } + +/* + * Plane in R3 or hyperplane in Rn + */ +typedef struct m_plane3 { + M_Real a, b, c, d; /* Coefficients of plane equation */ +} M_Plane3; +typedef struct m_plane { + M_Real *c; /* Coefficients of plane equation */ + Uint n; +} M_Plane; + +#define M_PLANE3_INITIALIZER(a,b,c,d) { a,b,c,d } +#define M_PLANE_INITIALIZER { NULL, 0 } +#define MPLANE3(v) ((M_Plane3 *)(v)) +#define MPLANE(v) ((M_Plane *)(v)) + +/* + * Triangle in R2/R3 + */ +typedef struct m_triangle2 { + M_Line2 a, b, c; +} M_Triangle2; +typedef struct m_triangle3 { + M_Line3 a, b, c; +} M_Triangle3; + +#define M_TRIANGLE2_INITIALIZER(ax,ay,bx,by,cx,cy) \ + { M_LineFromPts2(ax,ay), M_LineFromPts2(bx,by), \ + M_LineFromPts2(cx,cy) } +#define M_TRIANGLE3_INITIALIZER(ax,ay,az,bx,by,bz,cx,cy,cz) \ + { M_LineFromPts3(ax,ay,az), M_LineFromPts3(bx,by,bz), \ + M_LineFromPts3(cx,cy,cz) } + +/* + * Rectangle in R2/R3 + */ +typedef struct m_rectangle2 { + M_Line2 a, b, c, d; +} M_Rectangle2; +typedef struct m_rectangle3 { + M_Line3 a, b, c, d; +} M_Rectangle3; + +#define M_RECTANGLE2_INITIALIZER(ax,ay,bx,by,cx,cy,dx,dy) \ + { M_LineFromPts2(ax,ay), M_LineFromPts2(bx,by), \ + M_LineFromPts2(cx,cy), M_LineFromPts2(dx,dy) } +#define M_RECTANGLE_INITIALIZER(ax,ay,az,bx,by,bz,cx,cy,cz,dx,dy,dz) \ + { M_LineFromPts3(ax,ay,az), M_LineFromPts3(bx,by,bz), \ + M_LineFromPts3(cx,cy,cz), M_LineFromPts3(dx,dy,dz) } + +/* + * Simple polygon in R2/R3 (no self-intersections, no holes) + */ +typedef struct m_polygon2 { + M_Line2 *s; /* Sides (must be closed) */ + Uint n; /* Number of sides */ +} M_Polygon2; +typedef struct m_polygon3 { + M_Line3 *s; + Uint n; +} M_Polygon3; + +#define M_POLYGON2_INITIALIZER { NULL, 0 } +#define M_POLYGON3_INITIALIZER { NULL, 0 } + +/* + * Generic geometrical structure in R2 and R3 + */ +typedef enum m_geom_type { + M_NONE, + M_POINT, + M_LINE, + M_CIRCLE, + M_SPHERE, + M_PLANE, + M_POLYGON, + M_TRIANGLE, + M_RECTANGLE +} M_GeomType; + +typedef struct m_geom2 { + M_GeomType type; + union { + M_Vector2 point; + M_Line2 line; + M_Circle2 circle; + M_Polygon2 polygon; + M_Triangle2 triangle; + M_Rectangle2 rectangle; + } g; +} M_Geom2; + +typedef struct m_geom3 { + M_GeomType type; + union { + M_Vector3 point; + M_Line3 line; + M_Circle3 circle; + M_Sphere3 sphere; + M_Plane3 plane; + M_Polygon3 polygon; + M_Triangle3 triangle; + M_Rectangle3 rectangle; + } g; +} M_Geom3; + +#ifdef _M_INTERNAL +#define g_point g.point +#define g_line g.line +#define g_circle g.circle +#define g_sphere g.sphere +#define g_plane g.plane +#define g_polygon g.polygon +#define g_triangle g.triangle +#define g_rectangle g.rectangle +#endif + +/* Sets of any geometric structures in R2 and R3. */ +typedef struct m_geom_set2 { + M_Geom2 *g; + Uint n; +} M_GeomSet2; +typedef struct m_geom_set3 { + M_Geom3 *g; + Uint n; +} M_GeomSet3; +#define M_GEOM_SET_EMPTY { NULL, 0 } + +/* Sets of points in R2 and R3. */ +typedef struct m_point_set2 { + M_Vector2 *p; + Uint n; +} M_PointSet2; +typedef struct m_point_set3 { + M_Vector3 *p; + Uint n; +} M_PointSet3; +#define M_POINT_SET_EMPTY { NULL, 0 } + +#include <agar/math/m_line.h> +#include <agar/math/m_circle.h> +#include <agar/math/m_plane.h> +#include <agar/math/m_triangle.h> +#include <agar/math/m_rectangle.h> +#include <agar/math/m_polygon.h> +#include <agar/math/m_point_set.h> + +__BEGIN_DECLS + +/* + * Basic routines for manipulating general sets. + */ +static __inline__ void +M_GeomSetAdd2(M_GeomSet2 *S, const M_Geom2 *g) +{ + S->g = AG_Realloc(S->g, (S->n+1)*sizeof(M_Geom2)); + S->g[S->n++] = *g; +} +static __inline__ void +M_GeomSetAdd3(M_GeomSet3 *S, const M_Geom3 *g) +{ + S->g = AG_Realloc(S->g, (S->n+1)*sizeof(M_Geom3)); + S->g[S->n++] = *g; +} + +static __inline__ void +M_GeomSetFree2(M_GeomSet2 *S) +{ + Uint i; + for (i = 0; i < S->n; i++) { + if (S->g[i].type == M_POLYGON) + M_PolygonFree2(&S->g[i].g.polygon); + } + AG_Free(S->g); + S->g = NULL; + S->n = 0; +} +static __inline__ void +M_GeomSetFree3(M_GeomSet3 *S) +{ + Uint i; + for (i = 0; i < S->n; i++) { + if (S->g[i].type == M_POLYGON) + M_PolygonFree3(&S->g[i].g.polygon); + } + AG_Free(S->g); + S->g = NULL; + S->n = 0; +} +__END_DECLS Added: trunk/math/m_gui.c =================================================================== --- trunk/math/m_gui.c (rev 0) +++ trunk/math/m_gui.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,237 @@ +/* + * Copyright (c) 2006-2008 Hypertriton, Inc. <http://hypertriton.com/> + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Utility GUI routines for types defined by the math library. + */ + +#include <core/core.h> +#include <gui/widget.h> +#include <gui/box.h> +#include <gui/fspinbutton.h> +#include <gui/spinbutton.h> + +#include "m.h" +#include "m_gui.h" + +AG_FSpinbutton * +M_SpinReal(void *parent, const char *label, M_Real *pv) +{ + AG_FSpinbutton *fsb; + + fsb = AG_FSpinbuttonNew(parent, 0, NULL, label); + AG_WidgetBind(fsb, "value", M_WIDGET_REAL, pv); + AG_FSpinbuttonSetIncrement(fsb, 0.05); + return (fsb); +} + +AG_FSpinbutton * +M_SpinRealInc(void *parent, const char *label, M_Real *pv, M_Real inc) +{ + AG_FSpinbutton *fsb; + + fsb = M_SpinReal(parent, label, pv); + AG_FSpinbuttonSetIncrement(fsb, inc); + return (fsb); +} + +AG_FSpinbutton * +M_SpinFloat(void *parent, const char *label, float *pv) +{ + AG_FSpinbutton *fsb; + + fsb = AG_FSpinbuttonNew(parent, 0, NULL, label); + AG_WidgetBind(fsb, "value", AG_WIDGET_FLOAT, pv); + return (fsb); +} + +AG_FSpinbutton * +M_SpinDouble(void *parent, const char *label, double *pv) +{ + AG_FSpinbutton *fsb; + + fsb = AG_FSpinbuttonNew(parent, 0, NULL, label); + AG_WidgetBind(fsb, "value", AG_WIDGET_DOUBLE, pv); + return (fsb); +} + +AG_Spinbutton * +M_SpinInt(void *parent, const char *label, int *pv) +{ + AG_Spinbutton *sb; + + sb = AG_SpinbuttonNew(parent, 0, label); + AG_WidgetBind(sb, "value", AG_WIDGET_INT, pv); + return (sb); +} + +void * +M_EditVector3(void *parent, const char *label, M_Vector3 *pv) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + + box = AG_BoxNew(parent, AG_BOX_HORIZ, AG_BOX_HOMOGENOUS|AG_BOX_HFILL); + AG_LabelNewStatic(box, 0, label); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->x); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->y); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->z); + + return (box); +} + +void * +M_EditVector4(void *parent, const char *label, M_Vector4 *pv) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + + box = AG_BoxNew(parent, AG_BOX_HORIZ, AG_BOX_HOMOGENOUS|AG_BOX_HFILL); + AG_LabelNewStatic(box, 0, label); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->x); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->y); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &pv->z); + + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.01); + M_WidgetBindReal(fsb, "value", &pv->w); + return (box); +} + +void * +M_EditMatrix44(void *parent, const char *label, M_Matrix44 *T) +{ + AG_Box *hbox, *vbox; + AG_FSpinbutton *fsb; + int i, j; + + vbox = AG_BoxNew(parent, AG_BOX_VERT, AG_BOX_EXPAND); + if (label != NULL) { + AG_LabelNewStatic(vbox, 0, label); + } + for (j = 0; j < 4; j++) { + hbox = AG_BoxNew(vbox, AG_BOX_HORIZ, + AG_BOX_HOMOGENOUS|AG_BOX_HFILL); + for (i = 0; i < 4; i++) { + fsb = AG_FSpinbuttonNew(hbox, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.1); + M_WidgetBindReal(fsb, "value", &T->m[i][j]); + } + } + return (vbox); +} + +void * +M_EditTranslate3(void *parent, const char *label, M_Matrix44 *T) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + int i; + + box = AG_BoxNew(parent, AG_BOX_VERT, AG_BOX_HFILL); + if (label != NULL) { + AG_LabelNewStatic(box, 0, label); + } + for (i = 0; i < 3; i++) { + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &T->m[i][3]); + } + return (box); +} + +void * +M_EditTranslate4(void *parent, const char *label, M_Matrix44 *T) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + int i; + + box = AG_BoxNew(parent, AG_BOX_VERT, AG_BOX_HFILL); + if (label != NULL) { + AG_LabelNewStatic(box, 0, label); + } + for (i = 0; i < 4; i++) { + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.5); + M_WidgetBindReal(fsb, "value", &T->m[i][3]); + } + return (box); +} + +void * +M_EditScale3(void *parent, const char *label, M_Matrix44 *T) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + int i; + + box = AG_BoxNew(parent, AG_BOX_VERT, AG_BOX_HFILL); + if (label != NULL) { + AG_LabelNewStatic(box, 0, label); + } + for (i = 0; i < 3; i++) { + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.05); + M_WidgetBindReal(fsb, "value", &T->m[i][i]); + } + return (box); +} + +void * +M_EditScale4(void *parent, const char *label, M_Matrix44 *T) +{ + AG_Box *box; + AG_FSpinbutton *fsb; + int i; + + box = AG_BoxNew(parent, AG_BOX_VERT, AG_BOX_HFILL); + if (label != NULL) { + AG_LabelNewStatic(box, 0, label); + } + for (i = 0; i < 4; i++) { + fsb = AG_FSpinbuttonNew(box, 0, NULL, NULL); + AG_FSpinbuttonSetIncrement(fsb, 0.05); + M_WidgetBindReal(fsb, "value", &T->m[i][i]); + } + return (box); +} Added: trunk/math/m_gui.h =================================================================== --- trunk/math/m_gui.h (rev 0) +++ trunk/math/m_gui.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,94 @@ +/* Public domain */ + +#ifndef _AGAR_MATH_M_GUI_H_ +#define _AGAR_MATH_M_GUI_H_ +#include <agar/math/m_begin.h> + +#if defined(QUAD_PRECISION) + +# define M_WIDGET_REAL AG_WIDGET_LONG_DOUBLE +# define M_WidgetBindReal(w,n,p) AG_WidgetBind((w),(n),AG_WIDGET_LONG_DOUBLE,\ + (p)) +# define M_WidgetReal(w,n) AG_WidgetLongDouble((w),(n)) +# define M_NumericalNewReal AG_NumericalNewLongDbl +# define M_NumericalNewRealR AG_NumericalNewLongDblR +# define M_NumericalGetReal AG_NumericalGetLongDbl +# define M_NumericalNewRealPNZ(p,f,u,l,v) \ + AG_NumericalNewLongDblR((p),(f),(u),(l),(v),M_TINYVAL,M_INFINITY) +# define M_NumericalNewRealPNZF(p,f,u,l,v) \ + AG_NumericalNewLongDblR((p),(f),(u),(l),(v),M_TINYVAL,M_HUGEVAL) +# define M_NumericalNewRealP(p,f,u,l,v) \ + AG_NumericalNewLongDblR((p),(f),(u),(l),(v),0.0,M_INFINITY) +# define M_NumericalNewRealPF(p,f,u,l,v) \ + AG_NumericalNewLongDblR((p),(f),(u),(l),(v),0.0,M_HUGEVAL) + +#elif defined(DOUBLE_PRECISION) + +# define M_WIDGET_REAL AG_WIDGET_DOUBLE +# define M_WidgetBindReal(w,n,p) AG_WidgetBind((w),(n),AG_WIDGET_DOUBLE,(p)) +# define M_WidgetReal(w,n) AG_WidgetDouble((w),(n)) +# define M_NumericalNewReal AG_NumericalNewDbl +# define M_NumericalNewRealR AG_NumericalNewDblR +# define M_NumericalGetReal AG_NumericalGetDbl +# define M_NumericalNewRealPNZ(p,f,u,l,v) \ + AG_NumericalNewDblR((p),(f),(u),(l),(v),M_TINYVAL,M_INFINITY) +# define M_NumericalNewRealPNZF(p,f,u,l,v) \ + AG_NumericalNewDblR((p),(f),(u),(l),(v),M_TINYVAL,M_HUGEVAL) +# define M_NumericalNewRealP(p,f,u,l,v) \ + AG_NumericalNewDblR((p),(f),(u),(l),(v),0.0,M_INFINITY) +# define M_NumericalNewRealPF(p,f,u,l,v) \ + AG_NumericalNewDblR((p),(f),(u),(l),(v),0.0,M_HUGEVAL) + +#elif defined(SINGLE_PRECISION) + +# define M_WIDGET_REAL AG_WIDGET_FLOAT +# define M_WidgetBindReal(w,n,p) AG_WidgetBind((w),(n),AG_WIDGET_FLOAT,(p)) +# define M_WidgetReal(w,n) AG_WidgetFloat((w),(n)) +# define M_NumericalNewReal AG_NumericalNewFlt +# define M_NumericalNewRealR AG_NumericalNewFltR +# define M_NumericalGetReal AG_NumericalGetFlt +# define M_NumericalNewRealPNZ(p,f,u,l,v) \ + AG_NumericalNewFltR((p),(f),(u),(l),(v),M_TINYVAL,M_INFINITY) +# define M_NumericalNewRealPNZF(p,f,u,l,v) \ + AG_NumericalNewFltR((p),(f),(u),(l),(v),M_TINYVAL,M_HUGEVAL) +# define M_NumericalNewRealP(p,f,u,l,v) \ + AG_NumericalNewFltR((p),(f),(u),(l),(v),0.0,M_INFINITY) +# define M_NumericalNewRealPF(p,f,u,l,v) \ + AG_NumericalNewFltR((p),(f),(u),(l),(v),0.0,M_HUGEVAL) + +#else +# error "Precision is not defined" +#endif + +#define M_WIDGET_TIME AG_WIDGET_SINT32 +#define M_WidgetBindTime(w,n,p) AG_WidgetBind((w),(n),M_WIDGET_TIME,(p)) +#define M_WidgetTime(w,n) AG_WidgetSint32((w),(n)) +#define M_NumericalNewTime AG_NumericalNewSint32 +#define M_NumericalNewTimeR AG_NumericalNewSint32R +#define M_NumericalNewTimeP(p,f,u,l,v) \ + AG_NumericalNewSint32R((p),(f),(u),(l),(v),0,0x7fffffff-1) +#define M_NumericalNewTimePNZ(p,f,u,l,v) \ + AG_NumericalNewSint32R((p),(f),(u),(l),(v),1,0x7fffffff-1) +#define M_NumericalGetTime AG_NumericalGetSint32 + +__BEGIN_DECLS +AG_FSpinbutton *M_SpinReal(void *, const char *, M_Real *); +AG_FSpinbutton *M_SpinRealInc(void *, const char *, M_Real *, M_Real); +AG_FSpinbutton *M_SpinFloat(void *, const char *, float *); +AG_FSpinbutton *M_SpinDouble(void *, const char *, double *); +AG_Spinbutton *M_SpinInt(void *, const char *, int *); + +void *M_EditVector3(void *, const char *, M_Vector3 *); +void *M_EditVector4(void *, const char *, M_Vector4 *); +void *M_EditMatrix44(void *, const char *, M_Matrix44 *); +void *M_EditTranslate3(void *, const char *, M_Matrix44 *); +void *M_EditTranslate4(void *, const char *, M_Matrix44 *); +void *M_EditScale3(void *, const char *, M_Matrix44 *); +void *M_EditScale4(void *, const char *, M_Matrix44 *); +__END_DECLS + +#include <agar/math/m_plotter.h> +#include <agar/math/m_matview.h> +#include <agar/math/m_close.h> + +#endif /* _AGAR_MATH_M_GUI_H_ */ Added: trunk/math/m_heapsort.c =================================================================== --- trunk/math/m_heapsort.c (rev 0) +++ trunk/math/m_heapsort.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,176 @@ +/*- + * Copyright (c) 1991, 1993 + * The Regents of the University of California. All rights reserved. + * + * This code is derived from software contributed to Berkeley by + * Ronnie Kon at Mindcraft Inc., Kevin Lew and Elmer Yglesias. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +/* + * Heapsort -- Knuth, Vol. 3, page 145. Runs in O (N lg N), both average + * and worst. While heapsort is faster than the worst case of quicksort, + * the BSD quicksort does median selection so that the chance of finding + * a data set that will trigger the worst case is nonexistent. Heapsort's + * only advantage over quicksort is that it requires little additional memory. + */ + +#include <core/core.h> + +#include "m.h" + +/* + * Swap two areas of size number of bytes. Although qsort(3) permits random + * blocks of memory to be sorted, sorting pointers is almost certainly the + * common case (and, were it not, could easily be made so). Regardless, it + * isn't worth optimizing; the SWAP's get sped up by the cache, and pointer + * arithmetic gets lost in the time required for comparison function calls. + */ +#define SWAP(a, b, count, size, tmp) { \ + count = size; \ + do { \ + tmp = *a; \ + *a++ = *b; \ + *b++ = tmp; \ + } while (--count); \ +} + +/* Copy one block of size size to another. */ +#define COPY(a, b, count, size, tmp1, tmp2) { \ + count = size; \ + tmp1 = a; \ + tmp2 = b; \ + do { \ + *tmp1++ = *tmp2++; \ + } while (--count); \ +} + +/* + * Build the list into a heap, where a heap is defined such that for + * the records K1 ... KN, Kj/2 >= Kj for 1 <= j/2 <= j <= N. + * + * There are two cases. If j == nmemb, select largest of Ki and Kj. If + * j < nmemb, select largest of Ki, Kj and Kj+1. + */ +#define CREATE(initval, nmemb, par_i, child_i, par, child, size, count, tmp) { \ + for (par_i = initval; (child_i = par_i * 2) <= nmemb; \ + par_i = child_i) { \ + child = base + child_i * size; \ + if (child_i < nmemb && compar(child, child + size) < 0) { \ + child += size; \ + ++child_i; \ + } \ + par = base + par_i * size; \ + if (compar(child, par) <= 0) \ + break; \ + SWAP(par, child, count, size, tmp); \ + } \ +} + +/* + * Select the top of the heap and 'heapify'. Since by far the most expensive + * action is the call to the compar function, a considerable optimization + * in the average case can be achieved due to the fact that k, the displaced + * element, is usually quite small, so it would be preferable to first + * heapify, always maintaining the invariant that the larger child is copied + * over its parent's record. + * + * Then, starting from the *bottom* of the heap, finding k's correct place, + * again maintaining the invariant. As a result of the invariant no element + * is 'lost' when k is assigned its correct place in the heap. + * + * The time savings from this optimization are on the order of 15-20% for the + * average case. See Knuth, Vol. 3, page 158, problem 18. + * + * XXX Don't break the #define SELECT line, below. Reiser cpp gets upset. + */ +#define SELECT(par_i, child_i, nmemb, par, child, size, k, count, tmp1, tmp2) { \ + for (par_i = 1; (child_i = par_i * 2) <= nmemb; par_i = child_i) { \ + child = base + child_i * size; \ + if (child_i < nmemb && compar(child, child + size) < 0) { \ + child += size; \ + ++child_i; \ + } \ + par = base + par_i * size; \ + COPY(par, child, count, size, tmp1, tmp2); \ + } \ + for (;;) { \ + child_i = par_i; \ + par_i = child_i / 2; \ + child = base + child_i * size; \ + par = base + par_i * size; \ + if (child_i == 1 || compar(k, par) < 0) { \ + COPY(child, k, count, size, tmp1, tmp2); \ + break; \ + } \ + COPY(child, par, count, size, tmp1, tmp2); \ + } \ +} + +int +M_HeapSort(void *vbase, size_t nmemb, size_t size, + int (*compar)(const void *, const void *)) +{ + int cnt, i, j, l; + char tmp, *tmp1, *tmp2; + char *base, *k, *p, *t; + + if (nmemb <= 1) + return (0); + + if (!size) { + AG_SetError("Size==0"); + return (-1); + } + + if ((k = malloc(size)) == NULL) { + AG_SetError("Out of memory"); + return (-1); + } + + /* + * Items are numbered from 1 to nmemb, so offset from size bytes + * below the starting address. + */ + base = (char *)vbase - size; + + for (l = nmemb / 2 + 1; --l;) + CREATE(l, nmemb, i, j, t, p, size, cnt, tmp); + + /* + * For each element of the heap, save the largest element into its + * final slot, save the displaced element (k), then recreate the + * heap. + */ + while (nmemb > 1) { + COPY(k, base + nmemb * size, cnt, size, tmp1, tmp2); + COPY(base + nmemb * size, base + size, cnt, size, tmp1, tmp2); + --nmemb; + SELECT(i, j, nmemb, t, p, size, k, cnt, tmp1, tmp2); + } + free(k); + return (0); +} Added: trunk/math/m_int_vector.c =================================================================== --- trunk/math/m_int_vector.c (rev 0) +++ trunk/math/m_int_vector.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,116 @@ +/* + * Copyright (c) 2004-2008 Hypertriton, Inc. <http://hypertriton.com/> + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include <core/core.h> +#include "m.h" + +#define ASSERT_LENGTH(A, B) \ + if ((A)->n != (B)->n) \ + AG_FatalError("Incompatible vectors") + +M_IntVector * +M_IntVectorNew(Uint n) +{ + M_IntVector *veci; + + veci = Malloc(sizeof(M_IntVector)); + veci->v = Malloc(n*sizeof(int)); + veci->n = n; + return (veci); +} + +void +M_IntVectorSet(M_IntVector *v, int val) +{ + Uint i; + + for (i = 0; i < v->n; i++) + v->v[i] = val; +} + +void +M_IntVectorCopy(const M_IntVector *v1, M_IntVector *v2) +{ + Uint i; + + ASSERT_LENGTH(v1, v2); + for (i = 0; i < v1->n; i++) + v2->v[i] = v1->v[i]; +} + +void +M_IntVectorFree(M_IntVector *v) +{ + Free(v->v); + Free(v); +} + +void +M_IntVectorAddv(M_IntVector *v2, const M_IntVector *v1) +{ + Uint i; + + ASSERT_LENGTH(v1, v2); + for (i = 0; i < v1->n; i++) + v2->v[i] = v1->v[i]+v2->v[i]; +} + +void +M_IntVectorSubv(M_IntVector *v2, const M_IntVector *v1) +{ + Uint i; + + ASSERT_LENGTH(v1, v2); + for (i = 0; i < v1->n; i++) + v2->v[i] = v1->v[i]-v2->v[i]; +} + +void +M_IntVectorScalev(M_IntVector *v, M_Real c) +{ + Uint i; + + for (i = 0; i < v->n; i++) + v->v[i] *= c; +} + +void +M_IntVectorResize(M_IntVector *v, Uint n) +{ + v->v = Realloc(v->v, n*sizeof(int)); + v->n = n; +} + +void +M_IntVectorPrint(const M_IntVector *v) +{ + Uint i; + + fputs(" ----\n", stdout); + for (i = 0; i < v->n; i++) { + printf("| %4d: %d\n", i, v->v[i]); + } + fputs(" ----\n", stdout); +} Added: trunk/math/m_int_vector.h =================================================================== --- trunk/math/m_int_vector.h (rev 0) +++ trunk/math/m_int_vector.h 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,18 @@ +/* Public domain */ + +typedef struct m_int_vector { + Uint n; + int *v; +} M_IntVector; + +__BEGIN_DECLS +M_IntVector *M_IntVectorNew(Uint); +void M_IntVectorSet(M_IntVector *, int); +void M_IntVectorCopy(const M_IntVector *, M_IntVector *); +void M_IntVectorFree(M_IntVector *); +void M_IntVectorAddv(M_IntVector *, const M_IntVector *); +void M_IntVectorSubv(M_IntVector *, const M_IntVector *); +void M_IntVectorScalev(M_IntVector *, M_Real); +void M_IntVectorResize(M_IntVector *, Uint); +void M_IntVectorPrint(const M_IntVector *); +__END_DECLS Added: trunk/math/m_line.c =================================================================== --- trunk/math/m_line.c (rev 0) +++ trunk/math/m_line.c 2008-09-01 16:13:21 UTC (rev 7562) @@ -0,0 +1,272 @@ +/* + * Copyright (c) 2007-2008 Hypertriton, Inc. <http://hypertriton.com/> + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR + * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE + * USE OF THIS SOFTWARE EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +/* + * Routines related to lines, line segments and rays. + */ + +#include <core/core.h> +#include "m.h" + +M_Line2 +M_LineRead2(AG_DataSource *ds) +{ + M_Line2 L; + + L.p = M_ReadVector2(ds); + L.d = M_ReadVector2(ds); + L.t = M_ReadReal(ds); + return (L); +} + +M_Line3 +M_LineRead3(AG_DataSource *ds) +{ + M_Line3 L; + + L.p = M_ReadVector3(ds); + L.d = M_ReadVector3(ds); + L.t = M_ReadReal(ds); + return (L); +} + +void +M_LineWrite2(AG_DataSource *ds, M_Line2 *L) +{ + M_WriteVector2(ds, &L->p); + M_WriteVector2(ds, &L->d); + M_WriteReal(ds, L->t); +} + +void +M_LineWrite3(AG_DataSource *ds, M_Line3 *L) +{ + M_WriteVector3(ds, &L->p); + M_WriteVector3(ds, &L->d); + M_WriteReal(ds, L->t); +} + +/* Create a line from a point, direction vector and length. */ +M_Line2 +M_LineFromPtDir2(M_Vector2 p, M_Vector2 d, M_Real len) +{ + M_Line2 L; + + L.p = p; + L.d = d; + L.t = len; + return (L); +} + +/* Create a line from a point, direction vector and length. */ +M_Line3 +M_LineFromPtDir3(M_Vector3 p, M_Vector3 d, M_Real len) +{ + M_Line3 L; + + L.p = p; + L.d = d; + L.t = len; + return (L); +} + +/* Create a line from two points in R2. */ +M_Line2 +M_LineFromPts2(M_Vector2 p1, M_Vector2 p2) +{ + M_Line2 L; + + L.p = p1; + L.d.x = p2.x - p1.x; + L.d.y = p2.y - p1.y; + L.t = M_VecLen2p(&L.d); + L.d.x /= L.t; + L.d.y /= L.t; + return (L); +} + +/* Create a line from two points in R3. */ +M_Line3 +M_LineFromPts3(M_Vector3 p1, M_Vector3 p2) +{ + M_Line3 L; + + L.p = p1; + L.d = M_VecSub3p(&p2, &p1); + L.t = M_VecLen3p(&L.d); + M_VecScale3v(&L.d, 1.0/L.t); + return (L); +} + +/* + * Compute a new line parallel to the given line, with perpendicular + * endpoints. + */ +M_Line2 +M_LineParallel2(M_Line2 L, M_Real dist) +{ + M_Vector2 p1, p2, pd; + + M_LineToPts2(L, &p1, &p2); + pd.x = L.d.y; + pd.y = -L.d.x; + M_VecScale2v(&pd, dist); + M_VecAdd2v(&p1, &pd); + M_VecAdd2v(&p2, &pd); + return M_LineFromPts2(p1, p2); +} + +/* + * Compute a new line parallel to the given line, with perpendicular + * endpoints. XXX this is a circle of solutions in R3 + */ +M_Line3 +M_LineParallel3(M_Line3 L, M_Real dist) +{ + M_Vector3 p1, p2, pd; + + M_LineToPts3(L, &p1, &p2); + pd.x = L.d.y; + pd.y = -L.d.x; + M_VecScale3v(&pd, dist); + M_VecAdd3v(&p1, &pd); + M_VecAdd3v(&p2, &pd); + return M_LineFromPts3(p1, p2); +} + +/* Compute a line in R2 from the projection on the X-Y plane of a line in R3. */ +M_Line2 +M_LineProject2(M_Line3 L3) +{ + M_Line2 L2; + + L2.p = M_Vector3to2(L3.p); + L2.d = M_Vector3to2(L3.d); + L2.t = M_VecLen2p(&L2.d); + L2.d.x /= L2.t; + L2.d.y /= L2.t; + return (L2); +} + +/* Project a line in R2 onto the X-Y plane of R3. */ +M_Line3 +M_LineProject3(M_Line2 L2) +{ + M_Line3 L3; + + L3.p = M_Vector2to3(L2.p); + L3.d = M_Vector2to3(L2.d); + L3.t = M_VecLen3p(&L3.d); + L3.d.x /= L3.t; + L3.d.y /= L3.t; + L3.d.z /= L3.t; + return (L3); +} + +/* Compute minimal distance from a line segment L to a point p. */ +M_Real +M_LinePointDistance2(M_Line2 L, M_Vector2 p3) +{ + M_Vector2 p1, p2, s; + M_Real u; + + /* [p3 - p1 - u(p2-p1)] dot (p2-p1) = 0 */ + M_LineToPts2(L, &p1, &p2); + u = ((p3.x - p1.x)*(p2.x - p1.x) + + (p3.y - p1.y)*(p2.y - p1.y)) / (L.t*L.t); + + /* s = p1 + u(p2-p1) */ + s = M_VecAdd2(p1, M_VecScale2(M_VecSub2(p2,p1), u)); + return M_VecDistance2p(&p3, &s); +} + +/* Compute minimal distance from a line segment L to a point p. */ +M_Real +M_LinePointDistance3(M_Line3 L, M_Vector3 p3) +{ + M_Vector3 p1, p2, s; + M_Real u; + + /* [p3 - p1 - u(p2-p1)] dot (p2-p1) = 0 */ + M_LineToPts3(L, &p1, &p2); + u = ((p3.x - p1.x)*(p2.x - p1.x) + + (p3.y - p1.y)*(p2.y - p1.y) + + (p3.z - p1.z)*(p2.z - p1.z)) / (L.t*L.t); + + /* s = p1 + u(p2-p1) */ + s = M_VecAdd3(p1, M_VecScale3(M_VecSub3(p2,p1), u)); + return M_VecDistance3p(&p3, &s); +} + +/* Compute the CCW angle between two lines in R2. */ +M_Real +M_LineLineAngle2(M_Line2 L1, M_Line2 L2) +{ + return (Atan2(L2.d.y - L1.d.y, + L2.d.x - L1.d.x)); +} + +/* Compute the CCW angle between two lines in R3. */ +M_Real +M_LineLineAngle3(M_Line3 L1, M_Line3 L2) +{ + return Acos(M_VecDot3(L1.d, L2.d)); +} + +/* Compute intersection between two line segments in R2. */ +M_GeomSet2 +M_IntersectLineLine2(M_Line2 L1, M_Line2 L2) +{ + M_GeomSet2 Sint = M_GEOM_SET_EMPTY; + M_Vector2 a1 = M_LineFirstPt2(L1); + M_Vector2 a2 = M_LineSecondPt2(L1); + M_Vector2 b1 = M_LineFirstPt2(L2); + M_Vector2 b2 = M_LineSecondPt2(L2); + M_Real a = (b2.x - b1.x)*(a1.y - b1.y) - (b2.y - b1.y)*(a1.x - b1.x); + M_Real b = (a2.x - a1.x)*(a1.y - b1.y) - (a2.y - a1.y)*(a1.x - b1.x); + M_Real c = (b2.y - b1.y)*(a2.x - a1.x) - (b2.x - b1.x)*(a2.y - a1.y); + M_Geom2 G; + + if (c != 0.0) { + M_Real ac = a/c; + M_Real bc = b/c; + + if (ac >= 0.0 && ac <= 1.0 && + bc >= 0.0 && bc <= 1.0) { + G.type = M_POINT; + G.g_point = M_VecAdd2(a |